Delphi快速文件复制

时间:2009-01-13 08:01:18

标签: delphi file copy

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

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

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

6 个答案:

答案 0 :(得分:27)

有几个选择。

  1. 您可以调用使用的CopyFile CopyFileA Windows API
    • 你可以调用探险家使用的api(windows api SHFileOperation)。一个例子 调用该函数可以找到 SCIP.be
    • 您可以编写自己的使用缓冲区的函数。
  2. 如果您知道要复制的文件类型,第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;
    

答案 1 :(得分:3)

您可以让资源管理器通过SHFileOperation()http://msdn.microsoft.com/en-us/library/bb762164(VS.85).aspx为您完成(示例代码从delphi执行:http://delphi.icm.edu.pl/ftp/d20free/fileop11.zip

答案 2 :(得分:3)

也许你可以学习Cobian Backup 8(代号为Black Moon)的源代码。它是开源的,用Delphi编写。

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

答案 3 :(得分:2)

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

答案 4 :(得分:2)

首先,我很抱歉打破了这个旧帖子,但我对 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 文件引用添加到该项目中。

你应该得到这个:

Interface of the FastCopyFile GUI Example

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

所有学分当然都归 Davy Landman

答案 5 :(得分: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;