Delphi: Kopieren von Dateien aus dem Ordner mit den Gesamten Fortschritt. CopyFileEx?

Gut, ich hatte eine Antwort - aber ich hab nur gerade um zu Graben es aus 🙁 Aber hier ist es sowieso, ich schrieb das vor ein paar Jahren als Teil eines Programms, das aufgerufen wurde "CopyFilesAndFailGraceFully.exe" 🙂 ich habe modded es ein bisschen zu entgehen, den recovery-Kram, Griffe versagende Festplatten, wenn Sie es können - also NICHT VOLL GETESTET, aber laufen wie ein einfacher test.

Können Sie aufrufen, bekommen Sie eine rekursive filecount, Dateigröße oder Kopieren Sie die Dateien in einem Ordner in einen neuen Ordner. Oder eine Mod für Ihre eigene situation 🙂 wie auch immer sein ein Beispiel für das, was Sie brauchen.

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.

Seine ein Objekt (Wie Sie sehen), es zu benutzen (in etwa):
Brauchen Sie ein paar vars entsprechend benannt.
Erklären Sie Ihre callback:

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

und Umsetzung:

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;

Dann rufen Sie Sie nach Bedarf 🙂 z.B.:

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;

Hinzufügen, bis die Größe der Datei für alle Dateien, bevor Sie beginnen. Dann können Sie manuell konvertieren Sie die Fortschritte für jede einzelne Datei in einen Allgemeinen Fortschritt.

Oder verwenden Sie SHFileOperation und erhalten die native OS-Datei-kopieren-Fortschritts-Dialoge.