Szybka kopia pliku Delphi

Question

Piszę aplikację, która ma skopiować kilka plików z jednego miejsca w drugie. Kiedy używam TFileStream dla kopii, jest 3-4 razy wolniejszy niż kopiowanie plików z systemem operacyjnym.

Próbowałem również skopiować z buforem, ale to też było zbyt wolne.

Pracuję pod Win32, każdy miał pewne spostrzeżenia na ten temat?

Answer 1

Nie jest kilka opcji.

1. Można zadzwonić CopyFile który wykorzystuje się CopyFileA Windows API
   • Można zadzwonić do API, które Explorer używa (Windows API SHFileOperation). Przykład wywoływania tej funkcji można znaleźć na SCIP.be
   • Możesz napisać własną funkcję, która używa bufora.

Jeśli znasz rodzaju plików zamierzasz skopiować, metoda 3th będą normalnie wyprzedzić innych. Ponieważ interfejsy API systemu Windows są bardziej dostrojone pod względem ogólnej jakości (małe pliki, duże pliki, pliki przez sieć, pliki na wolnych dyskach). Możesz dostosować własną funkcję kopiowania bardziej, aby dopasować ją do swoich potrzeb.

Poniżej jest moja własna funkcja buforowana kopia (i już okorowane callbacks 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; 

własne funkcje:

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; 

Kod jest nieco dłużej niż to konieczne, bo zawiera mechanizm ponawiania obsługujący problem z połączeniem Wi-Fi, który miałem.

więc ta część

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

można zapisać jako

if BytesWritten < BytesRead then 
    begin 
     RaiseLastOSError; 
    end; 

Answer 2

Można mieć Explorer zrobi to za Ciebie poprzez SHFileOperation() http://msdn.microsoft.com/en-us/library/bb762164(VS.85).aspx (przykładowy kod robi to z Delphi: http://delphi.icm.edu.pl/ftp/d20free/fileop11.zip)

Answer 3

Można spróbować bezpośrednio wywołanie funkcji CopyFile Windows API

Answer 4

Może uczysz Cobian Backup 8 (kod źródłowy Black Moon) kod źródłowy. Jest to opensource, napisane w Delphi.

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

Answer 5

Albo można zrobić to „brudne” sposób ... Znalazłem jakiś stary kod, który wykonuje pracę (nie wiem, czy jest szybki):

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 6

Przede wszystkim, przepraszam za wstawianie się ten stary wątek, ale zrobiłem kilka istotnych zmian do wielkiego odpowiedź wykonane przez Davy Landman na własne potrzeby. Zmiany są następujące:

• Dodano możliwość wykorzystania ścieżek względnych (oczywiście absolutna i UNC wsparcie ścieżki jest zachowane)
• Dodano możliwość oddzwonienia, aby pokazać postęp kopia jest na ekranie (czytaj dalej) lub anulowanie procesu kopiowania
• Główny kod został trochę oczyszczony. Myślę, że wsparcie dla Unicode został utrzymany, ale ja naprawdę nie wiem, ponieważ używam najnowszej wersji ANSI kompilator Delphi (jeśli ktoś może przetestować to?)

Aby użyć tego kodu, należy utworzyć FastCopy.pas plik w projekcie, a następnie skopiować i wkleić treść:

{ 
    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://stackoverflow.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. 

główną metodą jest nazywany FastCopyFile i masz 4 przeciążone funkcje pasujące do wszystkich potrzeb. Poniżej znajdziesz dwa przykłady pokazujące, jak grać z tą jednostką.

Pierwszym z nich jest najprostszy: po prostu stworzyć Console Application, a następnie skopiować i wkleić następującej treści:

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. 

Jeśli chcesz, zrobiłem aplikację VCL, aby pokazać, w jaki sposób wyświetlić kopię postęp i możliwość przerwania. Ta aplikacja jest wielowątkowa, aby uniknąć zamrożenia GUI. Aby przetestować ten pełniejszy przykład utworzyć nową aplikację VCL następnie użyć poniższy kod:

Unit1.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 

Oczywiście , nie zapomnij dodać do tego projektu odwołania do pliku o nazwie FastCopy.pas.

Powinieneś dostać to:

Wybierz plik źródłowy, plik docelowy następnie uderzył start.

Wszystkie kredyty idą oczywiście na Davy Landman.