Суббота, 23.06.2018, 06:59
Приветствую Вас Гость
Меню сайта


Копилка для дальнейшего развития ресурса.
 
Форма входа
Интересное
Статистика

Онлайн всего: 1
Гостей: 1
Пользователей: 0

Программирование на Delphi.

Программирование

Главная » FAQ » Файлы


Procedure TFrameRuleEngine.SaveRules; 
Var 
  i: Integer; 

begin 
  i := 0; 
  While i < CheckListBoxRule.Items.Count Do 
  Begin 
  If CheckListBoxRule.Items[i] = '' Then 
  Begin 
  // Если ячейка пустая, то удаляем её 
  CheckListBoxRule.Items.Delete(i); 
  End 
  Else 
  Begin 
  // Добавляем 1 или 0 соответственно checked или not checked 
  CheckListBoxRule.Items[i] := IntToStr(Integer(CheckListBoxRule.Checked[i])) + CheckListBoxRule.Items[i]; 
  Inc(i); 
  End; 
  End; 
  // Сохраняем весь список 
  CheckListBoxRule.Items.SaveToFile(ExtractFilePath(Application.ExeName) + 'Rule.Txt'); 

end;

Procedure TFrameRuleEngine.LoadRules; 
Var 
  sChecked: String; 
  i: Integer; 

begin 
  If FileExists(ExtractFilePath(Application.ExeName) + 'Rule.Txt') Then 
  Begin 
  // Считываем файл 
  CheckListBoxRule.Items.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Rule.Txt'); 
  i := 0; 
  While i < CheckListBoxRule.Items.Count Do 
  Begin 
  If CheckListBoxRule.Items[i] = '' Then 
  Begin 
  // Удаляем пустую ячейку 
  CheckListBoxRule.Items.Delete(i); 
  End 
  Else 
  Begin 
  // получаем состояние чекбокса 
  sChecked := Copy(CheckListBoxRule.Items[i], 1, 1); 
  CheckListBoxRule.Items[i] := Copy(CheckListBoxRule.Items[i], 2, Length(CheckListBoxRule.Items[i])); 
  // Обновляем свойство Checked 
  CheckListBoxRule.Checked[i] := Boolean(StrToInt(sChecked)); 
  Inc(i); 
  End; 
  End; 
  End; 
end; 



function TForm1.DeleteDir(Dir: string): boolean;

var
  isFound: boolean;
  sRec: TSearchRec;
begin
  Result := false;
  ChDir( Dir );
  if IOResult <> 0 then
  begin
  ShowMessage( 'Не могу войти в каталог: ' + Dir );
  Exit;
  end;
  isFound := FindFirst( '*.*', faAnyFile, sRec ) = 0;
  while isFound do
  begin
  if ( sRec.Name <> '.' ) and ( sRec.Name <> '..' ) then
  if ( sRec.Attr and faDirectory ) = faDirectory then
  begin
  if not DeleteDir( sRec.Name ) then
  Exit;
  end
  else
  if not DeleteFile( sRec.Name ) then
  begin
  ShowMessage( 'Не могу удалить файл: ' + sRec.Name );
  Exit;
  end;
  isFound := FindNext( sRec ) = 0;
  end;
  FindClose( sRec );
  ChDir( '..' );
  RmDir( Dir );
  Result := IOResult = 0;
end;




// Способ первый
procedure TForm1.CopyFiles(FromCopy, ToCopy: string);
  procedure FCopy( Path: string );
  var
  sRec: TSearchRec;
  isFound: boolean;
  tempPath: string;
  begin
  if not DirectoryExists( ToCopy ) then CreateDir( ToCopy );
  tempPath := ToCopy;
  isFound := FindFirst( Path + '\*.*', faAnyFile, sRec ) = 0;
  while isFound do
  begin
  if ( ( sRec.Name <> '.' ) and ( sRec.Name <> '..' ) ) and
  ( ( sRec.Attr and faDirectory ) = faDirectory ) then
  begin
  tempPath := Path + '\' + sRec.Name;
  Delete( tempPath, 1, Length( FromCopy ) );
  tempPath := ToCopy + tempPath;
  if not DirectoryExists( tempPath ) then
  CreateDir( tempPath );
  FCopy( Path + '\' + sRec.Name );
  Application.ProcessMessages;
  end
  else
  begin
  tempPath := Path + '\' + sRec.Name;
  Delete( tempPath, 1, Length( FromCopy ) );
  tempPath := ToCopy + tempPath;
  CopyFile( PChar( Path + '\' + sRec.Name ),
  PChar( tempPath ), false );
  ProgressBar1.Position := ProgressBar1.Position + sRec.Size;
  Application.ProcessMessages;
  end;
  isFound := FindNext( sRec ) = 0;
  Application.ProcessMessages;
  end;
  FindClose( sRec );
  end;
begin
  FCopy( FromCopy );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CopyFiles( 'c:\откуда', 'd:\куда' );
end;

// Способ второй
uses
  ..., ShellAPI;

function CopyDir( const fromDir, toDir: string ): boolean;
var
  fos: TSHFileOpStruct;
begin
  ZeroMemory( @fos, SizeOf( fos ) );
  with fos do
  begin
  wFunc := FO_COPY;
  fFlags := FOF_FILESONLY;
  pFrom := PChar( fromDir + #0 );
  pTo := PChar( toDir )
  end;
  Result := ( 0 = ShFileOperation( fos ) );
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  List: TStringList;
begin
  List := TStringList.Create;
  List.Add( 'Путь к каталогу, который нужно скопировать' );
  for i := 0 to List.Count-1 do
  if CopyDir( List.Strings[i], 'C:\' ) then
  ShowMessage( 'файлы скопированы' );
  List.Free;
end;



function GetAttribut( Path: string ): string;

var
  Atr: Integer;
begin
  Result := '----';
  Atr := FileGetAttr( Path );
  if ( Atr and faReadOnly ) = faReadOnly then
  Result[1] := 'r';
  if ( Atr and faHidden ) = faHidden then
  Result[2] := 'h';
  if ( Atr and faSysFile ) = faSysFile then
  Result[3] := 's';
  if ( Atr and faArchive ) = faArchive then
  Result[4] := 'a';
end;