Последние записи

made in programmersforum 8

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

16th
Дек

Копирование файлов в делфи

Posted by Chas under Топик-обзор

{Копирование содержимого директории, вместе с поддиректориями.
Фукция копирует СОДЕРЖИМОЕ директории SourceDir в директорию TargetDir.
Копируются все файлы, подкаталоги, и файлы находящиеся в этих подкаталогах.
Аргумент StopIfNotAllCopied: если значение этого аргумента = True,
то при первой же ошибке копирования файла или папки, работы функции
прекратится а функуция вернёт False. В случае если этот аргумент = False,
то ошибки копирования учитываться не будут.
Аргумент OverWriteFiles: если True, то существующие файлы будут переписаны.
Зависимости: SysUtils, FileCtrl, Windows
Автор:       VID, snap@iwt.ru}
function FullDirectoryCopy(SourceDir, TargetDir: string; StopIfNotAllCopied,
  OverWriteFiles: Boolean): Boolean;
var
  SR: TSearchRec;
  I: Integer;
begin
  Result := False;
  SourceDir := IncludeTrailingBackslash(SourceDir);
  TargetDir := IncludeTrailingBackslash(TargetDir);
  if not DirectoryExists(SourceDir) then
    Exit;
  if not ForceDirectories(TargetDir) then
    Exit;
  I := FindFirst(SourceDir + ‘*’, faAnyFile, SR);
  try
    while I = 0 do
    begin
      if (SR.Name <> ») and (SR.Name <> ‘.’) and (SR.Name <> ‘..’) then
      begin
        if SR.Attr = faDirectory then
          Result := FullDirectoryCopy(SourceDir + SR.Name, TargetDir + SR.NAME,
            StopIfNotAllCopied, OverWriteFiles)
        else if not (not OverWriteFiles and FileExists(TargetDir + SR.Name))
          then
          Result := CopyFile(Pchar(SourceDir + SR.Name), Pchar(TargetDir +
            SR.Name), False)
        else
          Result := True;
        if not Result and StopIfNotAllCopied then
          exit;
      end;
      I := FindNext(SR);
    end;
  finally
    SysUtils.FindClose(SR);
  end;
end;
Пример использования: 
FullDirectoryCopy(‘C:\Users\Admin\Desktop\Папка_1’,‘C:\Users\Admin\Desktop\Папка_2’,False,True);

Копирование с показом стандартного окна копирования файлов:
Код:

var
  Fo : TSHFileOpStruct;
  buffer : array[0..4096] of char;
  p : pchar;
begin
  FillChar(Buffer, sizeof(Buffer), #0);
  p := @buffer;
  p := StrECopy(p, ‘C:\DownLoad\1.ZIP’) + 1;
  p := StrECopy(p, ‘C:\DownLoad\2.ZIP’) + 1;
  p := StrECopy(p, ‘C:\DownLoad\3.ZIP’) + 1;
  StrECopy(p, ‘C:\DownLoad\4.ZIP’);
  FillChar(Fo, sizeof(Fo), #0);
  Fo.Wnd := Handle;
  Fo.wFunc := FO_COPY;
  Fo.pFrom := @Buffer;
  Fo.pTo := ‘D:\’;
  Fo.fFlags := 0;
  if ((SHFileOperation(Fo) <> 0) or (Fo.fAnyOperationsAborted <> false)) then
    ShowMessage(‘Cancelled’)
end;

Как получить список файлов со всеми подкаталогами

procedure ScanDir(StartDir: string; Mask:string; List:TStrings);
var
  SearchRec : TSearchRec;
begin
if Mask = »then Mask := ‘*.*’;
if StartDir[Length(StartDir)] <> ‘\’then StartDir := StartDir + ‘\’;
ifFindFirst(StartDir+Mask, faAnyFile, SearchRec) = 0then
begin
repeat
      Application.ProcessMessages;
if(SearchRec.Attrand faDirectory) <> faDirectory then
          List.Add(StartDir + SearchRec.Name)
elseif(SearchRec.Name <> ‘..’)and(SearchRec.Name <> ‘.’)then
begin
          List.Add(StartDir + SearchRec.Name + ‘\’);
          ScanDir(StartDir + SearchRec.Name + ‘\’,Mask,List);
end;
untilFindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;

{
Пример вызова. параметры
1. имя папки
2. маска, по умолчанию *.*
3. хранилище для результата, любой наследник от TString, например TStringList
}
procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.Items.Clear;
  ScanDir(‘c:’,»,ListBox1.Items);
  Label1.Caption := IntToStr(ListBox1.Items.Count);
end;

Копирование методом потока

Procedure FileCopy(Const SourceFileName, TargetFileName: String);
Var
  S,T   : TFileStream;
Begin
  S := TFileStream.Create(sourcefilename, fmOpenRead );
  try
    T := TFileStream.Create(targetfilename, fmOpenWrite or fmCreate);
    try
      T.CopyFrom(S, S.Size ) ;
      FileSetDate(T.Handle, FileGetDate(S.Handle));
    finally
      T.Free;
    end;
  finally
    S.Free;
  end;
end;