Delphi快速文件复制

Yar*_*ran 16 delphi copy file

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

我也尝试用缓冲区复制,但这太慢了.

我在Win32下工作,有人对此事有一些见解吗?

Dav*_*man 27

有几个选择.

  1. 您可以调用使用CopyFileA Windows API 的CopyFile
    • 你可以调用探险家使用的api(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;
Run Code Online (Sandbox Code Playgroud)

自己的功能:

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;
Run Code Online (Sandbox Code Playgroud)

代码有点长,因为我包含了一个重试机制来支持我的wifi连接问题.

这一部分

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

可写成

    if BytesWritten < BytesRead then
    begin
        RaiseLastOSError;
    end;
Run Code Online (Sandbox Code Playgroud)

  • 请注意,此处显示的所有自制文件复制器都有一个严重的缺点:它们不复制文件的ADS(附加数据流),而只复制文件本身,而Windows API CopyFile或ShFileOperation调用实际上复制所有ADS .没有多少应用程序主动使用ADS,所以如果您知道要复制的文件没有,那就没关系,但要注意,如果使用自制文件复制器并让它复制文件,最终可能会出现无法使用的文件你不知道...... (12认同)

SiZ*_*OUS 5

首先,我很抱歉提出这个旧线程,但我根据自己的需要对戴维·兰德曼(Davy Landman)所做的出色答案做了一些重大更改。变化是:

\n\n
    \n
  • 添加了使用相对路径的可能性(当然保留绝对路径和 UNC 路径支持)
  • \n
  • 添加回调功能,以便在屏幕上显示复制\xe2\x80\x99s进度(继续阅读)或取消复制过程
  • \n
  • 主要代码被清理了一点。我认为 Unicode 支持被保留,但我真的不知道 \xe2\x80\x99 ,因为我 \xe2\x80\x99m 使用最新的 ANSI 版本的 Delphi 编译器(如果有人可以测试吗?)
  • \n
\n\n

要使用此代码,请在项目中创建FastCopy.pas文件,然后复制粘贴内容:

\n\n
{\n  FastCopyFile\n\n  By SiZiOUS 2014, based on the work by Davy Landman\n  www.sizious.com - @sizious - fb.com/sizious - sizious (at) gmail (dot) com\n\n  This unit was designed to copy a file using the Windows API.\n  It\'s faster than using the (old) BlockRead/Write and TFileStream methods.\n\n  Every destination file will be overwritten (by choice), unless you specify\n  the fcfmAppend CopyMode flag. In that case, the source file will be appened to\n  the destination file (instead of overwriting it).\n\n  You have the choice to use a normal procedure callback, method object callback\n  or no callback at all. The callback is used to cancel the copy process and to\n  display the copy progress on-screen.\n\n  Developed and tested under Delphi 2007 (ANSI).\n  If you are using a Unicode version of Delphi (greater than Delphi 2007), may\n  be you need to do some adapations (beware of the WideString type).\n\n  All credits flying to Davy Landman.\n  http://stackoverflow.com/questions/438260/delphi-fast-file-copy   \n}\nunit FastCopy;\n\ninterface\n\nuses\n  Windows, SysUtils;\n\ntype\n  TFastCopyFileMode = (fcfmCreate, fcfmAppend);\n  TFastCopyFileNormalCallback = procedure(const FileName: TFileName;\n    const CurrentSize, TotalSize: LongWord; var CanContinue: Boolean);\n  TFastCopyFileMethodCallback = procedure(const FileName: TFileName;\n    const CurrentSize, TotalSize: LongWord; var CanContinue: Boolean) of object;\n\n// Simplest definition\nfunction FastCopyFile(\n  const ASourceFileName, ADestinationFileName: TFileName): Boolean; overload;\n\n// Definition with CopyMode and without any callbacks\nfunction FastCopyFile(\n  const ASourceFileName, ADestinationFileName: TFileName;\n  CopyMode: TFastCopyFileMode): Boolean; overload;\n\n// Definition with normal procedure callback\nfunction FastCopyFile(\n  const ASourceFileName, ADestinationFileName: TFileName;\n  CopyMode: TFastCopyFileMode;\n  Callback: TFastCopyFileNormalCallback): Boolean; overload;\n\n// Definition with object method callback  \nfunction FastCopyFile(\n  const ASourceFileName, ADestinationFileName: TFileName;\n  CopyMode: TFastCopyFileMode;\n  Callback: TFastCopyFileMethodCallback): Boolean; overload;\n\nimplementation\n\n{ Dummy Callback: Method Version }\ntype\n  TDummyCallBackClient = class(TObject)\n  private\n    procedure DummyCallback(const FileName: TFileName;\n      const CurrentSize, TotalSize: LongWord; var CanContinue: Boolean);\n  end;\n\nprocedure TDummyCallBackClient.DummyCallback(const FileName: TFileName;\n  const CurrentSize, TotalSize: LongWord; var CanContinue: Boolean);\nbegin\n  // Nothing\n  CanContinue := True;\nend;\n\n{ Dummy Callback: Classical Procedure Version }\nprocedure DummyCallback(const FileName: TFileName;\n  const CurrentSize, TotalSize: LongWord; var CanContinue: Boolean);\nbegin\n  // Nothing\n  CanContinue := True;\nend;\n\n{ CreateFileW API abstract layer }\nfunction OpenLongFileName(ALongFileName: string; DesiredAccess, ShareMode,\n  CreationDisposition: LongWord): THandle;\nvar\n  IsUNC: Boolean;\n  FileName: PWideChar;\n\nbegin\n  // Translate relative paths to absolute ones\n  ALongFileName := ExpandFileName(ALongFileName);\n\n  // Check if already an UNC path\n  IsUNC := Copy(ALongFileName, 1, 2) = \'\\\\\';\n  if not IsUNC then\n    ALongFileName := \'\\\\?\\\' + ALongFileName;\n\n  // Preparing the FileName for the CreateFileW API call\n  FileName := PWideChar(WideString(ALongFileName));\n\n  // Calling the API\n  Result := CreateFileW(FileName, DesiredAccess, ShareMode, nil,\n    CreationDisposition, FILE_ATTRIBUTE_NORMAL, 0);\nend;\n\n{ FastCopyFile implementation }\nfunction FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName;\n  CopyMode: TFastCopyFileMode;\n  Callback: TFastCopyFileNormalCallback;\n  Callback2: TFastCopyFileMethodCallback): Boolean; overload;\nconst\n  BUFFER_SIZE = 524288; // 512KB blocks, change this to tune your speed\n\nvar\n  Buffer: array of Byte;\n  ASourceFile, ADestinationFile: THandle;\n  FileSize, BytesRead, BytesWritten, BytesWritten2, TotalBytesWritten,\n  CreationDisposition: LongWord;\n  CanContinue, CanContinueFlag: Boolean;\n\nbegin\n  FileSize := 0;\n  TotalBytesWritten := 0;\n  CanContinue := True;\n  SetLength(Buffer, BUFFER_SIZE);\n\n  // Manage the Creation Disposition flag\n  CreationDisposition := CREATE_ALWAYS;\n  if CopyMode = fcfmAppend then\n    CreationDisposition := OPEN_ALWAYS;\n\n  // Opening the source file in read mode\n  ASourceFile := OpenLongFileName(ASourceFileName, GENERIC_READ, 0, OPEN_EXISTING);\n  if ASourceFile <> 0 then\n  try\n    FileSize := FileSeek(ASourceFile, 0, FILE_END);\n    FileSeek(ASourceFile, 0, FILE_BEGIN);\n\n    // Opening the destination file in write mode (in create/append state)\n    ADestinationFile := OpenLongFileName(ADestinationFileName, GENERIC_WRITE,\n      FILE_SHARE_READ, CreationDisposition);\n\n    if ADestinationFile <> 0 then\n    try\n      // If append mode, jump to the file end\n      if CopyMode = fcfmAppend then\n        FileSeek(ADestinationFile, 0, FILE_END);\n\n      // For each blocks in the source file\n      while CanContinue and (LongWord(FileSeek(ASourceFile, 0, FILE_CURRENT)) < FileSize) do\n      begin\n\n        // Reading from source\n        if (ReadFile(ASourceFile, Buffer[0], BUFFER_SIZE, BytesRead, nil)) and (BytesRead <> 0) then\n        begin\n          // Writing to destination\n          WriteFile(ADestinationFile, Buffer[0], BytesRead, BytesWritten, nil);\n\n          // Read/Write secure code block (e.g. for WiFi connections)\n          if BytesWritten < BytesRead then\n          begin\n            WriteFile(ADestinationFile, Buffer[BytesWritten], BytesRead - BytesWritten, BytesWritten2, nil);\n            Inc(BytesWritten, BytesWritten2);\n            if BytesWritten < BytesRead then\n              RaiseLastOSError;\n          end;\n\n          // Notifying the caller for the current state\n          Inc(TotalBytesWritten, BytesWritten);\n          CanContinueFlag := True;\n          if Assigned(Callback) then\n            Callback(ASourceFileName, TotalBytesWritten, FileSize, CanContinueFlag);\n          CanContinue := CanContinue and CanContinueFlag;\n          if Assigned(Callback2) then\n            Callback2(ASourceFileName, TotalBytesWritten, FileSize, CanContinueFlag);\n          CanContinue := CanContinue and CanContinueFlag;\n        end;\n\n      end;\n\n    finally\n      CloseHandle(ADestinationFile);\n    end;\n\n  finally\n    CloseHandle(ASourceFile);\n  end;\n\n  // Check if cancelled or not\n  if not CanContinue then\n    if FileExists(ADestinationFileName) then\n      DeleteFile(ADestinationFileName);\n\n  // Results (checking CanContinue flag isn\'t needed)\n  Result := (FileSize <> 0) and (FileSize = TotalBytesWritten); \nend;\n\n{ FastCopyFile simple definition }\nfunction FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName): Boolean; overload;\nbegin\n  Result := FastCopyFile(ASourceFileName, ADestinationFileName, fcfmCreate);\nend;\n\n{ FastCopyFile definition without any callbacks }\nfunction FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName;\n  CopyMode: TFastCopyFileMode): Boolean; overload;\nbegin\n  Result := FastCopyFile(ASourceFileName, ADestinationFileName, CopyMode,\n    DummyCallback);\nend;\n\n{ FastCopyFile definition with normal procedure callback }\nfunction FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName;\n  CopyMode: TFastCopyFileMode;\n  Callback: TFastCopyFileNormalCallback): Boolean; overload;\nvar\n  DummyObj: TDummyCallBackClient;\n\nbegin\n  DummyObj := TDummyCallBackClient.Create;\n  try\n    Result := FastCopyFile(ASourceFileName, ADestinationFileName, CopyMode,\n      Callback, DummyObj.DummyCallback);\n  finally\n    DummyObj.Free;\n  end;\nend;\n\n{ FastCopyFile definition with object method callback }\nfunction FastCopyFile(const ASourceFileName, ADestinationFileName: TFileName;\n  CopyMode: TFastCopyFileMode;\n  Callback: TFastCopyFileMethodCallback): Boolean; overload;\nbegin\n  Result := FastCopyFile(ASourceFileName, ADestinationFileName, CopyMode,\n    DummyCallback, Callback);\nend;\n\nend.\n
Run Code Online (Sandbox Code Playgroud)\n\n

main 方法被调用FastCopyFile,并且您有 4 个重载函数来满足每种需求。下面您将找到两个示例,向您展示如何使用该装置。

\n\n

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

\n\n
program Project1;\n\n{$APPTYPE CONSOLE}\n\nuses\n  SysUtils,\n  fastcopy in \'fastcopy.pas\';\n\nbegin\n  try\n    WriteLn(\'FastCopyFile Result: \', FastCopyFile(\'test2.bin\', \'test.bin\'));\n    WriteLn(\'Strike the <ENTER> key to exit...\');\n    ReadLn;\n  except\n    on E:Exception do\n      Writeln(E.Classname, \': \', E.Message);\n  end;\nend.\n
Run Code Online (Sandbox Code Playgroud)\n\n

如果您愿意,我制作了一个 VCL 应用程序来向您展示如何显示复制进度和中止可能性。该应用程序是多线程的,以避免 GUI 冻结。要测试这个更完整的示例,请创建一个新的 VCL 应用程序,然后使用以下代码:

\n\n

Unit1.pas:

\n\n
unit Unit1;\n\ninterface\n\nuses\n  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,\n  Dialogs, ComCtrls, StdCtrls, ExtCtrls, FastCopy;\n\ntype\n  TFastCopyFileThread = class;\n\n  TForm1 = class(TForm)\n    Button1: TButton;\n    ProgressBar1: TProgressBar;\n    Label1: TLabel;\n    Button2: TButton;\n    RadioGroup1: TRadioGroup;\n    GroupBox1: TGroupBox;\n    Edit1: TEdit;\n    GroupBox2: TGroupBox;\n    Edit2: TEdit;\n    OpenDialog1: TOpenDialog;\n    SaveDialog1: TSaveDialog;\n    Button3: TButton;\n    Button4: TButton;\n    procedure Button1Click(Sender: TObject);\n    procedure Button2Click(Sender: TObject);\n    procedure FormCreate(Sender: TObject);\n    procedure Button3Click(Sender: TObject);\n    procedure Button4Click(Sender: TObject);\n  private\n    { D\xc3\xa9clarations priv\xc3\xa9es }\n    fFastCopyFileThread: TFastCopyFileThread;\n    fFastCopyFileThreadCanceled: Boolean;\n    procedure ChangeControlsState(State: Boolean);\n    procedure FastCopyFileProgress(Sender: TObject; FileName: TFileName;\n      Value: Integer; var CanContinue: Boolean);\n    procedure FastCopyFileTerminate(Sender: TObject);\n    function GetStatusText: string;\n    procedure SetStatusText(const Value: string);\n  public\n    { D\xc3\xa9clarations publiques }\n    procedure StartFastCopyThread;\n    property StatusText: string read GetStatusText write SetStatusText;\n  end;\n\n  TFastCopyFileProgressEvent = procedure(Sender: TObject; FileName: TFileName;\n    Value: Integer; var CanContinue: Boolean) of object;\n\n  TFastCopyFileThread = class(TThread)\n  private\n    fSourceFileName: TFileName;\n    fDestinationFileName: TFileName;\n    fProgress: TFastCopyFileProgressEvent;\n    fCopyMode: TFastCopyFileMode;\n    procedure FastCopyFileCallback(const FileName: TFileName;\n      const CurrentSize, TotalSize: LongWord; var CanContinue: Boolean);\n  protected\n    procedure Execute; override;\n  public\n    constructor Create; overload;\n    property SourceFileName: TFileName\n      read fSourceFileName write fSourceFileName;\n    property DestinationFileName: TFileName\n      read fDestinationFileName write fDestinationFileName;\n    property CopyMode: TFastCopyFileMode read fCopyMode write fCopyMode;\n    property OnProgress: TFastCopyFileProgressEvent\n      read fProgress write fProgress;\n  end;  \n\nvar\n  Form1: TForm1;\n\nimplementation\n\n{$R *.dfm}\n\n{ TForm1 }\n\nprocedure TForm1.Button1Click(Sender: TObject);\nbegin\n  StartFastCopyThread;\nend;\n\nprocedure TForm1.Button2Click(Sender: TObject);\nbegin\n  fFastCopyFileThread.Terminate;\n  fFastCopyFileThreadCanceled := True;\nend;\n\nprocedure TForm1.Button3Click(Sender: TObject);\nbegin\n  with OpenDialog1 do\n    if Execute then\n      Edit1.Text := FileName;\nend;\n\nprocedure TForm1.Button4Click(Sender: TObject);\nbegin\n  with SaveDialog1 do\n    if Execute then\n      Edit2.Text := FileName;\nend;\n\nprocedure TForm1.ChangeControlsState(State: Boolean);\nbegin\n  Button1.Enabled := State;\n  Button2.Enabled := not State;\n  if State then\n  begin\n    if fFastCopyFileThreadCanceled then\n      StatusText := \'Aborted!\'\n    else\n      StatusText := \'Done!\';\n    fFastCopyFileThreadCanceled := False;\n  end;\nend;\n\nprocedure TForm1.FastCopyFileProgress(Sender: TObject; FileName: TFileName;\n  Value: Integer; var CanContinue: Boolean);\nbegin\n  StatusText := ExtractFileName(FileName);\n  ProgressBar1.Position := Value;\nend;\n\nprocedure TForm1.FastCopyFileTerminate(Sender: TObject);\nbegin\n  ChangeControlsState(True);\nend;\n\nprocedure TForm1.FormCreate(Sender: TObject);\nbegin\n  ChangeControlsState(True);\n  StatusText := \'Idle...\';\nend;\n\nfunction TForm1.GetStatusText: string;\nbegin\n  Result := Label1.Caption;\nend;\n\nprocedure TForm1.SetStatusText(const Value: string);\nbegin\n  Label1.Caption := Value;\nend;\n\nprocedure TForm1.StartFastCopyThread;\nbegin\n  ChangeControlsState(False);\n  fFastCopyFileThread := TFastCopyFileThread.Create;\n  with fFastCopyFileThread do\n  begin\n    SourceFileName := Edit1.Text;\n    DestinationFileName := Edit2.Text;\n    CopyMode := TFastCopyFileMode(RadioGroup1.ItemIndex);\n    OnProgress := FastCopyFileProgress;\n    OnTerminate := FastCopyFileTerminate;\n    Resume;\n  end;\nend;\n\n{ TFastCopyFileThread }\n\nconstructor TFastCopyFileThread.Create;\nbegin\n  inherited Create(True);\n  FreeOnTerminate := True;\nend;\n\nprocedure TFastCopyFileThread.Execute;\nbegin\n  FastCopyFile(SourceFileName, DestinationFileName, CopyMode,\n    FastCopyFileCallback);\nend;\n\nprocedure TFastCopyFileThread.FastCopyFileCallback(const FileName: TFileName;\n  const CurrentSize, TotalSize: LongWord; var CanContinue: Boolean);\nvar\n  ProgressValue: Integer;\n\nbegin\n  CanContinue := not Terminated;\n  ProgressValue := Round((CurrentSize / TotalSize) * 100);\n  if Assigned(OnProgress) then\n    OnProgress(Self, FileName, ProgressValue, CanContinue);\nend;\n\nend.\n
Run Code Online (Sandbox Code Playgroud)\n\n

单元1.dfm:

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

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

\n\n

你应该得到这个:

\n\n

FastCopyFile GUI 示例的界面

\n\n

选择源文件、目标文件,然后单击“开始”。

\n\n

所有功劳当然都归功于戴维·兰德曼。

\n