【文章】檔案複製時如何得知已複製的檔案大小? 【作者】Thomas Stutz 【內文】http://delphi.ktop.com.tw/topic.asp?topic_id=56095程式來源:http://www.swissdelphicenter.ch/en/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; {***************************************} //转自http://delphi.ktop.com.tw/topic.asp?TOPIC_ID=56566
var Form1: TForm1; CancelCopy: Boolean; implementation {$R *.dfm} function CopyFileProgress(TotalFileSize, TotalBytesTransferred, StreamSize, StreamBytesTransferred: LARGE_INTEGER; dwStreamNumber, dwCallbackReason, hSourceFile, hDestinationFile, lpData: DWORD): DWORD; stdcall; begin Application.ProcessMessages; if CancelCopy = True then begin ShowMessage('Abbruch'); result := PROGRESS_CANCEL; Exit; end; case dwCallbackReason of CALLBACK_CHUNK_FINISHED: begin Form1.ProgressBar1.Position := TotalBytesTransferred.QuadPart; result := PROGRESS_CONTINUE; end; CALLBACK_STREAM_SWITCH: begin Form1.ProgressBar1.Max := TotalFileSize.QuadPart; result := PROGRESS_CONTINUE; end; end; end; procedure TForm1.Button1Click(Sender: TObject); var Cancel: PBOOL; begin CancelCopy := False; Cancel := nil; CopyFileEx('g:\Brennen\Madonna - Erotica.mpg', 'g:\Madonna - Erotica.mpg', @CopyFileProgress, nil, Cancel, 0); end; procedure TForm1.Button2Click(Sender: TObject); begin CancelCopy := True;; end; //转自http://www.delphipraxis.net/topic26076,next.html
【作者】Thomas Stutz
【內文】http://delphi.ktop.com.tw/topic.asp?topic_id=56095程式來源:http://www.swissdelphicenter.ch/en/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; {***************************************}
//转自http://delphi.ktop.com.tw/topic.asp?TOPIC_ID=56566
Form1: TForm1;
CancelCopy: Boolean; implementation {$R *.dfm} function CopyFileProgress(TotalFileSize, TotalBytesTransferred, StreamSize,
StreamBytesTransferred: LARGE_INTEGER; dwStreamNumber, dwCallbackReason,
hSourceFile, hDestinationFile, lpData: DWORD): DWORD; stdcall;
begin
Application.ProcessMessages;
if CancelCopy = True then
begin
ShowMessage('Abbruch');
result := PROGRESS_CANCEL;
Exit;
end;
case dwCallbackReason of
CALLBACK_CHUNK_FINISHED:
begin
Form1.ProgressBar1.Position := TotalBytesTransferred.QuadPart;
result := PROGRESS_CONTINUE;
end;
CALLBACK_STREAM_SWITCH:
begin
Form1.ProgressBar1.Max := TotalFileSize.QuadPart;
result := PROGRESS_CONTINUE;
end;
end;
end; procedure TForm1.Button1Click(Sender: TObject);
var
Cancel: PBOOL;
begin
CancelCopy := False;
Cancel := nil;
CopyFileEx('g:\Brennen\Madonna - Erotica.mpg', 'g:\Madonna - Erotica.mpg',
@CopyFileProgress, nil, Cancel, 0);
end; procedure TForm1.Button2Click(Sender: TObject);
begin
CancelCopy := True;;
end;
//转自http://www.delphipraxis.net/topic26076,next.html