【问题标题】:Delphi fast file copyDelphi快速文件复制
【发布时间】:2009-01-13 08:01:17
【问题描述】:

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

我也尝试使用缓冲区进行复制,但这也太慢了。

我在Win32下工作,有人对这个问题有所了解吗?

【问题讨论】:

    标签: delphi file copy


    【解决方案1】:

    有几个选项。

    1. 您可以调用 CopyFile 它使用 CopyFileA windows API
      • 你可以调用资源管理器使用的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;
    

    自有功能:

    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;
    

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

    所以这部分

        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;
    

    【讨论】:

    • 请注意,这里显示的所有自制文件复制器都有一个严重的缺点:它们不会复制文件的 ADS(附加数据流),而只会复制文件本身,而 Windows API CopyFile或 ShFileOperation 调用实际上沿所有 ADS 复制。积极使用 ADS 的应用程序并不多,因此如果您知道要复制的文件不使用,那很好,但请注意,如果您使用自制的文件复印机并让它复制文件,您最终可能会得到无法使用的文件你不知道...
    • ADS = 备用 (!) 数据流
    【解决方案2】:

    或许你可以研究一下 Cobian Backup 8(代号为 Black Moon)的源代码。它是开源的,用 Delphi 编写。

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

    【讨论】:

    【解决方案3】:

    首先,我很抱歉碰到这个旧线程,但我对 Davy Landman 为我自己的需要所做的出色回答做了一些重大更改。变化是:

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

    要使用此代码,请在您的项目中创建一个 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 文件引用添加到该项目。

    你应该得到这个:

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

    所有功劳当然归 Davy Landman

    【讨论】:

      【解决方案4】:

      您可以通过 SHFileOperation() http://msdn.microsoft.com/en-us/library/bb762164(VS.85).aspx 让 Explorer 为您执行此操作(来自 delphi 的示例代码:http://delphi.icm.edu.pl/ftp/d20free/fileop11.zip

      【讨论】:

        【解决方案5】:

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

        【讨论】:

          【解决方案6】:

          或者你可以用“肮脏”的方式来做...... 我发现了一些可以完成这项工作的旧代码(不确定它是否很快):

          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;
          

          【讨论】:

            猜你喜欢
            • 2018-07-04
            • 2014-03-31
            • 1970-01-01
            • 2010-10-02
            • 2018-02-12
            • 1970-01-01
            • 1970-01-01
            • 2011-12-15
            • 2016-06-29
            相关资源
            最近更新 更多