Delphi schnelle Dateikopie

Question

Ich schreibe eine App, die eine Reihe von Dateien von einem Ort zum anderen kopieren soll. Wenn ich TFileStream für die Kopie verwende, ist es 3-4 Mal langsamer als das Kopieren der Dateien mit dem Betriebssystem.

Ich habe auch versucht, mit einem Puffer zu kopieren, aber das war auch zu langsam.

Ich arbeite unter Win32, hat jemand Einblick in diese Angelegenheit?

Answer 1

Es sind ein paar Optionen.

1. Sie könnten Copyfile aufrufen, die verwendet die CopyFileA Windows-API
   • Sie konnten die api nennen die Explorer verwendet (die Fenster api SHFileOperation). Ein Beispiel für Aufruf dieser Funktion finden Sie unter SCIP.be
   • Sie könnten Ihre eigene Funktion schreiben, die einen Puffer verwendet.

Wenn Sie die Art von Dateien Sie zu kopieren wissen, die 3. Methode wird in der Regel übertrifft die andere. Weil die Windows-APIs besser auf den besten Fall abgestimmt sind (kleine Dateien, große Dateien, Dateien über das Netzwerk, Dateien auf langsamen Laufwerken). Sie können Ihre eigene Kopierfunktion mehr auf Ihre Bedürfnisse abstimmen.

unten meine eigene gepufferte Kopierfunktion (ich habe die GUI Rückrufe zu):

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; 

Eigene Funktionen:

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; 

Der Code ist ein bisschen länger, dass notwendig, weil ich enthielt einen Wiederholungsmechanismus, um ein WLAN-Verbindungsproblem zu unterstützen, das ich hatte.

So ist dieser Teil

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

könnte als

if BytesWritten < BytesRead then 
    begin 
     RaiseLastOSError; 
    end; 

Answer 2

können Sie haben Explorer es für Sie tun über SHFileOperation() http://msdn.microsoft.com/en-us/library/bb762164(VS.85).aspx (Beispiel-Code aus delphi tun: http://delphi.icm.edu.pl/ftp/d20free/fileop11.zip)

Answer 3

Sie könnten versuchen, direkt den Aufruf der CopyFile Windows-API-Funktion

Answer 4

Vielleicht können Sie Cobian studieren Backup 8 (Codename Black Moon) Quellcode. Es ist Opensource, geschrieben in Delphi.

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

Answer 5

Oder Sie können ihm die „schmutzige“ Art und Weise tun ... Ich habe einigen alten Code gefunden, der die Arbeit erledigt (nicht sicher, ob es schnell ist):

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

Zunächst einmal geschrieben werden, tut mir leid für diesen alten Thread stoßen, aber ich habe einige wesentliche Änderungen an der große Antwort gemacht von Davy Landman für meine eigenen Bedürfnisse. Die Änderungen sind:

• Added die Möglichkeit, relative Pfade zu verwenden (natürlich absolute und UNC-Pfade Unterstützung gehalten)
• Added die Callback-Fähigkeit, um die Kopie des Fortschritts auf dem Bildschirm zu zeigen (lesen Sie) oder Abbrechen des Kopiervorgangs
• Der Hauptcode wurde ein wenig gereinigt. Ich denke, die Unicode-Unterstützung gehalten wurde, aber ich weiß wirklich nicht, da ich die aktuelle ANSI-Version des Delphi-Compilers bin mit (wenn jemand das testen kann?)

diesen Code zu verwenden, erstellen Sie ein FastCopy.pas Datei in Ihrem Projekt, dann copy-paste den Inhalt:

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

die wichtigste Methode aufgerufen wird FastCopyFile und Sie haben vier überladene Funktionen für alle Bedürfnisse passt. Im Folgenden finden Sie zwei Beispiele, wie Sie mit dieser Einheit spielen können.

Die erste ist die einfachste: erstellen Sie einfach eine Console Application, dann copy-paste die folgenden Inhalte:

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. 

Wenn Sie wollen, habe ich eine VCL-Anwendung, um Ihnen zu zeigen, wie die Kopie angezeigt werden Fortschritt und die Abbruchmöglichkeit. Diese Anwendung ist multi-threaded, um das Einfrieren der GUI zu vermeiden. Um dieses vollständigeres Beispiel zu testen, erstellen Sie eine neue VCL-Anwendung dann unter den Code verwenden:

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 

Natürlich Vergessen Sie nicht, den Dateiverweis FastCopy.pas diesem Projekt hinzuzufügen.

Sie sollten diese:

Wählen Sie eine Quelldatei, eine Zieldatei drücken Sie dann starten.

Alle Credits gehen natürlich zu Davy Landman.