![]() |
Kopier Routine mit Fortschrittsbalken
Hallo,
ich habe ein Tool geschrieben welches Komplette Verzeichnisse von A nach B kopieren soll. Bis jetzt arbeitet das Programm mit der API Funktion CopyFile(), was auch soweit funktioniert jedoch bei großen Dateien unschön ist. Jetzt habe ich mir überlegt eine eigene Routine zuschreiben und habe auch gleich etwas gefunden mit BlockRead und Blockwrite was ebenfalls funktioniert. Jedoch sobald ich das Verzeichnis des Webservers kopieren will, schlägt die Routine fehl weil einige Dateien von einem anderen Prozess in Benutzung sind, aber irgendwie muß das doch trotzdem gehen. Der Windoof Explorer kann die Datei doch auch kopieren oder andere Dateibrowser.
Delphi-Quellcode:
Jemand eine idee wo man die Datei trotzdem kopieren kann mit einer Fortschrittsanzeige?
Procedure pCopyFile(Source, Target : String; bAttr : Boolean; Var Status : Boolean; Var Progress : TProgressbar);
Var File1 : File; File2 : File; Buffer : Pointer; Buffersize : Integer; Read : Integer; Write : Integer; Error : Word; i : Word; Size : Int64; AttrSource : Word; IoRes : Integer; Begin Buffersize := 10000; If (FileExists(Target)) Then Begin Status := True; Exit; End;{if} AssignFile(File1, Source); AttrSource := FileGetAttr(Source); FileSetAttr(Source, faArchive); AssignFile(File2, Target); FileSetAttr(Target , faArchive); {$I-} Reset(File1, 1); Rewrite(File2, 1); {$I+} IoRes := IoResult; If (IoRes <> 0) Then Begin frmMain.Log.Lines.Add('Fehler: '+IntToStr(IoRes)+' '+SysErrorMessage(IoRes)); Status := False; Exit; End Else Begin Size := FileSize(File1); If Size > 100 * 1024 Then Begin Progress.Position := 0; Progress.Min := 0; Progress.Max := Size; Progress.Step := 1; End; End; Read := 0; Write := 0; GetMem(Buffer, Buffersize); Repeat; {$I-} Blockread(File1, Buffer^, buffersize, Read); Blockwrite(File2, Buffer^, Read, Write); {$I+} Error := IoResult; Progress.Position := Read; Application.ProcessMessages; Until (Read = 0)or(Write <> Read) Or (Error <> 0); If Error <> 0 Then Begin FreeMem(buffer,buffersize); Status := False; Exit; End; CloseFile(File1); CloseFile(File2); FreeMem(Buffer, Buffersize); Status := True; If Size > 100 * 1024 Then Progress.Position := 0; End; |
Re: Kopier Routine mit Fortschrittsbalken
|
Re: Kopier Routine mit Fortschrittsbalken
Vielen dank, ich werde mir das mal näher anschauen.
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 17:27 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz