Delphi: Copier des Fichiers à partir du dossier avec le progrès en Général. CopyFileEx?

Bien, j'ai eu une réponse, mais je n'en ai juste eu le temps de creuser ça 🙁 Mais ici, il est de toute façon, j'ai écrit cela il y a quelques années dans le cadre d'un programme qui a été appelé "CopyFilesAndFailGraceFully.exe" 🙂 j'ai modded un peu à côté de la reprise des trucs qui gère à défaut des disques durs si elle peut donc PAS ENTIÈREMENT TESTÉ, mais de l'exécuter comme un simple test.

Vous pouvez appeler pour obtenir un récursif filecount, taille du fichier ou Copier les fichiers dans un dossier vers un nouveau dossier. Ou Mod pour votre situation particulière 🙂 de toute façon c'est un exemple de ce que vous avez besoin.

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.

Son Objet (Comme vous le voyez) pour l'utiliser (en gros):
Vous aurez besoin d'un couple de vars bien nommé.
Déclarer votre rappel:

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

et à mettre en œuvre:

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;

Alors appel en tant que de besoin 🙂 par exemple:

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;

OriginalL'auteur Despatcher

Ajouter la taille de fichier pour tous les fichiers avant de commencer. Ensuite, vous pouvez convertir manuellement les progrès de chaque fichier dans un progrès d'ensemble.

Ou de l'utilisation SHFileOperation et obtenir le système d'exploitation natif de copie de fichier de progression.

OriginalL'auteur David Heffernan