Datei kopieren mit Fortschrittsanzeige

[Matze]

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.

[CalganX]

Hi,
[cl]SHFile*[/cl]
Da kannst du auch einen Statusbalken anzeigen lassen.

Chris

[Matze]

Danke!!

Zitat:

[Fehler] Unit1.pas(477): Undefinierter Bezeichner: 'aFlags'

[CalganX]

Hi,
du musst den Parameternamen anpassen. Ich glaube einfach nur ein "a" anfügen.

Chris

[Matze]

Zitat von Chakotay1308:

Hi,
du musst den Parameternamen anpassen. Ich glaube einfach nur ein "a" anfügen.

Chris

[Matze]

Das geht irgendwie nicht, was muss ich denn genau anstelle von aFlags schreiben? In sakuras Post finde ich darüber nichts.

[Manzoni]

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); 
var variable : TCallBack;
begin 
  FastFileCopy('c:\daten.txt', 'c:\test\daten2.txt', variable); 
end;

weiss net, aber evtl. funzt es so
wenn nicht, nimm doch den?

Delphi-Quellcode:

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;

[maximov]

Zitat:

Es kommt aber leider immer, dass eine Variable verlangt wird, anstatt @FastFileCopyCallBack.

wenn du versucht @FastFileCopyCallBack in den aufruf zuschreiben, dann wird das nix, da du normalerweise das @ weglassen müsstest. Also nur die reine prozedur angeben *hoff*

cu.

[CalganX]

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); 
{...}
begin 
  {...}
end; {FastFileCopy} 

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

Source untested.

Chris

[Luckie]

Alternativ kuck dir mal hier: http://www.luckie-online.de/files/demos/ den StreamProgressAdapter an.