procedure CopyFile(sFrom, sTo:
String; tlSrcFile, tlDestFile, tlSize: TLabel; bSecurityRename: Boolean;
pbFile: TProgressBar;
var iError: Byte;
var sMsg: ShortString;
iFileSize: Int64; lpWrite: TFileTime; bSetAccess: Boolean);
const cInternExtension = '
.sync';
var iAttr: Integer;
fFrom, fTo:
File;
Buf:
array[1..8191]
of Char;
gel, ges: Integer;
hDest, iSep: Integer;
iPos: Int64;
sOrg_To:
String;
//-------------------------------------------
procedure SetAttribute(sFile:
String);
begin
if iAttr<>-1
then FileSetAttr(sFile,iAttr);
end;
//-------------------------------------------
begin
iError:=1;
sMsg:=msgFileCopied;
// Datei-Infos setzen
SetTextToLabel(tlSrcFile,sFrom);
SetTextToLabel(tlDestFile,sTo);
SetSizeToLabel(tlSize,iFileSize,pbFile.Left+pbFile.Width);
pbFile.Position:=0;
iSep:=1;
while (iFileSize
div iSep) > High(Integer)
do
iSep:=iSep*10;
pbFile.Max:=iFileSize
div iSep;
Application.ProcessMessages;
// Dateiattribute ermitteln
iAttr:=FileGetAttr(sFrom);
sOrg_To:=sTo;
if FileExists(sTo)
then
begin
// Attribut auf 0 setzen
FileSetAttr(sTo,0);
// Umbennennen der Zieldatei
if not bSecurityRename
then bSecurityRename:=ExpandUNCFileName(sTo)[1]='
\';
if(bSecurityRename)
then
begin
sTo:=sTo+cInternExtension;
if FileExists(sTo)
then DeleteFile(sTo);
if(
not RenameFile(sOrg_To,sTo))
then
begin
sMsg:=ermRenameFileForCopy;
iError:=2;
exit;
end;
end;
end
else if bSecurityRename
then sTo:=sTo+cInternExtension;
//FileSetAttr(sFrom,0);
// Öffnen der Quelldatei
try
AssignFile(fFrom,sFrom);
FileMode:=0;
Reset(fFrom,1);
except
on e: EInOutError
do
begin
sMsg:=ermOpenSrc+SysErrorMessage(e.ErrorCode);
iError:=2;
exit;
end;
end;
// Öffnen der Zieldatei
try
AssignFile(fTo,sTo);
Rewrite(fTo,1);
except
on e: EInOutError
do
begin
CloseFile(fFrom);
SetAttribute(sFrom);
sMsg:=ermOpenDest+SysErrorMessage(e.ErrorCode);
iError:=2;
exit;
end;
end;
// Kopieren der Datei
iPos:=0;
repeat
try
BlockRead(fFrom,Buf,SizeOf(buf),gel);
BlockWrite(fTo,buf,gel,ges);
inc(iPos,gel);
pbFile.Position:=iPos
div iSep;
Application.ProcessMessages;
except
on e: EInOutError
do
begin
iError:=2;
sMsg:=SysErrorMessage(e.ErrorCode);
CloseFile(fFrom);
CloseFile(fTo);
DeleteFile(sTo);
if FileExists(sTo)
then iError:=3;
SetAttribute(sFrom);
exit;
end;
end;
if FCopyAbort
then
begin
CloseFile(fFrom);
CloseFile(fTo);
DeleteFile(sTo);
if FileExists(sTo)
then iError:=3;
tfCopy.SetAbort;
exit;
end;
until(gel<>ges)
or(gel=0);
if gel<>ges
then
begin
iError:=2;
sMsg:=ermWriteError;
CloseFile(fFrom);
CloseFile(fTo);
DeleteFile(sTo);
if FileExists(sTo)
then iError:=3;
SetAttribute(sFrom);
exit;
end;
// Dateien schliessen
CloseFile(fFrom);
CloseFile(fTo);
// Setzen des Zeitstempels
hDest:=FileOpen(sTo,fmOpenWrite);
if not SetFileTime(hDest,
nil,
nil,@lpWrite)
then
begin
iError:=2;
sMsg:=SysErrorMessage(GetLastError);
SetFileTime(hDest,
nil,
nil,0);
FileClose(hDest);
DeleteFile(sTo);
if FileExists(sTo)
then iError:=3;
exit;
end;
FileClose(hDest);
// Kopie zurückbenennen
if bSecurityRename
then
begin
if not RenameFile(sTo,sOrg_To)
then
begin
sMsg:=ermReRename;
iError:=2;
exit;
end;
end;
sTo:=sOrg_To;
// Setzen der Attribute
if FileSetAttr(sTo,iAttr)>0
then
begin
iError:=2;
sMsg:=ermSetAttrib+SysErrorMessage(GetLastError);
end;
// Setzen der NTFS Access Attribute
if bSetAccess
then
begin
try
SetDACL(PChar(sFrom),PChar(sTo));
except
// Fehler unbehandelt
end;
try
SetSACL(PChar(sFrom),PChar(sTo));
except
// Fehler unbehandelt
end;
try
SetOwner(PChar(sFrom),PChar(sTo));
except
// Fehler unbehandelt
end;
end;
// if bSetAccess
end;