Delphi快速文件复制 [英] Delphi fast file copy

问题描述

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

我也试图用缓冲区，但是太慢了。

我正在Win32工作，任何人都有这方面的见解？

解决方案

有几个选项。

1. 您可以调用使用$ b的CopyFile $ b CopyFileA Windows API
   
   
   
   
   • 你可以调用浏览器使用的api（windows api
     SHFileOperation ）。
     调用该函数的示例可以在
     SCIP.be
   
   
   • 您可以编写自己的使用缓冲区的函数。
   
   

如果您知道要复制的文件类型，则第3种方法通常会胜过其他方式。因为Windows API更适合整体最佳情况（小文件，大文件，网络上的文件，慢速驱动器上的文件）。您可以根据自己的需要调整自己的复印功能。

以下是我自己的缓冲复制功能（我已经删除GUI回调）：

  procedure CustomFileCopy（const ASourceFileName，ADestinationFileName：TFileName）; 
 const 
 BufferSize = 1024; // 1KB块，改变它来调整速度
 var 
缓冲区：字节数组; 
 ASourceFile，ADestinationFile：THandle; 
文件大小：DWORD; 
 BytesRead，BytesWritten，BytesWritten2：DWORD; 
 begin 
 SetLength（Buffer，BufferSize）; 
 ASourceFile：= OpenLongFileName（ASourceFileName，0）; 
如果ASourceFile<> 0 then 
 try 
 FileSize：= FileSeek（ASourceFile，0，FILE_END）; 
 FileSeek（ASourceFile，0，FILE_BEGIN）; 
 ADestinationFile：= CreateLongFileName（ADestinationFileName，FILE_SHARE_READ）; 
如果ADestinationFile<> 0 then 
 try 
 while（FileSize  -  FileSeek（ASourceFile，0，FILE_CURRENT））> = BufferSize do 
 begin 
 if（not ReadFile（ASourceFile，Buffer [0] BufferSize，BytesRead，nil））和（BytesRead = 0）然后
继续; 
 WriteFile（ADestinationFile，Buffer [0]，BytesRead，BytesWritten，nil）; 
 if BytesWritten< BytesRead然后
 begin 
 WriteFile（ADestinationFile，Buffer [BytesWritten]，BytesRead  -  BytesWritten，BytesWritten2，nil）; 
 if（BytesWritten2 + BytesWritten）< BytesRead然后
 RaiseLastOSError; 
结束
结束
如果FileSeek（ASourceFile，0，FILE_CURRENT） FileSize然后
 begin 
如果（不是ReadFile（ASourceFile，缓冲区[0]，FileSize  -  FileSeek（ASourceFile，0，FILE_CURRENT），BytesRead，nil））和（BytesRead = 0）然后
 ReadFile（ASourceFile，Buffer [0]，FileSize  -  FileSeek（ASourceFile，0，FILE_CURRENT），BytesRead，nil）; 
 WriteFile（ADestinationFile，Buffer [0]，BytesRead，BytesWritten，nil）; 
 if BytesWritten< BytesRead然后
 begin 
 WriteFile（ADestinationFile，Buffer [BytesWritten]，BytesRead  -  BytesWritten，BytesWritten2，nil）; 
 if（BytesWritten2 + BytesWritten）< BytesRead然后
 RaiseLastOSError; 
结束
结束
 finally 
 CloseHandle（ADestinationFile）; 
结束
 finally 
 CloseHandle（ASourceFile）; 
结束
结束
  

自己的功能：

  function OpenLongFileName（const ALongFileName：String; SharingMode：DWORD）：THandle;超载; 
 begin 
如果CompareMem（@（ALongFileName [1]），@（'\\'[1]），2）然后
 {Allready an UNC path} 
结果：= CreateFileW（PWideChar（WideString（ALongFileName）），GENERIC_READ，SharingMode，nil，OPEN_EXISTING，FILE_ATTRIBUTE_NORMAL，0）
 else 
结果：= CreateFileW（PWideChar（WideString（'\\？ \\'+ ALongFileName）），GENERIC_READ，SharingMode，nil，OPEN_EXISTING，FILE_ATTRIBUTE_NORMAL，0）; 
结束
函数OpenLongFileName（const ALongFileName：WideString; SharingMode：DWORD）：THandle;超载; 
 begin 
如果CompareMem（@（WideCharToString（PWLChar（ALongFileName））），@（'\\'[1]），然后
 {Allready an UNC路径} 
结果：= CreateFileW（PWideChar（ALongFileName），GENERIC_READ，SharingMode，nil，OPEN_EXISTING，FILE_ATTRIBUTE_NORMAL，0）
 else 
结果：= CreateFileW（PWideChar（'\\？ \'+ ALongFileName），GENERIC_READ，SharingMode，nil，OPEN_EXISTING，FILE_ATTRIBUTE_NORMAL，0）; 
结束
 
函数CreateLongFileName（const ALongFileName：String; SharingMode：DWORD）：THandle;超载; 
 begin 
如果CompareMem（@（ALongFileName [1]），@（'\\'[1]），2）然后
 {Allready an UNC path} 
结果：= CreateFileW（PWideChar（WideString（ALongFileName）），GENERIC_WRITE，SharingMode，nil，CREATE_ALWAYS，FILE_ATTRIBUTE_NORMAL，0）
 else 
结果：= CreateFileW（PWideChar（WideString（'\\？ \\'+ ALongFileName）），GENERIC_WRITE，SharingMode，nil，CREATE_ALWAYS，FILE_ATTRIBUTE_NORMAL，0）; 
结束
函数CreateLongFileName（const ALongFileName：WideString; SharingMode：DWORD）：THandle;超载; 
 begin 
如果CompareMem（@（WideCharToString（PWLChar（ALongFileName））），@（'\\'[1]），然后
 {Allready an UNC路径} 
结果：= CreateFileW（PWideChar（ALongFileName），GENERIC_WRITE，SharingMode，nil，CREATE_ALWAYS，FILE_ATTRIBUTE_NORMAL，0）
 else 
结果：= CreateFileW（PWideChar（'\\？ \'+ ALongFileName），GENERIC_WRITE，SharingMode，nil，CREATE_ALWAYS，FILE_ATTRIBUTE_NORMAL，0）; 
结束
  

代码有一点需要，因为我包括一个重试机制来支持WiFi连接问题

所以这部分

 如果BytesWritten< BytesRead然后
 begin 
 WriteFile（ADestinationFile，Buffer [BytesWritten]，BytesRead  -  BytesWritten，BytesWritten2，nil）; 
 if（BytesWritten2 + BytesWritten）< BytesRead然后
 RaiseLastOSError; 
结束
  

可以写成

  if BytesWritten< BytesRead然后
 begin 
 RaiseLastOSError; 
结束
  

I'm writing an app that supposed to copy a bunch of files from one place to another. When I'm using TFileStream for the copy it is 3-4 times slower than copying the files with the OS.

I also tried to copy with a buffer, but that was too slow aswell.

I'm working under Win32, anyone got some insights on this matter?

解决方案

There are a few options.

1. You could call CopyFile which uses the CopyFileA windows API
   • You could call the api which explorer uses (the windows api SHFileOperation). An example of calling that function can be found on SCIP.be
   • You could write your own function which uses a buffer.

If you know the kind of files your going to copy, the 3th method will normally outperform the others. Because the windows API's are more tuned for overall best case (small files, large files, files over network, files on slow drives). You can tune your own copy function more to fit your needs.

Below is my own buffered copy function (i've stripped out the GUI callbacks):

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;

Own functions:

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;

The code is a bit longer that necessary, because I included a retry mechanism to support a wifi connection problem I had.

So this part

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

could be written as

    if BytesWritten < BytesRead then
    begin
        RaiseLastOSError;
    end;

这篇关于Delphi快速文件复制的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！