Indy

OrgaMon verwendet den HTTP-Server und FTP-Client des Indy Projektes. Dieses Projekt enthält in Delphi geschriebene TCP Protokolle. Im Moment (Stand 2009) benötigen einige Units-Patches aus unterschiedlichen Gründen ...

Wirksamkeit der folgenden Patches

Im Tools->Optionen->Bibliothekspfad müssen die 3 Pfade ...

$(BDS)\source\Indy\Indy10\System
$(BDS)\source\Indy\Indy10\Core
$(BDS)\source\Indy\Indy10\Protocols


... hinzugefügt werden, sonst ist der Patch wirkungslos, da die Quelltexte sonst nicht gesehen werden.

Zeitzonen-Bug

• \System\IdSysVCL.pas

class function TIdSysVCL.OffsetFromUTC: TIdDateTimeBase;
var
 TimeZ : TTimeZoneInformation;
 OffsetInMinutes: integer;
begin

 // get Offset in Minutes from System
 if (GetTimeZoneInformation(TimeZ)=2) then
  OffsetInMinutes := - (TimeZ.Bias + TimeZ.DayLightBias)
 else
  OffsetInMinutes := - (TimeZ.Bias + TimeZ.StandardBias); 

 // Build the TDateTime, ensure positive Values
 Result := EncodeTime(abs(OffsetInMinutes) DIV 60,abs(OffsetInMinutes) MOD 60,0,0);

 // Ensure Old Sign
 if (OffsetInMinutes<0) then
   Result := - Result;
end;

FTP_Client kann keine REST(art)

• \Protocols\IdFTP.pas

   // Im "public" Bereich der TIDFTP-Klasse
   // am besten unter die anderen Put - Routinen
   procedure PutRestart(const ASourceFile,ADestFile: string; const StartPosition: Int64);

   // hier die Implementierung weiter unten
   // 
procedure TIdFTP.PutRestart(const ASourceFile, ADestFile: string; const StartPosition: int64);
var
  LSourceStream: TIdStream;
  LDestFileName : String;
begin
  LDestFileName := ADestFile;
  if LDestFileName =  then
  begin
    LDestFileName := Sys.ExtractFileName(ASourceFile);
  end;
  LSourceStream := TReadFileNonExclusiveStream.Create(ASourceFile);
  try
    EIdFTPUploadFileNameCanNotBeEmpty.IfTrue(ADestFile = , RSFTPFileNameCanNotBeEmpty);
    LSourceStream.Position := StartPosition;
    DoBeforePut(LSourceStream);
    SendCmd('REST ' + Sys.IntToStr(StartPosition), [350]);  {Do not localize}
    InternalPut('STOR ' + ADestFile, LSourceStream, false);  {Do not localize}
    DoAfterPut;
  finally
    Sys.FreeAndNil(LSourceStream);
  end;
end;

// eine typische Anwendung eines FTP Restart sieht so aus ...
function TFormDatensicherung.doUpload(ResultFName: string):boolean;
var
  FtpDestFName: string;
  rSize: int64;
  lSize: int64;
begin
  //
  result := false;
  lSize := FSize(ResultFName);
  SolidInit(IdFTP1);
  with IdFTP1 do
  begin     

    Host := cFTP_Host;
    UserName := cFTP_UserName;
    password := cFTP_Password;

    try
      FtpStartTime := 0;
      if connected then
        Quit;
      connect;

      // atomic.begin
      FtpDestFName := ExtractFileName(ResultFName);
      repeat 

       rSize := Size(FtpDestFName + '.$$$');
       if rSize=lSize then
         break;
       if rSize>lSize then
         raise Exception.create('FTP: remote Datei ist '+inttostr(rSize-lSize)+' Bytes grösser als die lokale');

       if (rSize<1) then
       begin
         FTP_StartOffset := 0;
         Put(ResultFName, FtpDestFName + '.$$$');
       end else
       begin
         FTP_StartOffset := rSize;
         PutRestart(ResultFName, FtpDestFName + '.$$$',rSize);
       end;

     until true;

     rSize := Size(FtpDestFName + '.$$$');
     if (lSize=rSize) then
     begin
       if (Size(FtpDestFName) >= 0) then
         Delete(FtpDestFName);
       Rename(FtpDestFName + '.$$$', FtpDestFName);
       result := true;
     end else
     begin
       if (rSize>lSize) then
         raise Exception.create('FTP: remote Datei ist '+inttostr(rSize-lSize)+' Bytes grösser als die lokale')
       else
         raise Exception.create('FTP: remote Datei ist '+inttostr(lSize-rSize)+' Bytes kleiner als die lokale');
     end;
     // atomic.end

     Quit;
    except
      on E: Exception do
      begin
        Log('ERROR: Ftp Upload Error: ' + e.message);
      end;
    end;
  end;
end;