德尔福：从总体进度的文件夹复制文件。 CopyFileEx？

Question

我已经找到了带有进度的CopyFileEx的例子，但是我需要从整体进度的文件夹中复制一些文件。

任何人都可以提供信息如何做到这一点？还是有很好的选择（组件，功能）？

非常感谢您的帮助！

Answer 1

好使用，我有一个答案 - 但我刚刚得到周围挖掘出来:(但这里是反正，我几年前写了这个作为程序的一部分被称为“CopyFilesAndFailGraceFully.exe” :)我已经改装成有点错过了一个处理失败，如果它可以硬盘恢复的东西 - 所以没有充分测试，但运行一个简单的测试。

您可以调用它来获取递归文件计数，文件大小或将文件夹中的文件复制到新文件夹。或Mod适合你自己的情况:)无论如何，它是你需要的一个例子。

unit FileCopierU; 
(*************************************************************** 
    Author Despatcher (Timbo) 2011 
****************************************************************) 
interface 

uses 
    Windows, Messages, SysUtils, Classes, controls, stdctrls, strUtils, ComCtrls, ShellApi, Math; 

Type 
    TFolderOp = (foCopy, foCount, foSize); 
    TCopyCallBack = function(TotalFileSize, TotalBytesTransferred, StreamSize, StreamBytesTransferred: int64; 
          StreamNumber, CallbackReason: Dword; 
          SourceFile, DestinationFile: THandle; Data: Pointer): DWord; 

    TFileCopier = class(TPersistent) 
    private 
    fCopyCount: Integer; 
    fFileCount: Integer; 
    fFileSize: Int64; 
    fCallBack: TCopyCallBack; 
    function DoFolderFiles(const ASourcePath, ATargetPath: string; const Op: TFolderOp): Int64; 
    function DoFolderTree(const ASourcePath, ATargetPath: string; const Op: TFolderOp): Int64; 
    public 
    constructor Create; virtual; 
    function AddBackSlash(const S: String): string; 
    function DoFiles(const ASourcePath, ATargetPath: string; const Op: TFolderOp): Int64; 
    property CallBack: TCopyCallBack read fCallBack write fCallBack; 
    property CopyCount: Integer read fCopyCount; 
    property FileCount: Integer read fFileCount; 
    property FileSize: Int64 read fFileSize; 
    end; 

implementation 

{ TFileCopier } 

function TFileCopier.AddBackSlash(const S: String): string; 
begin 
    Result := S; 
    if S <> '' then 
    begin 
    If S[length(S)] <> '\' then 
     Result := S + '\'; 
    end 
    else 
    Result := '\'; 
end; 

function TFileCopier.DoFiles(const ASourcePath, ATargetPath: string; 
    const Op: TFolderOp): Int64; 
begin 
    case Op of 
    foCopy: fCopyCount := 0; 
    foCount: fFileCount := 0; 
    foSize: fFileSize:= 0; 
    end; 
    Result := DoFolderTree(ASourcePath, ATargetPath, Op); 
end; 

constructor TFileCopier.Create; 
begin 
    inherited; 
    CallBack := nil; 
end; 

function TFileCopier.DoFolderFiles(const ASourcePath, ATargetPath: string; 
            const Op: TFolderOp): Int64; 
// Return -1: failed/error x: count of to or count of copied or Size of all files 
// Root paths must exist 
var 
    StrName, 
    MySearchPath, 
    MyTargetPath, 
    MySourcePath: string; 
    FindRec: TSearchRec; 
    i: Integer; 
    Cancelled: Boolean; 
    Attributes: WIN32_FILE_ATTRIBUTE_DATA; 
begin 
    Result := 0; 
    Cancelled := False; 
    MyTargetPath := AddBackSlash(ATargetPath); 
    MySourcePath := AddBackSlash(ASourcePath); 
    MySearchPath := AddBackSlash(ASourcePath) + '*.*'; 
    i := FindFirst(MySearchPath, 0 , FindRec); 
    try 
    while (i = 0) and (Result <> -1) do 
    begin 
     try 
     case op of 
     foCopy: begin 
      StrName := MySourcePath + FindRec.Name; 
      if CopyFileEx(PWideChar(StrName), PWideChar(MyTargetPath + FindRec.Name), @fCallBack, nil, @Cancelled, COPY_FILE_FAIL_IF_EXISTS) then 
      begin 
      inc(Result); 
      inc(fCopyCount); 
      end 
      else 
      Result := -1; 
     end; 
     foCount: 
     begin 
     Inc(Result); 
     Inc(fFileCount); 
     end; 
     foSize: 
     begin 
     Result := Result + FindRec.Size; 
     fFileSize := fFileSize + FindRec.Size; 
     end; 
     end; // case 
     except 
     Result := -1; 
     end; 
     i := FindNext(FindRec); 
    end; 
    finally 
    FindClose(FindRec); 
    end; 

end; 

function TFileCopier.DoFolderTree(const ASourcePath, ATargetPath: string; 
            const Op: TFolderOp): Int64; 
// Return -1: failed/error x: count of to or count of copied or Size of all files 
// Root paths must exist 
// Recursive 
var 
    FindRec: TSearchRec; 
    StrName, StrExt, 
    MySearchPath, 
    MyTargetPath, 
    MySourcePath: string; 
    InterimResult :Int64; 
    i: Integer; 
begin 
    Result := 0; 
    // Find Folders 
    MySearchPath := AddBackSlash(ASourcePath) + '*.*'; 
    MySourcePath := AddBackSlash(ASourcePath); 
    MyTargetPath := AddBackSlash(ATargetPath); 
    i := FindFirst(MySearchPath, faDirectory , FindRec); 
    try 
    while (i = 0) and (Result <> -1) do 
    begin 
     StrName := FindRec.Name; 
     if (Bool(FindRec.Attr and faDirectory)) and (StrName <> '.') and (StrName <> '..') then 
     begin 
     try 
      case op of 
      foCopy: 
      if CreateDir(MyTargetPath + StrName) then 
       begin 
       InterimResult := DoFolderTree(MySourcePath + StrName, MyTargetPath + StrName, Op); 
       if InterimResult <> -1 then 
       begin 
        Result := Result + InterimResult; 
        fCopyCount := Result; 
       end 
       else 
        Result := -1; 
       end; // foCopy 
      foCount, foSize: 
      begin 
      InterimResult := DoFolderTree(MySourcePath + StrName, MyTargetPath + StrName, Op); 
      if InterimResult <> -1 then 
       Result := Result + InterimResult 
      else 
       Result := -1; // or result, -1 easier to read 
      end; // foCount, foSize 
      end; // case 
     except 
      Result := -1; 
     end; 
     end; 
     i := FindNext(FindRec); 
    end; 
    finally 
    FindClose(FindRec); 
    end; 
    if Result <> -1 then 
    case op of 
    foCopy: 
    begin 
    InterimResult := DoFolderFiles(AddBackSlash(ASourcePath), AddBackSlash(ATargetPath), Op); 
    if InterimResult <> -1 then 
    begin 
     Result := Result + InterimResult; 
     fCopyCount := Result; 
    end 
    else 
     Result := InterimResult; 
    end; 
    foCount: 
    begin 
    InterimResult := DoFolderFiles(AddBackSlash(ASourcePath), AddBackSlash(ATargetPath), Op); 
    if InterimResult <> -1 then 
    begin 
     Result := Result + InterimResult; 
     fFileCount := Result; 
    end 
    else 
     Result := InterimResult; 
    end; // foCount 
    foSize: 
    begin 
    InterimResult := DoFolderFiles(AddBackSlash(ASourcePath), AddBackSlash(ATargetPath), Op); 
    if InterimResult <> -1 then 
    begin 
     Result := Result + InterimResult; 
     fFileSize := Result; 
    end 
    else 
     Result := InterimResult; 
    end; // foSize 
    end; // case 
end; 


end. 

它的对象（正如你看到的）使用它（大约）： 你需要一对夫妇瓦尔适当命名的。 声明回调：

function CallBack(TotalFileSize, TotalBytesTransferred, StreamSize, StreamBytesTransferred: int64; StreamNumber, CallbackReason: Dword; SourceFile, DestinationFile: THandle; Data: Pointer): DWord; 

和实施：

procedure TForm1.Button1Click(Sender: TObject); 
var 
    Copier: TFileCopier; 
begin 
    Copier:= TFileCopier.Create; 
    try 
    Copier.CallBack := CallBack; 
    CopyStream := 1; 
    CopyCount := 0; 
    Copier.DoFiles(MyCopyFolder, MyTargetFolder, foCount); 
    Copier.DoFiles(MyCopyFolder, MyTargetFolder, foSize); 
    Copier.DoFiles(MyCopyFolder, MyTargetFolder, foCopy); 
    finally 
    lblCount.Caption := 'Copied: ' + IntToStr(Copier.CopyCount) + ' Size: ' + IntToStr(Copier.FileSize) + ' Total: ' + IntToStr(Copier.FileCount); 
    Copier.Free; 
    end; 
end; 

Answer 2

在开始之前将所有文件的文件大小相加。然后，您可以手动将每个文件的进度转换为整体进度。

或使用SHFileOperation并获取本机操作系统文件复制进度对话框。

Answer 3

这里是我没有WinApi的解决方案。

首先，复制一个文件中的程序：

procedure CopyFileWithProgress(const AFrom, ATo: String; var AProgress: TProgressBar); 
var 
    FromF, ToF: file; 
    NumRead, NumWritten, DataSize: Integer; 
    Buf: array[1..2048] of Char; 
begin 
    try 
    DataSize := SizeOf(Buf); 
    AssignFile(FromF, AFrom); 
    Reset(FromF, 1); 
    AssignFile(ToF, ATo); 
    Rewrite(ToF, 1); 
    repeat 
    BlockRead(FromF, Buf, DataSize, NumRead); 
    BlockWrite(ToF, Buf, NumRead, NumWritten); 
    if Assigned(AProgress) then 
    begin 
     AProgress.Position := AProgress.Position + DataSize; 
     Application.ProcessMessages; 
    end; 
    until (NumRead = 0) or (NumWritten <> NumRead); 
    finally 
    CloseFile(FromF); 
    CloseFile(ToF); 
    end; 
end; 

现在，从目录中收集文件和计算它们的进步总大小。 请注意，该过程需要一个TStringList类的实例，其中将存储文件路径。

procedure GatherFilesFromDirectory(const ADirectory: String; 
    var AFileList: TStringList; out ATotalSize: Int64); 
var 
    SR: TSearchRec; 
begin 
    if FindFirst(ADirectory + '\*.*', faDirectory, sr) = 0 then 
    begin 
    repeat 
     if ((SR.Attr and faDirectory) = SR.Attr) and (SR.Name <> '.') and (SR.Name <> '..') then 
     GatherFilesFromDirectory(ADirectory + '\' + Sr.Name, AFileList, ATotalSize); 
    until FindNext(SR) <> 0; 
    FindClose(SR); 
    end; 

    if FindFirst(ADirectory + '\*.*', 0, SR) = 0 then 
    begin 
    repeat 
     AFileList.Add(ADirectory + '\' + SR.Name); 
     Inc(ATotalSize, SR.Size); 
    until FindNext(SR) <> 0; 
    FindClose(SR); 
    end; 
end; 

最后的使用例子：

procedure TfmMain.btnCopyClick(Sender: TObject); 
var 
    FileList: TStringList; 
    TotalSize: Int64; 
    i: Integer; 
begin 
    TotalSize := 0; 
    FileList := TStringList.Create; 
    try 
    GatherFilesFromDirectory('C:\SomeSourceDirectory', FileList, TotalSize); 
    pbProgress.Position := 0; 
    pbProgress.Max := TotalSize; 
    for i := 0 to FileList.Count - 1 do 
    begin 
     CopyFileWithProgress(FileList[i], 'C:\SomeDestinationDirectory\' + ExtractFileName(FileList[i]), pbProgress); 
    end; 
    finally 
    FileList.Free; 
    end; 
end; 

与缓冲区的大小做实验我提高性能。然而，它现在是相当快的。也许比用这个臃肿的Vista/Win 7对话框复制还要快。

此外这是我几年前为其他论坛写的快速解决方案，它可能包含一些错误。因此，在自己的风险;-)

Answer 4

，我（的最佳解决方案经常复制20 MB，而不是：

function CallBack(TotalFileSize, TotalBytesTransferred, StreamSize, StreamBytesTransferred: int64; 
          StreamNumber, CallbackReason: Dword; 
          SourceFile, DestinationFile: THandle; 
          Data: Pointer): DWord; 
begin 
    if CopyStream <> StreamNumber then 
    begin 
    inc(CopyCount); 
    CopyStream := StreamNumber; 
    end; 
    Result := PROGRESS_CONTINUE; 
    Form1.lblCount.Caption := 'Copied' + IntToStr(CopyCount); 
    application.ProcessMessages; 
end; 

需要:)例如，然后调用）是在Lite版本中使用CopyFileEx。我的软件的主要目的不是复制。