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:

Zitat von Chakotay1308

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

Chris

:angle2:

[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.

[APP]

Hallo Matze,

Zitat:

Zitat von Matze

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

Abgesehen vom Flags/aFlags-Problem, das Dir Chris gelöst hat, funktioniert Sakuras Lösung einwandfrei:

Delphi-Quellcode:

    ...
    end; // target not available 
    fFlags := Flags // statt aFlags; 
    ...

Aufruf (aus Sakuras Post)

Code:

DoFileWork(Self.Handle, FO_DELETE, strlFiles, nil, [b][color=red]FOF_ALLOWUNDO[/color][/b]);

Mögliche Parameter für Flag (aus Sakuras Post)

Zitat:

aFlags - mögliche Flags zur Verarbeitung
FOF_ALLOWUNDO - Ermöglicht eine Umkehrung der letzten Operation
FOF_FILESONLY - Verzeichnisse ignorieren
FOF_MULTIDESTFILES - aTo hat einen Eintrag für jeden Eintrag in der aFrom Liste
FOF_NOCONFIRMATION - Der User muss keine Bestätigung zum Überschreiben, etc. geben
FOF_NOERRORUI - Fehlermeldugen unterdrücken
FOF_NORECURSION - Unterverzeichnisse ignorieren
FOF_RENAMEONCOLLISION - Datei umbenennen, wenn diese bereits im Zielverzeichnis existiert (Kopie 1 von ...)
FOF_SILENT - Fortschrittsanzeige unterdrücken.

[Matze]

Boah, ich bin platt!

Ich staune jedesmal neu.

Vielen Dank euch allen! :)

[Matze]

Also, sakuras Code geht schon mal. :)

Bei dem anderen kommt an dieser Stelle:

Delphi-Quellcode:

Assign(infile, InFileName);

dieser Fehler:

Zitat:

[Fehler] Unit1.pas(475): Inkompatible Typen: 'TPersistent' und 'file'

infile ist vom Typ file
InFileName von Typ string

Was mache ich denn nun schon wieder falsch?

In der OH sind immer nur andere Beispiele zu finden. :gruebel:

[CalganX]

Hi,
mach aus den ganzen Assigns mal AssignFile...

Chris

[Matze]

Thx, geht! :thumb:

[APP]

Komisch,
bei mir geht es auch mit Assign...

[changlee]

Der Beitrag ist zwar schon sehr alt, aber ich habe ein Problem damit und ich wundere mich, dass niemand anderes dieses Problem bemerkt:

Wenn ich Dateien mit dieser Funktion in einer Schleife kopiere, dann läuft mein Statusbalken gleichmäßig voll, verharrt dann aber relativ lange an seiner letzten Position bis er mit der nächsten Datei fortfährt. Und der Grund dafür ist die Zeile:

Code:

CloseFile(outfile)

CloseFile dauert relativ lange (nennenswert lange im Vergleich zur Gesamtdauer des Kopiervorgangs).
Das ist sehr schade, da die Funktion dadurch unbrauchbar wird.

Ich habe dann das ganze auch nochmal mit Streams geschrieben, aber ich sehe das gleiche Verhalten - nur diesmal in der Zeile:

Code:

outStream.Free; // das hier dauert sehr lange!!!

gesamter Code der Stream-Variante:

Code:

function FastFileCopy2(const InFileName, OutFileName: string; CallBack: TProgressCallBack; doneBefore: int64; total: int64; mustCancel: TBoolFunction): boolean;
const
  BufSize = 3 * 4 * 4096; { 48Kbytes gives me the best results }
var
  done, thisSize: int64;
  outStream,inStream:TFileStream;
begin
  result := false;
  if (InFileName <> OutFileName) then begin
    outStream := TFileStream.Create(OutFileName, fmCreate);
    inStream  := TFileStream.Create(InFileName, fmOpenRead);
    try
      thisSize := inStream.Size;
      if total = 0 then begin
        total := thisSize;
        doneBefore := 0;
      end;
      while (inStream.Position+BufSize<=thisSize) and not mustCancel do begin
        outStream.CopyFrom(inStream,BufSize);
        CallBack(inStream.Position+doneBefore,total);
      end;
      if not MustCancel then begin
        outStream.CopyFrom(inStream,inStream.Size-inStream.Position);
        CallBack(inStream.Position+doneBefore,total);
        //FileSetDate(TFileRec(outfile).Handle, FileGetDate(TFileRec(infile).Handle));
        result := true;
      end
    finally
      outStream.Free; // das hier dauert sehr lange!!!
      inStream.Free;
    end;
  end;
end; {FastFileCopy2}

Warum ist das so? Kann ich irgendwie entgegenwirken?

[tomkupitz]

Windows.CopyFileEx geht auch...

[Luckie]

Haben noch andere Prozesse einen Zugriff auf die Datei(en), wie zum Beispiel ein Virenscanner?

Und da andere noch nicht von dem Problem berichtet haben, scheint es üblicherweise nicht aufzutreten. Zu mal du mit dem alternativen Code ja gezeigt hast, dass es nicht an der Implementierung liegt, sondern irgend was bei dir das Schließen der Datei verzögert/blockiert.

[Dalai]

Man sollte beachten, dass das Lesen von Dateien unter Umständen sehr viel schneller geht als das Schreiben, beispielsweise beim Kopieren von Daten von SSD auf HDD oder von HDD/SSD auf Netzwerk. Windows liest den Kram in den Cache so schnell es die Quelle zulässt, aber das Schließen der Datei kann logischerweise erst abgeschlossen werden, nachdem die Daten auch ans Ziel rausgeschrieben wurden.

Grüße
Dalai

[changlee]

Zitat:

Zitat von tomkupitz (Beitrag 1442147)

Windows.CopyFileEx geht auch...

...ermöglicht aber leider keine Fortschrittsanzeige.


Zu den Hinweisen von Luckie und Dalai, habe ich ein paar Tests gemacht.

Das Problem tritt auf beim Schreiben auf externe HDDs (schreibend auf USB2.0/USB3.0, lesend von USB2.0/USB3.0/interne SSD).
Das Problem tritt nicht auf beim Schreiben auf die interne SSD (schreibend auf interne SSD, lesend von USB2.0/USB3.0/interne SSD).-> liegt also offenbar nicht am Virenscanner

Leider habe ich keine externe SSD und keine interne HDD zum Testen.

Die Zeit für Closefile beträgt nach groben Abschätzen bei den Versuchen ca. ein Drittel der Kopierdauer für die ganze Datei - sofern auf eine HDD geschrieben wird.
Bei einer SSD benötigt Closefile keine spürbare Zeit, selbst bei sehr großen Dateien nicht.

Fallen euch noch irgendwelche Ansatzpunkte ein?

[dummzeuch]

Zitat:

Zitat von changlee (Beitrag 1442190)

Zitat:

Zitat von tomkupitz (Beitrag 1442147)

Windows.CopyFileEx geht auch...

...ermöglicht aber leider keine Fortschrittsanzeige.

Doch, es erlaubt genau das:

CopyFileWithProgress (using CopyFileEx)

Benutze ich schon seit Jahren problemlos.

[changlee]

ok danke. Das hatte ich anders in Erinnerung.
Ich will es gerade testen, habe aber noch ein Problem mit dem Aufruf von CopyFileEx.
Der Beispielcode ist mir zugegebener Maßen zu umfangreich. Ich versuche ein Minimalbeispiel umzusetzen:

Code:

function TJobThread.SyncProgress2(_TotalFileSize, _TotalBytesTransferred, _StreamSize, _StreamBytesTransferred: LARGE_INTEGER; _StreamNumber, _CallbackReason: LongWord; _SourceFile, _DestinationFile: THandle; _Data: Pointer): LongWord;
begin
  // mach irgendwas..
end;

procedure TJobThread.Execute;
var
  src1,tgt:string;
begin
    src := 'c:\temp\datei1.img';
    tgt := 'c:\temp\datei2.img';
    Windows.CopyFileEx(PChar(src), PChar(tgt), SyncProgress2, Redir, @Redir.FCancelFlag, Flags); // Fehler beim Compilieren: E2035 Nicht genügend wirkliche Parameter
    Windows.CopyFileEx(PChar(src), PChar(tgt), @SyncProgress2, Redir, @Redir.FCancelFlag, Flags); // Fehler beim Compilieren: E2036 Variable erforderlich
end;

Wie kann ich die Funktion SyncProgress2 übergeben?


Falls noch jemand eine Idee hat warum closfile bzw. Stream.Free so lange dauert, bin ich aber auch da noch für jeden Tip dankbar.

[Forensiker]

SyncProgress2 ist eine callback und sollte Global definiert sein.. nicht innerhalb einer Klasse.

Delphi-Quellcode:

Windows.CopyFileEx(PChar(src), PChar(tgt), SyncProgress2, Redir, @Redir.FCancelFlag, Flags); // Fehler beim Compilieren: E2035 Nicht genügend wirkliche Parameter

Kann nicht funktionieren da ein Pointer auf die Callback erwartet wird.

Delphi-Quellcode:

Windows.CopyFileEx(PChar(src), PChar(tgt), @SyncProgress2, Redir, @Redir.FCancelFlag, Flags); // Fehler beim Compilieren: E2036 Variable erforderlich

Siehe erste Zeile im Beitrag.

[changlee]

ich hab's befürchtet. Ich kann wirklich keine Klassenmethode übergeben??

Dann kapiere ich es aber immer noch nicht.
Ich habe jezt folgenden Code:

Code:

procedure TJobThread.SyncProgress(Position, Size: int64);
begin
  self.fProgressPosition  := Position;
  self.fProgressSize      := Size;
  self.fProgressToPublish := 0;
  self.Synchronize(self.publishProgress);
end;

function SyncProgress2(_TotalFileSize, _TotalBytesTransferred, _StreamSize, _StreamBytesTransferred: LARGE_INTEGER; _StreamNumber, _CallbackReason: LongWord; _SourceFile, _DestinationFile: THandle; _Data: Pointer): LongWord;
var a,b:int64;
begin
  //a := int64(_TotalBytesTransferred);
  //b := int64(_TotalFileSize);
  //TJobThread(_Data).SyncProgress(a,b);
  result := PROGRESS_CONTINUE;
end;


procedure TJobThread.Execute;
var
  doCancel : PBOOL;
  src,tgt:string;
begin
  src := 'c:\temp\datei1.img';
  tgt := 'c:\temp\datei2.img';
  doCancel := PBOOL(False);
  Windows.CopyFileEx(PChar(s1), PChar(s2), @SyncProgress2, @self, doCancel, 0) then begin
end;

Die Zieldatei wird erstellt, enthält aber keine Daten. Der Kopiervorgang ist sofort zu Ende und die Datei nicht zu öffnen.
Setze ich einen Haltepunkt bekomme ich beim Aufruf von CopyFileEx eine Zugriffsverletzung (Lesen von Adresse...).

[Luckie]

http://michael-puff.de/Programmierun...pyFileEx.shtml

[changlee]

Den Code hatte ich auch schon gefunden ;-)

Aber trotzdem gut, dass du ihn nochmal geschickt hast.
Ich habe meine beiden Fehler gefunden:

Code:

function SyncProgress2(...): LongWord; // ALT, Kopiervorgang schlägt fehl
function SyncProgress2(...): DWORD; stdcall; // NEU, Kopiervorgang funktionert
...
TJobThread(_Data).SyncProgress(a,b); // Falsch
TJobThread(_Data^).SyncProgress(a,b); // Korrekt

Danke!!!

Viele Grüße
Stefan

[Luckie]

Ok, dann findet man die Quellcodes auf meiner Seite also noch. ;-)