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

Question

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!!!

Answer 1

The best solution for me (to copy 20 MB and not often) is to use CopyFileEx in a lite version. A main purpose of my soft is not copying.

Answer 2

Well, I had an answer - but I only just got around to digging it out :( But here it is anyway, I wrote this a few years ago as part of a program that was called "CopyFilesAndFailGraceFully.exe" :) I've modded it a bit to miss out the recovery stuff that handles failing hard drives if it can - so NOT FULLY TESTED but run as a simple test.

You can call it to get a recursive filecount, filesize or Copy the files in a folder to a new folder. Or Mod for your own situation :) Anyway its an example of what you need.

unit FileCopierU;
(***************************************************************
  Author Despatcher (Timbo) 2011
****************************************************************)
interface

uses
  Windows, Messages, SysUtils, Classes, controls, stdctrls, strUtils, ComCtrls, ShellApi, Math;

Type
  TFolderOp = (foCopy, foCount, foSize);
  TCopyCallBack = function( TotalFileSize, TotalBytesTransferred, StreamSize, StreamBytesTransferred: int64;
                            StreamNumber, CallbackReason: Dword;
                            SourceFile, DestinationFile: THandle; Data: Pointer): DWord;

  TFileCopier = class(TPersistent)
  private
    fCopyCount: Integer;
    fFileCount: Integer;
    fFileSize: Int64;
    fCallBack: TCopyCallBack;
     function DoFolderFiles(const ASourcePath, ATargetPath: string; const Op: TFolderOp): Int64;
     function DoFolderTree(const ASourcePath, ATargetPath: string; const Op: TFolderOp): Int64;
  public
     constructor Create; virtual;
     function AddBackSlash(const S: String): string;
     function DoFiles(const ASourcePath, ATargetPath: string; const Op: TFolderOp): Int64;
     property CallBack: TCopyCallBack read fCallBack write fCallBack;
     property CopyCount: Integer read fCopyCount;
     property FileCount: Integer read fFileCount;
     property FileSize: Int64 read fFileSize;
  end;

implementation

{ TFileCopier }

function TFileCopier.AddBackSlash(const S: String): string;
begin
  Result := S;
  if S <> '' then
  begin
    If S[length(S)] <> '\' then
      Result := S + '\';
  end
  else
    Result := '\';
end;

function TFileCopier.DoFiles(const ASourcePath, ATargetPath: string;
  const Op: TFolderOp): Int64;
begin
  case Op of
   foCopy: fCopyCount := 0;
   foCount: fFileCount := 0;
   foSize: fFileSize:= 0;
  end;
  Result := DoFolderTree(ASourcePath, ATargetPath, Op);
end;

constructor TFileCopier.Create;
begin
  inherited;
  CallBack := nil;
end;

function TFileCopier.DoFolderFiles( const ASourcePath, ATargetPath: string;
                                    const Op: TFolderOp): Int64;
// Return -1: failed/error x: count of to or count of copied or Size of all files
// Root paths must exist
var
  StrName,
  MySearchPath,
  MyTargetPath,
  MySourcePath: string;
  FindRec: TSearchRec;
  i: Integer;
  Cancelled: Boolean;
  Attributes: WIN32_FILE_ATTRIBUTE_DATA;
begin
  Result := 0;
  Cancelled := False;
  MyTargetPath := AddBackSlash(ATargetPath);
  MySourcePath := AddBackSlash(ASourcePath);
  MySearchPath := AddBackSlash(ASourcePath) + '*.*';
  i := FindFirst(MySearchPath, 0 , FindRec);
  try
    while (i = 0) and (Result <> -1) do
    begin
      try
      case op of
       foCopy: begin
          StrName := MySourcePath + FindRec.Name;
          if CopyFileEx(PWideChar(StrName), PWideChar(MyTargetPath + FindRec.Name), @fCallBack, nil, @Cancelled, COPY_FILE_FAIL_IF_EXISTS) then
          begin
            inc(Result);
            inc(fCopyCount);
          end
          else
            Result := -1;
        end;
       foCount:
       begin
         Inc(Result);
         Inc(fFileCount);
       end;
       foSize:
       begin
         Result := Result + FindRec.Size;
         fFileSize := fFileSize + FindRec.Size;
       end;
      end; // case
      except
        Result := -1;
      end;
      i := FindNext(FindRec);
    end;
  finally
    FindClose(FindRec);
  end;

end;

function TFileCopier.DoFolderTree( const ASourcePath, ATargetPath: string;
                                     const Op: TFolderOp): Int64;
// Return -1: failed/error x: count of to or count of copied or Size of all files
// Root paths must exist
// Recursive
var
  FindRec: TSearchRec;
  StrName, StrExt,
  MySearchPath,
  MyTargetPath,
  MySourcePath: string;
  InterimResult :Int64;
  i: Integer;
begin
  Result := 0;
  // Find Folders
  MySearchPath := AddBackSlash(ASourcePath) + '*.*';
  MySourcePath := AddBackSlash(ASourcePath);
  MyTargetPath := AddBackSlash(ATargetPath);
  i := FindFirst(MySearchPath, faDirectory , FindRec);
  try
    while (i = 0) and (Result <> -1) do
    begin
      StrName := FindRec.Name;
      if (Bool(FindRec.Attr and faDirectory)) and (StrName <> '.') and (StrName <> '..') then
      begin
        try
          case op of
           foCopy:
             if CreateDir(MyTargetPath + StrName) then
              begin
                InterimResult := DoFolderTree(MySourcePath + StrName, MyTargetPath + StrName, Op);
                if InterimResult <> -1 then
                begin
                  Result := Result + InterimResult;
                  fCopyCount := Result;
                end
                else
                  Result := -1;
              end; // foCopy
           foCount, foSize:
           begin
             InterimResult := DoFolderTree(MySourcePath + StrName, MyTargetPath + StrName, Op);
             if InterimResult <> -1 then
               Result := Result + InterimResult
             else
               Result := -1;  // or result, -1 easier to read
           end; // foCount, foSize
          end; // case
        except
          Result := -1;
        end;
      end;
      i := FindNext(FindRec);
    end;
  finally
    FindClose(FindRec);
  end;
  if Result <> -1 then
  case op of
   foCopy:
    begin
     InterimResult := DoFolderFiles( AddBackSlash(ASourcePath), AddBackSlash(ATargetPath), Op);
     if InterimResult <> -1 then
     begin
       Result := Result + InterimResult;
       fCopyCount := Result;
     end
     else
       Result := InterimResult;
    end;
   foCount:
   begin
     InterimResult := DoFolderFiles(AddBackSlash(ASourcePath), AddBackSlash(ATargetPath), Op);
     if InterimResult <> -1 then
     begin
       Result := Result + InterimResult;
       fFileCount := Result;
     end
     else
       Result := InterimResult;
   end; // foCount
   foSize:
   begin
     InterimResult := DoFolderFiles(AddBackSlash(ASourcePath), AddBackSlash(ATargetPath), Op);
     if InterimResult <> -1 then
     begin
       Result := Result + InterimResult;
       fFileSize := Result;
     end
     else
       Result := InterimResult;
   end; // foSize
  end; // case
end;


end.

Its an Object (As you see) to use it (roughly): You will need a couple of vars appropriately named. Declare your callback:

  function CallBack(TotalFileSize, TotalBytesTransferred, StreamSize, StreamBytesTransferred: int64; StreamNumber, CallbackReason: Dword; SourceFile, DestinationFile: THandle; Data: Pointer): DWord;

and implement:

function CallBack( TotalFileSize, TotalBytesTransferred, StreamSize, StreamBytesTransferred: int64;
                          StreamNumber, CallbackReason: Dword;
                          SourceFile, DestinationFile: THandle;
                          Data: Pointer): DWord;
begin
  if CopyStream <> StreamNumber then
  begin
    inc(CopyCount);
    CopyStream :=  StreamNumber;
  end;
  Result := PROGRESS_CONTINUE;
  Form1.lblCount.Caption := 'Copied' + IntToStr(CopyCount);
  application.ProcessMessages;
end;

Then call as needed :) e.g.:

procedure TForm1.Button1Click(Sender: TObject);
var
  Copier: TFileCopier;
begin
  Copier:= TFileCopier.Create;
  try
  Copier.CallBack := CallBack;
  CopyStream := 1;
  CopyCount := 0;
  Copier.DoFiles(MyCopyFolder, MyTargetFolder, foCount);
  Copier.DoFiles(MyCopyFolder, MyTargetFolder, foSize);
  Copier.DoFiles(MyCopyFolder, MyTargetFolder, foCopy);
  finally
    lblCount.Caption := 'Copied: ' + IntToStr(Copier.CopyCount) + ' Size: ' + IntToStr(Copier.FileSize) + ' Total: ' + IntToStr(Copier.FileCount);
    Copier.Free;
  end;
end;

Answer 3

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 ;-)

Answer 4

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.