Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Delphi: Copy Files from folder with Overall progress. CopyFileEx?

I have found examples of CopyFileEx with progress, but I need to copy some files from a folder with overall progress.

Can anybody provide info how to do this? Or is there good alternative (component, function)?

Big thanks for help!!!

like image 996
maxfax Avatar asked Jun 15 '11 06:06

maxfax


2 Answers

Here is my solution without WinApi.

First, a procedure for copying one file:

procedure CopyFileWithProgress(const AFrom, ATo: String; var AProgress: TProgressBar);
var
  FromF, ToF: file;
  NumRead, NumWritten, DataSize: Integer;
  Buf: array[1..2048] of Char;
begin
  try
    DataSize := SizeOf(Buf);
    AssignFile(FromF, AFrom);
    Reset(FromF, 1);
    AssignFile(ToF, ATo);
    Rewrite(ToF, 1);
    repeat
    BlockRead(FromF, Buf, DataSize, NumRead);
    BlockWrite(ToF, Buf, NumRead, NumWritten);
    if Assigned(AProgress) then
    begin
      AProgress.Position := AProgress.Position + DataSize;
      Application.ProcessMessages;
    end;
    until (NumRead = 0) or (NumWritten <> NumRead);
  finally
    CloseFile(FromF);
    CloseFile(ToF);
  end;
end;

Now, gathering files from directory and calculating their total size for progress. Please note that the procedure requires an instance of TStringList class where will be stored file paths.

procedure GatherFilesFromDirectory(const ADirectory: String;
  var AFileList: TStringList; out ATotalSize: Int64);
var
  SR: TSearchRec;
begin
  if FindFirst(ADirectory + '\*.*', faDirectory, sr) = 0 then
  begin
    repeat
      if ((SR.Attr and faDirectory) = SR.Attr) and (SR.Name <> '.') and (SR.Name <> '..') then
        GatherFilesFromDirectory(ADirectory + '\' + Sr.Name, AFileList, ATotalSize);
    until FindNext(SR) <> 0;
    FindClose(SR);
  end;

  if FindFirst(ADirectory + '\*.*', 0, SR) = 0 then
  begin
    repeat
      AFileList.Add(ADirectory + '\' + SR.Name);
      Inc(ATotalSize, SR.Size);
    until FindNext(SR) <> 0;
    FindClose(SR);
  end;
end;

And finally the usage example:

procedure TfmMain.btnCopyClick(Sender: TObject);
var
  FileList: TStringList;
  TotalSize: Int64;
  i: Integer;
begin
  TotalSize := 0;
  FileList := TStringList.Create;
  try
    GatherFilesFromDirectory('C:\SomeSourceDirectory', FileList, TotalSize);
    pbProgress.Position := 0;
    pbProgress.Max := TotalSize;
    for i := 0 to FileList.Count - 1 do
    begin
      CopyFileWithProgress(FileList[i], 'C:\SomeDestinationDirectory\' + ExtractFileName(FileList[i]), pbProgress);
    end;
  finally
    FileList.Free;
  end;
end;

Experimenting with buffer size my improve performance. However it is quite fast as it is now. Maybe even faster than copying with this bloated Vista/Win 7 dialogs.

Also this is quick solution which I wrote few years ago for other forum, it might contain some bugs. So use at own risk ;-)

like image 77
Wodzu Avatar answered Sep 22 '22 09:09

Wodzu


Add up the file size for all the files before you start. Then you can manually convert the progress for each individual file into an overall progress.

Or use SHFileOperation and get the native OS file copy progress dialogs.

like image 39
David Heffernan Avatar answered Sep 23 '22 09:09

David Heffernan