unit uFastFileCopy;

interface

uses
 Windows, SysUtils;

type
 TFastCopyFileMode = (fcfmCreate, fcfmAppend);
 TFastCopyFileNormalCallback = procedure(const FileName: TFileName; const CurrentSize, TotalSize: Int64; var CanContinue: Boolean);
 TFastCopyFileMethodCallback = procedure(const FileName: TFileName; const CurrentSize, TotalSize: Int64; var CanContinue: Boolean) of object;

const
 BufferSize_Default: Cardinal = 4096 * 3 * 2;

 // Simplest definition
function FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName): Boolean; overload;

// Definition with CopyMode and without any callbacks and default buffer
function FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName; CopyMode: TFastCopyFileMode): Boolean; overload;

// Definition with normal procedure callback and default buffer
function FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName; CopyMode: TFastCopyFileMode; Callback: TFastCopyFileNormalCallback): Boolean; overload;

// Definition with normal procedure callback and custom buffer
function FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName; CopyMode: TFastCopyFileMode; Callback: TFastCopyFileNormalCallback; BufferSize: Cardinal)
 : Boolean; overload;

// Definition with object method callback and custom buffer
function FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName; CopyMode: TFastCopyFileMode; Callback: TFastCopyFileMethodCallback; BufferSize: Cardinal)
 : Boolean; overload;

implementation

{Dummy Callback: Method Version}
type
 TDummyCallBackClient = class(TObject)
 private
  procedure DummyCallback(const FileName: TFileName; const CurrentSize, TotalSize: Int64; var CanContinue: Boolean);
 end;

procedure TDummyCallBackClient.DummyCallback(const FileName: TFileName; const CurrentSize, TotalSize: Int64; var CanContinue: Boolean);
begin
 // Nothing
 CanContinue := True;
end;

{Dummy Callback: Classical Procedure Version}
procedure DummyCallback(const FileName: TFileName; const CurrentSize, TotalSize: Int64; var CanContinue: Boolean);
begin
 // Nothing
 CanContinue := True;
end;

{CreateFileW API abstract layer}
function OpenLongFileName(ALongFileName: string; DesiredAccess, ShareMode, CreationDisposition: LongWord): THandle;
var
 // IsUNC: Boolean;
 FileName: PWideChar;

begin
 // Translate relative paths to absolute ones
 ALongFileName := ExpandFileName(ALongFileName);

 // Check if already an UNC path
 // IsUNC := Copy(ALongFileName, 1, 2) = '\\';
 // if not IsUNC then
 // ALongFileName := '\\?\' + ALongFileName;

 // Preparing the FileName for the CreateFileW API call
 FileName := PWideChar(WideString(ALongFileName));

 // Calling the API
 Result := CreateFileW(FileName, DesiredAccess, ShareMode, nil, CreationDisposition, FILE_ATTRIBUTE_NORMAL, 0);
end;

{FastCopyFile implementation}
function FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName; CopyMode: TFastCopyFileMode; Callback: TFastCopyFileNormalCallback; Callback2: TFastCopyFileMethodCallback;
 BufferSize: Cardinal): Boolean; overload;
var
 Buffer: TArray<Byte>;
 ASourceFile, ADestinationFile: THandle;
 FileSize, TotalBytesWritten: Int64;
 BytesRead, BytesWritten, BytesWritten2, CreationDisposition: LongWord;
 CanContinue, CanContinueFlag: Boolean;

begin
 FileSize := 0;
 TotalBytesWritten := 0;
 CanContinue := True;
 SetLength(Buffer, BufferSize);

 // Manage the Creation Disposition flag
 CreationDisposition := CREATE_ALWAYS;
 if CopyMode = fcfmAppend then
  CreationDisposition := OPEN_ALWAYS;

 // Opening the source file in read mode
 ASourceFile := OpenLongFileName(ASourceFileName, GENERIC_READ, 0, OPEN_EXISTING);
 if ASourceFile <> 0 then
  try
   FileSize := FileSeek(ASourceFile, Int64(0), FILE_END);
   FileSeek(ASourceFile, Int64(0), FILE_BEGIN);

   SysUtils.ForceDirectories(ExtractFilePath(ADestinationFileName));

   // Opening the destination file in write mode (in create/append state)
   ADestinationFile := OpenLongFileName(ADestinationFileName, GENERIC_WRITE, FILE_SHARE_READ, CreationDisposition);

   if ADestinationFile <> 0 then
    try
     // If append mode, jump to the file end
     if CopyMode = fcfmAppend then
      FileSeek(ADestinationFile, Int64(0), FILE_END);

     // For each blocks in the source file
     while CanContinue and (FileSeek(ASourceFile, Int64(0), FILE_CURRENT) < FileSize) do
      begin

       // Reading from source
       if (ReadFile(ASourceFile, Buffer[0], BufferSize, BytesRead, nil)) and (BytesRead <> 0) then
        begin
         // Writing to destination
         WriteFile(ADestinationFile, Buffer[0], BytesRead, BytesWritten, nil);

         // Read/Write secure code block (e.g. for WiFi connections)
         if BytesWritten < BytesRead then
          begin
           WriteFile(ADestinationFile, Buffer[BytesWritten], BytesRead - BytesWritten, BytesWritten2, nil);
           Inc(BytesWritten, BytesWritten2);
           if BytesWritten < BytesRead then
            RaiseLastOSError;
          end;

         // Notifying the caller for the current state
         Inc(TotalBytesWritten, BytesWritten);
         CanContinueFlag := True;
         if Assigned(Callback) then
          Callback(ASourceFileName, TotalBytesWritten, FileSize, CanContinueFlag);
         CanContinue := CanContinue and CanContinueFlag;
         if Assigned(Callback2) then
          Callback2(ASourceFileName, TotalBytesWritten, FileSize, CanContinueFlag);
         CanContinue := CanContinue and CanContinueFlag;
        end;

      end;

    finally
     CloseHandle(ADestinationFile);
    end;

  finally
   CloseHandle(ASourceFile);
  end;

 // Check if cancelled or not
 if not CanContinue then
  if FileExists(ADestinationFileName) then
   DeleteFile(ADestinationFileName);

 // Results (checking CanContinue flag isn't needed)
 Result := (FileSize <> 0) and (FileSize = TotalBytesWritten);
end;

{FastCopyFile simple definition}
function FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName): Boolean; overload;
begin
 Result := FastCopyFile(ASourceFileName, ADestinationFileName, fcfmCreate);
end;

{FastCopyFile definition without any callbacks and default buffer}
function FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName; CopyMode: TFastCopyFileMode): Boolean; overload;
begin
 Result := FastCopyFile(ASourceFileName, ADestinationFileName, CopyMode, DummyCallback, BufferSize_Default);
end;

{Definition with normal procedure callback and default buffer}
function FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName; CopyMode: TFastCopyFileMode; Callback: TFastCopyFileNormalCallback): Boolean; overload;
begin
 Result := FastCopyFile(ASourceFileName, ADestinationFileName, CopyMode, DummyCallback, BufferSize_Default);
end;

{FastCopyFile definition with normal procedure callback and custom buffer}
function FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName; CopyMode: TFastCopyFileMode; Callback: TFastCopyFileNormalCallback; BufferSize: Cardinal)
 : Boolean; overload;
var
 DummyObj: TDummyCallBackClient;

begin
 DummyObj := TDummyCallBackClient.Create;
 try
  Result := FastCopyFile(ASourceFileName, ADestinationFileName, CopyMode, Callback, DummyObj.DummyCallback, BufferSize);
 finally
  DummyObj.Free;
 end;
end;

{FastCopyFile definition with object method callback and custom buffer}
function FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName; CopyMode: TFastCopyFileMode; Callback: TFastCopyFileMethodCallback; BufferSize: Cardinal)
 : Boolean; overload;
begin
 Result := FastCopyFile(ASourceFileName, ADestinationFileName, CopyMode, DummyCallback, Callback, BufferSize);
end;

end.

procedure FileCopyCallBack(const FileName: TFileName; const CurrentSize, TotalSize: Int64; var CanContinue: Boolean);
begin
 CanContinue := PruefeX_Y_Z;
end;

if FileSize < 4096 * 50 then
 BufferSize := iFileSize
else
 BufferSize := 4096 * 50;

if FastCopyFile(sSource, sDest, TFastCopyFileMode.fcfmCreate, FileCopyCallBack, BufferSize) then
 ....