Delphi：从文件夹复制文件与总体进度。 CopyFileEx？ [英] Delphi: Copy Files from folder with Overall progress. CopyFileEx?

问题描述

我发现CopyFileEx有进度的例子，但我需要从一个文件夹中复制一些文件与总体进展。

I have found examples of CopyFileEx with progress, but I need to copy some files from a folder with overall progress.

任何人都可以提供信息如何做到这一点？

Can anybody provide info how to do this? Or is there good alternative (component, function)?

推荐答案

方案

好吧，我有一个答案 - 但我只是刚刚开始挖掘:(但这里它是反正，我写了这几年前作为程序的一部分，称为CopyFilesAndFailGraceFully .exe:)我已经修改了一些错过恢复的东西处理失败的硬盘驱动器，如果可以 - 所以不完全测试，但运行作为一个简单的测试。

Well, I had an answer - but I only just got around to digging it out :( But here it is anyway, I wrote this a few years ago as part of a program that was called "CopyFilesAndFailGraceFully.exe" :) I've modded it a bit to miss out the recovery stuff that handles failing hard drives if it can - so NOT FULLY TESTED but run as a simple test.

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

You can call it to get a recursive filecount, filesize or Copy the files in a folder to a new folder. Or Mod for your own situation :) Anyway its an example of what you need.

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.

它的一个对象（如你所见）使用它（大致）：
需要几个适当命名的vars。
声明您的回调：

Its an Object (As you see) to use it (roughly): You will need a couple of vars appropriately named. Declare your callback:

  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;

然后根据需要调用:)例如：

Then call as needed :) e.g.:

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;

这篇关于Delphi：从文件夹复制文件与总体进度。 CopyFileEx？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！