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对话框复制更快。

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

Answer 2

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

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

Answer 3

嗯，我有一个答案 - 但我只是开始挖掘出来:(但是这里无论如何，几年前我写这个作为一个名为“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.

它是一个Object（如你所见）使用它（粗略地）：你需要一些适当命名的变量。声明你的回调：

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

并实施：

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;

然后根据需要打电话:)例如：

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 4

对我来说最好的解决方案（复制20 MB而不是经常）是在Lite版本中使用CopyFileEx。我软的主要目的不是复制。

Delphi：从文件夹中复制文件，总体进度。 CopyFileEx？

4 个答案: