Firewall bringt Programm zum Absturz

[Baeuerle]

Ok,

vielleicht liegt es darna, dass ich ein TCopyObj = class(TAutoObject, ICopy) benutze als eine ActivX Server bzw. COM Objekt benutze.

hier kommt die eigentliche kopierroutine:

Delphi-Quellcode:

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;