unit RuFileCopy;
interface
uses
System.Classes;
type
TFileCopyMode = (fomAlways, fomIfNewer, fomIfOlder, fomIfSameDate, fomIfSameDateTime);
TFileCopyCallback =
procedure(ProgressPercent: Integer)
of object;
TRuFileCopyThread =
class(TThread)
private
{ Private-Deklarationen }
FCopyResult, FSourceName, FDestName:
string;
FFileCopyMode: TFileCopyMode;
FFileCopyCallback: TFileCopyCallback;
procedure ThreadCopyCallback(ProgressPercent: Integer);
protected
procedure Execute;
override;
public
constructor Create(aSourceName, aDestName:
string;
aFileCopyMode: TFileCopyMode;
aFileCopyCallback: TFileCopyCallback);
procedure ThreadIsReady(Sender: TObject);
end;
const
cRuFileCopyReady = 200;
var
RuFileCopyThreadResult:
string = '
';
{- Eine Datei kopieren: Direkt-Aufruf -}
function RuFileCopyExecute(aSourceName, aDestName:
string;
aFileCopyMode: TFileCopyMode;
aFileCopyCallback: TFileCopyCallback):
string;
{- Eine Datei kopieren: Kopiert die Datei in einem eigenen Thread -}
function RuFileCopyThread(aSourceName, aDestName:
string;
aFileCopyMode: TFileCopyMode;
aFileCopyCallback: TFileCopyCallback):
string;
implementation
uses System.SysUtils;
var
StreamCopyBuffer:
array[0..500 * 1024]
of byte;
ProgressPercent: Int64;
{------------------------------------------------------------------------------}
{- Eine Datei kopieren: Direkt-Aufruf oder Aufruf aus dem Thread -}
{- aSourceName = Name der Quelldatei -}
{- aDestName = Name der ZielDatei, darf auch das Zielverzeichnis sein -}
{- aFileCopyCallback = ProgressCallback: Übergibt Wert in Prozent von 1-100 -}
{------------------------------------------------------------------------------}
function RuFileCopyExecute(aSourceName, aDestName:
string;
aFileCopyMode: TFileCopyMode;
aFileCopyCallback: TFileCopyCallback):
string;
var
BytesRead, BytesToRead, P: Int64;
SourceStream, DestStream: TFileStream;
SourceDateTime, DestDateTime: TDateTime;
begin
Result := '
';
if not FileExists(aSourceName)
then Exit('
Quelldatei <'+aSourceName+'
> existiert nicht');
if not FileAge(aSourceName, SourceDateTime)
then Exit('
Quelldatei: TimeStamp lesen fehlgeschlagen');
BytesRead := 0;
ProgressPercent := 0;
P := 0;
// DestName darf auch ein Directory sein...dann den Dateinamen ran hängen
if DirectoryExists(aDestName)
// DestName ist ein Directory
then aDestName := IncludeTrailingBackslash(aDestName)+ExtractFileName(aSourceName);
if FileExists(aDestName)
then begin
if not FileAge(aDestName, DestDateTime)
then Exit('
Zieldatei: TimeStamp lesen fehlgeschlagen');
case aFileCopyMode
of
fomAlways :;
// immer kopieren
fomIfNewer :
// Die Quelldatei muss neuer als die Zieldatei sein
if NOT (SourceDateTime > DestDateTime)
then Exit('
Die Quelldatei ist nicht neuer als die Zieldatei');
fomIfOlder :
// Die Quelldatei muss älter als die Zieldatei sein => z.B. Downgrade
if NOT (SourceDateTime < DestDateTime)
then Exit('
Die Quelldatei ist nicht älter als die Zieldatei');
fomIfSameDate :
// Quell- und Ziel-Datei müssen am selben Tag erstellt worden sein
if Trunc(DestDateTime) <> Trunc(SourceDateTime)
then Exit('
Die Zieldatei ist nicht vom selben Datum als die Quelldatei');
fomIfSameDateTime :
// Das Datum von Quell- und Ziel-Datei muss identisch sein
if DestDateTime <> SourceDateTime
then Exit('
Datum und Zeit von Zieldatei und Quelldatei sind unterschiedlich');
else raise Exception.Create('
Da hat der Programmierer was vergessen');
end;
end;
SourceStream := TFileStream.Create(aSourceName,fmOpenRead
or fmShareDenyNone);
DestStream := TFileStream.Create(aDestName,fmCreate);
try
if @aFileCopyCallback =
nil
then DestStream.CopyFrom(SourceStream,SourceStream.Size)
// so geht es am schnellsten
else begin // mit Fortschrittanzeige
aFileCopyCallback(0);
BytesToRead := SizeOf(StreamCopyBuffer);
if SourceStream.Size < BytesToRead
then BytesToRead := SourceStream.Size;
repeat
SourceStream.ReadBuffer(StreamCopyBuffer,BytesToRead);
DestStream.WriteBuffer(StreamCopyBuffer,BytesToRead);
BytesRead := BytesRead + BytesToRead;
ProgressPercent := (BytesRead * 100)
div SourceStream.Size;
if P <> ProgressPercent
then begin
aFileCopyCallback(Integer(ProgressPercent));
P := ProgressPercent;
end;
if (SourceStream.Size - BytesRead) <= BytesToRead
then BytesToRead := SourceStream.Size - BytesRead;
until BytesRead >= SourceStream.Size;
if BytesRead <> SourceStream.SIZE
then Result := '
Fehler beim Kopiervorgang:'+#13#10
+'
Bytes gelesen:' + IntToStr(BytesRead) + #13#10
+'
Bytes geschrieben:' + IntToStr(SourceStream.SIZE)
else aFileCopyCallback(100);
// Kopiervorgang 100%
end;
finally
SourceStream.Free;
DestStream.Free;
end;
end;
function RuFileCopyThread(aSourceName, aDestName:
string;
aFileCopyMode: TFileCopyMode;
aFileCopyCallback: TFileCopyCallback):
string;
begin
with TRuFileCopyThread.Create(aSourceName, aDestName,
aFileCopyMode, aFileCopyCallback)
do begin
OnTerminate := ThreadIsReady;
FreeOnTerminate := true;
Start;
// Thread wird gestartet
end;
end;
{------------------------------------------------------------------------------}
{- TRuFileCopyThread ----------------------------------------------------------}
{------------------------------------------------------------------------------}
procedure TRuFileCopyThread.ThreadCopyCallback(ProgressPercent: Integer);
begin
Synchronize(
procedure
begin
FFileCopyCallback(ProgressPercent);
end);
end;
procedure TRuFileCopyThread.ThreadIsReady(Sender: TObject);
begin
RuFileCopyThreadResult := FCopyResult;
Synchronize(
procedure
begin
FFileCopyCallback(cRuFileCopyReady);
end);
end;
constructor TRuFileCopyThread.Create(aSourceName, aDestName:
string;
aFileCopyMode: TFileCopyMode; aFileCopyCallback: TFileCopyCallback);
begin
inherited Create(True);
// True = Thread nicht automatisch starten
FCopyResult := '
';
FSourceName := aSourceName;
FDestName := aDestName;
FFileCopyMode := aFileCopyMode;
FFileCopyCallback := aFileCopyCallback;
FreeOnTerminate := true;
end;
procedure TRuFileCopyThread.Execute;
begin
if not Terminated
then FCopyResult := RuFileCopyExecute(FSourceName, FDestName,
FFileCopyMode, FFileCopyCallback);
end;
end.
// Hauptprogramm
type
TForm1 =
class(TForm)
...
public
{ Public-Deklarationen }
procedure ShowProgress(ProgressPercent: Integer);
end;
...
procedure TForm1.ShowProgress(ProgressPercent: Integer);
begin
ProgressBar1.Position := ProgressPercent;
if ProgressPercent = cRuFileCopyReady
then Label4.Caption := '
FERTIG: '+DateTimeToStr(Now)+'
Result['+RuFileCopyThreadResult+'
]';
end;