2009-01-13 98 views
16

我正在写一个应用程序,应该将一堆文件从一个地方复制到另一个地方。 当我使用TFileStream进行复制时,它比使用操作系统复制文件慢3-4倍。德尔福快速文件复制

我也尝试复制一个缓冲区,但这太慢了。

我在Win32下工作,任何人都对此有所了解?

回答

27

有有几个选项。

  1. 你可以调用的CopyFile它采用 的CopyFileA窗口API
    • 你可以调用的API,它Explorer使用(在Windows API SHFileOperation)。调用该函数的 的示例可以在 SCIP.be
    • 上找到您可以编写自己的使用缓冲区的函数。

如果你知道文件的类型等你去复制,这是第3方法通常会优于其他人。因为Windows API更适合整体最佳情况(小文件,大文件,网络文件,慢速文件)。您可以更多地调整自己的复印功能以适应您的需求。

下面是我自己的缓冲拷贝功能(我已经剥离出来的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; 

自己的功能:

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; 

的代码是一个长一点是必要的,因为我包括一个重试机制来支持我的无线连接问题。

所以这部分

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

可以写成

if BytesWritten < BytesRead then 
    begin 
     RaiseLastOSError; 
    end; 
+0

非常感谢你! – 2009-01-13 10:10:13

2

你可以尝试直接调用CopyFile Windows API函数

1

或者你也可以做到这一点“脏”的方式...... 我已经发现了一些旧代码,没有工作(不知道是否是快):

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

首先,我是撞了这个古老的线程抱歉,但我做出了极大的答案有些显著变化由戴维兰德曼为我自己的需要。这些变化是:

  • 加入到使用相对路径(当然绝对和UNC路径的支持保管)
  • 添加回调的能力,以显示该副本的屏幕上进步的可能性(请继续阅读)或取消复制过程
  • 主代码被清理了一下。我认为,支持Unicode保持,但我真的不知道,因为我使用Delphi编译器的最新版本的ANSI(如果任何人都可以测试?)

若要使用此代码,创建一个FastCopy.pas文件在您的项目,然后复制粘贴内容:

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

主要方法被称为FastCopyFile,你必须为每一个需要安装4个重载函数。下面你会看到两个例子,告诉你如何玩这个单位。

第一种是最简单:只需创建一个Console Application,然后复制粘贴以下内容:

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. 

如果你愿意,我做为了一个VCL应用程序向您展示如何显示复制进步和夭折的可能性。此应用程序是多线程的,以避免GUI冻结。为了测试这个更完整的例子,创建一个新的VCL应用程序,然后使用下面的代码:

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 

当然,请不要忘记将FastCopy.pas文件引用添加到该项目中。

你应该得到这样的:

Interface of the FastCopyFile GUI Example

选择源文件,目标文件然后点击开始

所有学分当然去戴维兰德曼