Delphi：フォルダ全体からファイルをコピーします。 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. 

そのオブジェクト（見ての通り）は、それを使用するために（およそ）： あなたは適切な名前のVARSのカップルが必要になります。 があなたのコールバックを宣言します。

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 2

起動する前に、すべてのファイルのファイルサイズを追加してください。個々のファイルの進捗状況を手動で全体的な進捗状況に変換できます。

またはSHFileOperationを使用して、ネイティブOSファイルコピーの進行状況ダイアログを取得します。

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メガバイトをコピーしないために）は、ライトバージョンでCopyFileExを使用することです。私のソフトの主な目的はコピーではありません。