Delphi:从具有总体进度的文件夹中复制文件。复制文件Ex？

Question

我找到了具有进度的 CopyFileEx 示例，但我需要从具有整体进度的文件夹中复制一些文件。

任何人都可以提供如何执行此操作的信息吗？或者有好的替代方案(组件、功能)吗？

非常感谢您的帮助!!!

Answer 1

这是我没有 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 对话框进行复制还要快。

这也是我几年前为其他论坛编写的快速解决方案，它可能包含一些错误。因此使用风险自担；-)