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 nun REST(art)

bei grössen Datei-Uploads ist es immer möglich dass der Upload nicht vollständig erfolgreich durchgeführt werden kann. Diese Routine ist wiederansetzfähig und kann in einem 2. 3. Versuch die Datei vervollständigen. Erst wenn sie vollständig hochgeladen wurde erhält sie ihren richtigen Namen ...

• \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;