16

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

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

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

4

6 回答 6

28

有几个选项。

  1. 您可以调用使用CopyFileA windows API 的 CopyFile

如果您知道要复制的文件类型,第三种方法通常会优于其他方法。因为 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;
于 2009-01-13T08:28:42.023 回答
4

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

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

于 2009-01-13T08:14:18.107 回答
4

首先,我很抱歉碰到这个旧线程,但我对戴维兰德曼为我自己的需要做出的伟大答案做了一些重大改变。这些变化是:

  • 添加了使用相对路径的可能性(当然保留了绝对和 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.

调用 main 方法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.

单元 1.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文件引用添加到该项目。

你应该得到这个:

FastCopyFile GUI 示例界面

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

所有的功劳当然要归功于戴维兰德曼

于 2014-08-20T10:21:48.023 回答
3

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

于 2009-01-13T08:09:06.807 回答
2

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

于 2009-01-13T08:10:51.407 回答
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;
于 2009-01-13T08:14:53.067 回答