如何带进度条複製一個非空文件夾？不是windows自帶的進度條。。

...copy a file using a progressbar?

Author: Thomas Stutz

http://www.swissdelphicenter.ch/torry/showcode.php?id=330

1. }

{
You need a TProgressBar on your form for this tip.
Für diesen Tip wird eine TProgressBar benötigt.
}


procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string);
var
FromF, ToF: file of byte;
Buffer: array[0..4096] of char;
NumRead: integer;
FileLength: longint;
begin
AssignFile(FromF, Source);
reset(FromF);
AssignFile(ToF, Destination);
rewrite(ToF);
FileLength := FileSize(FromF);
with Progressbar1 do
begin
Min := 0;
Max := FileLength;
while FileLength > 0 do
begin
BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
FileLength := FileLength - NumRead;
BlockWrite(ToF, Buffer[0], NumRead);
Position := Position NumRead;
end;
CloseFile(FromF);
CloseFile(ToF);
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
CopyFileWithProgressBar1('c:\Windows\Welcome.exe', 'c:\temp\Welcome.exe');
end;

{ 2. }

{***************************************}

// To show the estimated time to copy a file:

procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string);
var
FromF, ToF: file of byte;
Buffer: array[0..4096] of char;
NumRead: integer;
FileLength: longint;
t1, t2: DWORD;
maxi: integer;
begin
AssignFile(FromF, Source);
reset(FromF);
AssignFile(ToF, Destination);
rewrite(ToF);
FileLength := FileSize(FromF);
with Progressbar1 do
begin
Min := 0;
Max := FileLength;
t1 := TimeGetTime;
maxi := Max div 4096;
while FileLength > 0 do
begin
BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
FileLength := FileLength - NumRead;
BlockWrite(ToF, Buffer[0], NumRead);
t2 := TimeGetTime;
Min := Min 1;
// Show the time in Label1
label1.Caption := FormatFloat('0.00', ((t2 - t1) / min * maxi - t2 t1) / 100);
Application.ProcessMessages;
Position := Position NumRead;
end;
CloseFile(FromF);
CloseFile(ToF);
end;
end;

{ 3. }
{***************************************}
// To show the estimated time to copy a file, using a callback function:

type
TCallBack = procedure(Position, Size: Longint); { export; }

procedure FastFileCopy(const InFileName, OutFileName: string;
CallBack: TCallBack);


implementation

procedure FastFileCopyCallBack(Position, Size: Longint);
begin
Form1.ProgressBar1.Max := Size;
Form1.ProgressBar1.Position := Position;
end;

procedure FastFileCopy(const InFileName, OutFileName: string;
CallBack: TCallBack);
const
BufSize = 3 * 4 * 4096; { 48Kbytes gives me the best results }
type
PBuffer = ^TBuffer;
TBuffer = array[1..BufSize] of Byte;
var
Size: DWORD;
Buffer: PBuffer;
infile, outfile: file;
SizeDone, SizeFile: LongInt;
begin
if (InFileName <> OutFileName) then
begin
buffer := nil;
Assign(infile, InFileName);
Reset(infile, 1);
try
SizeFile := FileSize(infile);
Assign(outfile, OutFileName);
Rewrite(outfile, 1);
try
SizeDone := 0;
New(Buffer);
repeat
BlockRead(infile, Buffer^, BufSize, Size);
Inc(SizeDone, Size);
CallBack(SizeDone, SizeFile);
BlockWrite(outfile, Buffer^, Size)
until Size < BufSize;
FileSetDate(TFileRec(outfile).Handle,
FileGetDate(TFileRec(infile).Handle));
finally
if Buffer <> nil then
Dispose(Buffer);
CloseFile(outfile)
end;
finally
CloseFile(infile);
end;
end
else
raise EInOutError.Create('File cannot be copied onto itself')
end; {FastFileCopy}




procedure TForm1.Button1Click(Sender: TObject);
begin
FastFileCopy('c:\daten.txt', 'c:\test\daten2.txt', @FastFileCopyCallBack);
end;

{ 4. }
{***************************************}


function CopyFileWithProgressBar2(TotalFileSize,
TotalBytesTransferred,
StreamSize,
StreamBytesTransferred: LARGE_INTEGER;
dwStreamNumber,
dwCallbackReason: DWORD;
hSourceFile,
hDestinationFile: THandle;
lpData: Pointer): DWORD; stdcall;
begin
// just set size at the beginning
if dwCallbackReason = CALLBACK_STREAM_SWITCH then
TProgressBar(lpData).Max := TotalFileSize.QuadPart;

TProgressBar(lpData).Position := TotalBytesTransferred.QuadPart;
Application.ProcessMessages;
Result := PROGRESS_CONTINUE;
end;

function TForm1.CopyWithProgress(sSource, sDest: string): Boolean;
begin
// set this FCancelled to true, if you want to cancel the copy operation
FCancelled := False;
Result := CopyFileEx(PChar(sSource), PChar(sDest), @CopyFileWithProgressBar2,
ProgressBar1, @FCancelled, 0);
end;

end;

題目很大, 也有很有多種不同的做法, 版本給了一個程式碼範例, 我就不重寫了, 講講原理就好.

要顯示複製資料夾的進度, 有 2 種不同的進度顯示方式, 一個是先算出檔案的總數, 依檔案總數做為進度表的依據, 另一種是算出要複製的資料量大小, 以目前已完成複製檔案的大小做為進度的依據.

不過這 2 種方式都是需要先計算總量, 一般就是用 FindFirstFile 和 FindNextFile 以recursive 的方式計算出總個數(或大小).

第一種方法在撰寫上較容易, 且實際複製檔案的時候, 可以用自己寫的函式, 或是現成的 CopyFile 函式.

第二種方法因為以完成複製的大小做為計算基準, 所以需用自己寫的函式, 或是像 CopyFileEx 這種具有 callback 功能的函式.

具體使用那一種方法就看實際的使用需求囉.

------
水瓶男的blog: http://791909.blogspot.com