delphi - stored - procedimientos almacenados sql ejemplos

Copia de archivo rápido Delphi

Question

Estoy escribiendo una aplicación que se supone que debe copiar un montón de archivos de un lugar a otro. Cuando uso TFileStream para la copia, es 3-4 veces más lento que copiar los archivos con el sistema operativo.

También intenté copiar con un búfer, pero eso también fue demasiado lento.

Estoy trabajando con Win32, ¿alguien tiene alguna idea sobre este asunto?

Answer 1

Hay algunas opciones.

1. Puede llamar a CopyFile que usa la API de Windows CopyFileA
   • Puede llamar a la API que usa el explorador (la API de Windows SHFileOperation ). Un ejemplo de llamar a esa función se puede encontrar en SCIP.be
   • Podrías escribir tu propia función que utiliza un buffer.

Si conoce el tipo de archivos que va a copiar, el 3 ° método normalmente superará a los demás. Porque las API de Windows están más ajustadas para el mejor caso general (archivos pequeños, archivos grandes, archivos en la red, archivos en discos lentos). Puede ajustar su propia función de copia más para satisfacer sus necesidades.

A continuación se muestra mi propia función de copia en búfer (he eliminado las devoluciones de llamada GUI):

procedure CustomFileCopy(const ASourceFileName, ADestinationFileName: TFileName);
const
  BufferSize = 1024; // 1KB blocks, change this to tune your speed
var
  Buffer : array of Byte;
  ASourceFile, ADestinationFile: THandle;
  FileSize: DWORD;
  BytesRead, BytesWritten, BytesWritten2: DWORD;
begin
  SetLength(Buffer, BufferSize);
  ASourceFile := OpenLongFileName(ASourceFileName, 0);
  if ASourceFile <> 0 then
  try
    FileSize := FileSeek(ASourceFile, 0, FILE_END);
    FileSeek(ASourceFile, 0, FILE_BEGIN);
    ADestinationFile :=  CreateLongFileName(ADestinationFileName, FILE_SHARE_READ);
    if ADestinationFile <> 0 then
    try
      while (FileSize - FileSeek(ASourceFile, 0, FILE_CURRENT)) >= BufferSize do
      begin
        if (not ReadFile(ASourceFile, Buffer[0], BufferSize, BytesRead, nil)) and (BytesRead = 0) then
         Continue;
        WriteFile(ADestinationFile, Buffer[0], BytesRead, BytesWritten, nil);
        if BytesWritten < BytesRead then
        begin
          WriteFile(ADestinationFile, Buffer[BytesWritten], BytesRead - BytesWritten, BytesWritten2, nil);
          if (BytesWritten2 + BytesWritten) < BytesRead then
            RaiseLastOSError;
        end;
      end;
      if FileSeek(ASourceFile, 0, FILE_CURRENT)  < FileSize then
      begin
        if (not ReadFile(ASourceFile, Buffer[0], FileSize - FileSeek(ASourceFile, 0, FILE_CURRENT), BytesRead, nil)) and (BytesRead = 0) then
         ReadFile(ASourceFile, Buffer[0], FileSize - FileSeek(ASourceFile, 0, FILE_CURRENT), BytesRead, nil);
        WriteFile(ADestinationFile, Buffer[0], BytesRead, BytesWritten, nil);
        if BytesWritten < BytesRead then
        begin
          WriteFile(ADestinationFile, Buffer[BytesWritten], BytesRead - BytesWritten, BytesWritten2, nil);
          if (BytesWritten2 + BytesWritten) < BytesRead then
            RaiseLastOSError;
        end;
      end;
    finally
      CloseHandle(ADestinationFile);
    end;
  finally
    CloseHandle(ASourceFile);
  end;
end;

Funciones propias:

function OpenLongFileName(const ALongFileName: String; SharingMode: DWORD): THandle; overload;
begin
  if CompareMem(@(ALongFileName[1]), @(''//'[1]), 2) then
    { Allready an UNC path }
    Result := CreateFileW(PWideChar(WideString(ALongFileName)), GENERIC_READ, SharingMode, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
  else
    Result := CreateFileW(PWideChar(WideString(''//?/' + ALongFileName)), GENERIC_READ, SharingMode, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
end;
function OpenLongFileName(const ALongFileName: WideString; SharingMode: DWORD): THandle;  overload;
begin
  if CompareMem(@(WideCharToString(PWideChar(ALongFileName))[1]), @(''//'[1]), 2) then
    { Allready an UNC path }
    Result := CreateFileW(PWideChar(ALongFileName), GENERIC_READ, SharingMode, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
  else
    Result := CreateFileW(PWideChar(''//?/' + ALongFileName), GENERIC_READ, SharingMode, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
end;

function CreateLongFileName(const ALongFileName: String; SharingMode: DWORD): THandle; overload;
begin
  if CompareMem(@(ALongFileName[1]), @(''//'[1]), 2) then
    { Allready an UNC path }
    Result := CreateFileW(PWideChar(WideString(ALongFileName)), GENERIC_WRITE, SharingMode, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
  else
    Result := CreateFileW(PWideChar(WideString(''//?/' + ALongFileName)), GENERIC_WRITE, SharingMode, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
end;
function CreateLongFileName(const ALongFileName: WideString; SharingMode: DWORD): THandle; overload;
begin
  if CompareMem(@(WideCharToString(PWideChar(ALongFileName))[1]), @(''//'[1]), 2) then
    { Allready an UNC path }
    Result := CreateFileW(PWideChar(ALongFileName), GENERIC_WRITE, SharingMode, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
  else
    Result := CreateFileW(PWideChar(''//?/' + ALongFileName), GENERIC_WRITE, SharingMode, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
end;

El código es un poco más largo de lo necesario, porque incluí un mecanismo de reintento para soportar un problema de conexión wifi que tenía.

Entonces esta parte

    if BytesWritten < BytesRead then
    begin
      WriteFile(ADestinationFile, Buffer[BytesWritten], BytesRead - BytesWritten, BytesWritten2, nil);
      if (BytesWritten2 + BytesWritten) < BytesRead then
        RaiseLastOSError;
    end;

podría escribirse como

    if BytesWritten < BytesRead then
    begin
        RaiseLastOSError;
    end;

Answer 2

O puede hacerlo de manera "sucia" ... He encontrado un código viejo que hace el trabajo (no estoy seguro si es rápido):

procedure CopyFile(const FileName, DestName: string);
var
   CopyBuffer   : Pointer; { buffer for copying }
   BytesCopied  : Longint;
   Source, Dest : Integer; { handles }
   Destination  : TFileName; { holder for expanded destination name }

const
     ChunkSize  : Longint = 8192; { copy in 8K chunks }

begin
     Destination := DestName;
     GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
     try
       Source := FileOpen(FileName, fmShareDenyWrite); { open source file }
       if Source < 0
          then raise EFOpenError.CreateFmt(''Error: Can''''t open file!'', [FileName]);
       try
         Dest := FileCreate(Destination); { create output file; overwrite existing }
         if Dest < 0
            then raise EFCreateError.CreateFmt(''Error: Can''''t create file!'', [Destination]);
         try
           repeat
             BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk }
             if BytesCopied > 0  {if we read anything... }
                then FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
           until BytesCopied < ChunkSize; { until we run out of chunks }

         finally
           FileClose(Dest); { close the destination file }
         end;

       finally
         FileClose(Source); { close the source file }
       end;

     finally
       FreeMem(CopyBuffer, ChunkSize); { free the buffer }
     end;
end;

Answer 3

Puede hacer que Explorer lo haga por usted a través de SHFileOperation () http://msdn.microsoft.com/en-us/library/bb762164(VS.85).aspx (código de ejemplo que lo hace desde delphi: http: // delphi. icm.edu.pl/ftp/d20free/fileop11.zip )

Answer 4

Puede intentar llamar directamente a la función de API de Windows CopyFile

Answer 5

Tal vez puedas estudiar el código fuente de Cobian Backup 8 (con nombre en código Black Moon). Es de código abierto, escrito en Delphi.

http://www.educ.umu.se/~cobian/cobianbackup.htm

Answer 6

Antes que nada, lamento haber topado con este viejo hilo, pero hice algunos cambios significativos en la gran respuesta que Davy Landman hizo para mis propias necesidades. Los cambios son:

• Se agregó la posibilidad de usar rutas relativas (por supuesto, se mantiene el soporte de rutas absolutas y UNC)
• Se agregó la capacidad de devolución de llamada, para mostrar el progreso de la copia en la pantalla (seguir leyendo) o cancelar el proceso de copia
• El código principal fue limpiado un poco. Creo que se mantuvo el soporte de Unicode, pero realmente no lo sé ya que estoy usando la última versión ANSI del compilador Delphi (si alguien puede probar eso).

Para usar este código, cree un archivo FastCopy.pas en su proyecto, luego copie y pegue el contenido:

{
  FastCopyFile

  By SiZiOUS 2014, based on the work by Davy Landman
  www.sizious.com - @sizious - fb.com/sizious - sizious (at) gmail (dot) com

  This unit was designed to copy a file using the Windows API.
  It''s faster than using the (old) BlockRead/Write and TFileStream methods.

  Every destination file will be overwritten (by choice), unless you specify
  the fcfmAppend CopyMode flag. In that case, the source file will be appened to
  the destination file (instead of overwriting it).

  You have the choice to use a normal procedure callback, method object callback
  or no callback at all. The callback is used to cancel the copy process and to
  display the copy progress on-screen.

  Developed and tested under Delphi 2007 (ANSI).
  If you are using a Unicode version of Delphi (greater than Delphi 2007), may
  be you need to do some adapations (beware of the WideString type).

  All credits flying to Davy Landman.
  http://.com/questions/438260/delphi-fast-file-copy   
}
unit FastCopy;

interface

uses
  Windows, SysUtils;

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

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

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

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

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

implementation

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

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

{ Dummy Callback: Classical Procedure Version }
procedure DummyCallback(const FileName: TFileName;
  const CurrentSize, TotalSize: LongWord; 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): Boolean; overload;
const
  BUFFER_SIZE = 524288; // 512KB blocks, change this to tune your speed

var
  Buffer: array of Byte;
  ASourceFile, ADestinationFile: THandle;
  FileSize, BytesRead, BytesWritten, BytesWritten2, TotalBytesWritten,
  CreationDisposition: LongWord;
  CanContinue, CanContinueFlag: Boolean;

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

  // 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, 0, FILE_END);
    FileSeek(ASourceFile, 0, FILE_BEGIN);

    // 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, 0, FILE_END);

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

        // Reading from source
        if (ReadFile(ASourceFile, Buffer[0], BUFFER_SIZE, 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 }
function FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName;
  CopyMode: TFastCopyFileMode): Boolean; overload;
begin
  Result := FastCopyFile(ASourceFileName, ADestinationFileName, CopyMode,
    DummyCallback);
end;

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

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

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

end.

El método principal se llama FastCopyFile y tiene 4 funciones sobrecargadas para satisfacer todas las necesidades. A continuación encontrará dos ejemplos que le muestran cómo jugar con esa unidad.

El primero es el más simple: simplemente crea una Console Application y luego copia y pega los siguientes contenidos:

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  fastcopy in ''fastcopy.pas'';

begin
  try
    WriteLn(''FastCopyFile Result: '', FastCopyFile(''test2.bin'', ''test.bin''));
    WriteLn(''Strike the <ENTER> key to exit...'');
    ReadLn;
  except
    on E:Exception do
      Writeln(E.Classname, '': '', E.Message);
  end;
end.

Si lo desea, hice una aplicación VCL para mostrarle cómo mostrar el progreso de la copia y la posibilidad de abortar. Esta aplicación es multiproceso para evitar la congelación de la GUI. Para probar este ejemplo más completo, cree una nueva aplicación VCL y luego use el siguiente código:

Unidad1.pas :

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls, FastCopy;

type
  TFastCopyFileThread = class;

  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    Button2: TButton;
    RadioGroup1: TRadioGroup;
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    GroupBox2: TGroupBox;
    Edit2: TEdit;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Déclarations privées }
    fFastCopyFileThread: TFastCopyFileThread;
    fFastCopyFileThreadCanceled: Boolean;
    procedure ChangeControlsState(State: Boolean);
    procedure FastCopyFileProgress(Sender: TObject; FileName: TFileName;
      Value: Integer; var CanContinue: Boolean);
    procedure FastCopyFileTerminate(Sender: TObject);
    function GetStatusText: string;
    procedure SetStatusText(const Value: string);
  public
    { Déclarations publiques }
    procedure StartFastCopyThread;
    property StatusText: string read GetStatusText write SetStatusText;
  end;

  TFastCopyFileProgressEvent = procedure(Sender: TObject; FileName: TFileName;
    Value: Integer; var CanContinue: Boolean) of object;

  TFastCopyFileThread = class(TThread)
  private
    fSourceFileName: TFileName;
    fDestinationFileName: TFileName;
    fProgress: TFastCopyFileProgressEvent;
    fCopyMode: TFastCopyFileMode;
    procedure FastCopyFileCallback(const FileName: TFileName;
      const CurrentSize, TotalSize: LongWord; var CanContinue: Boolean);
  protected
    procedure Execute; override;
  public
    constructor Create; overload;
    property SourceFileName: TFileName
      read fSourceFileName write fSourceFileName;
    property DestinationFileName: TFileName
      read fDestinationFileName write fDestinationFileName;
    property CopyMode: TFastCopyFileMode read fCopyMode write fCopyMode;
    property OnProgress: TFastCopyFileProgressEvent
      read fProgress write fProgress;
  end;  

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  StartFastCopyThread;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  fFastCopyFileThread.Terminate;
  fFastCopyFileThreadCanceled := True;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  with OpenDialog1 do
    if Execute then
      Edit1.Text := FileName;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  with SaveDialog1 do
    if Execute then
      Edit2.Text := FileName;
end;

procedure TForm1.ChangeControlsState(State: Boolean);
begin
  Button1.Enabled := State;
  Button2.Enabled := not State;
  if State then
  begin
    if fFastCopyFileThreadCanceled then
      StatusText := ''Aborted!''
    else
      StatusText := ''Done!'';
    fFastCopyFileThreadCanceled := False;
  end;
end;

procedure TForm1.FastCopyFileProgress(Sender: TObject; FileName: TFileName;
  Value: Integer; var CanContinue: Boolean);
begin
  StatusText := ExtractFileName(FileName);
  ProgressBar1.Position := Value;
end;

procedure TForm1.FastCopyFileTerminate(Sender: TObject);
begin
  ChangeControlsState(True);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ChangeControlsState(True);
  StatusText := ''Idle...'';
end;

function TForm1.GetStatusText: string;
begin
  Result := Label1.Caption;
end;

procedure TForm1.SetStatusText(const Value: string);
begin
  Label1.Caption := Value;
end;

procedure TForm1.StartFastCopyThread;
begin
  ChangeControlsState(False);
  fFastCopyFileThread := TFastCopyFileThread.Create;
  with fFastCopyFileThread do
  begin
    SourceFileName := Edit1.Text;
    DestinationFileName := Edit2.Text;
    CopyMode := TFastCopyFileMode(RadioGroup1.ItemIndex);
    OnProgress := FastCopyFileProgress;
    OnTerminate := FastCopyFileTerminate;
    Resume;
  end;
end;

{ TFastCopyFileThread }

constructor TFastCopyFileThread.Create;
begin
  inherited Create(True);
  FreeOnTerminate := True;
end;

procedure TFastCopyFileThread.Execute;
begin
  FastCopyFile(SourceFileName, DestinationFileName, CopyMode,
    FastCopyFileCallback);
end;

procedure TFastCopyFileThread.FastCopyFileCallback(const FileName: TFileName;
  const CurrentSize, TotalSize: LongWord; var CanContinue: Boolean);
var
  ProgressValue: Integer;

begin
  CanContinue := not Terminated;
  ProgressValue := Round((CurrentSize / TotalSize) * 100);
  if Assigned(OnProgress) then
    OnProgress(Self, FileName, ProgressValue, CanContinue);
end;

end.

Unit1.dfm :

object Form1: TForm1
  Left = 0
  Top = 0
  BorderStyle = bsDialog
  Caption = ''FastCopyFile Example (Threaded)''
  ClientHeight = 210
  ClientWidth = 424
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = ''Tahoma''
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 173
    Width = 31
    Height = 13
    Caption = ''Label1''
  end
  object Button1: TButton
    Left = 259
    Top = 177
    Width = 75
    Height = 25
    Caption = ''Start''
    Default = True
    TabOrder = 0
    OnClick = Button1Click
  end
  object ProgressBar1: TProgressBar
    Left = 8
    Top = 188
    Width = 245
    Height = 13
    TabOrder = 1
  end
  object Button2: TButton
    Left = 340
    Top = 177
    Width = 75
    Height = 25
    Caption = ''Stop''
    TabOrder = 2
    OnClick = Button2Click
  end
  object RadioGroup1: TRadioGroup
    Left = 4
    Top = 110
    Width = 410
    Height = 57
    Caption = '' Copy Mode: ''
    ItemIndex = 0
    Items.Strings = (
      ''Create (Overwrite destination)''
      ''Append (Merge destination)'')
    TabOrder = 3
  end
  object GroupBox1: TGroupBox
    Left = 4
    Top = 4
    Width = 412
    Height = 49
    Caption = '' Source: ''
    TabOrder = 4
    object Edit1: TEdit
      Left = 8
      Top = 20
      Width = 369
      Height = 21
      TabOrder = 0
      Text = ''test.bin''
    end
    object Button3: TButton
      Left = 383
      Top = 20
      Width = 21
      Height = 21
      Caption = ''...''
      TabOrder = 1
      OnClick = Button3Click
    end
  end
  object GroupBox2: TGroupBox
    Left = 4
    Top = 59
    Width = 412
    Height = 50
    Caption = '' Destination: ''
    TabOrder = 5
    object Edit2: TEdit
      Left = 8
      Top = 21
      Width = 369
      Height = 21
      TabOrder = 0
      Text = ''sizious.bin''
    end
  end
  object Button4: TButton
    Left = 387
    Top = 80
    Width = 21
    Height = 21
    Caption = ''...''
    TabOrder = 6
    OnClick = Button4Click
  end
  object OpenDialog1: TOpenDialog
    DefaultExt = ''bin''
    Filter = ''All Files (*.*)|*.*''
    Options = [ofHideReadOnly, ofFileMustExist, ofEnableSizing]
    Left = 344
    Top = 12
  end
  object SaveDialog1: TSaveDialog
    DefaultExt = ''bin''
    Filter = ''All Files (*.*)|*.*''
    Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
    Left = 344
    Top = 68
  end
end

Por supuesto, no olvide agregar la referencia del archivo FastCopy.pas a ese proyecto.

Deberías obtener esto:

Seleccione un archivo de origen, un archivo de destino y luego presione Inicio .

Todos los créditos van por supuesto a Davy Landman .