(Co-Admin)
Registriert seit: 7. Jul 2003
Ort: Schwabenländle
14.929 Beiträge
Turbo Delphi für Win32
|
Datei kopieren mit Fortschrittsanzeige
15. Feb 2004, 20:55
Hi!
Manzoni war so nett und hat mir einen Link geschickt, auf dem steht, wie man den Fortschritt beim Kopieren einer Datei anzeigen lassen kann:
Delphi-Quellcode:
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); //<== Fehler
end;
Es kommt aber leider immer, dass eine Variable verlangt wird, anstatt @FastFileCopyCallBack.
|
|
Zitat
|