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

Ist aufgetreten im Zusammenhang mit eMail Versand. Ich glaube da war das Sendedatum falsch! Dieser Bug verschwand im Delphi 2010 (Indy 10.5.5).

• \System\IdSysVCL.pas

 // Patch nur notwendig bis Delphi 2009!
 // Indy 10.5.5 ist OK!
 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
// 
// für Delphi 2007
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;

// für Delphi 2010
procedure TIdFTP.PutRestart(const ASourceFile, ADestFile: string; const StartPosition: int64);
var
  LSourceStream: TStream;
  LDestFileName : String;
begin
  LDestFileName := ADestFile;
  if LDestFileName = `` then
  begin
    LDestFileName := ExtractFileName(ASourceFile);
  end;
  LSourceStream := TIdReadFileNonExclusiveStream.Create(ASourceFile);
  try
    if ADestFile = `` then
     raise EIdFTPUploadFileNameCanNotBeEmpty.create(RSFTPFileNameCanNotBeEmpty);
    LSourceStream.Position := StartPosition;
    DoBeforePut(LSourceStream);
    SendCmd('REST ' + IntToStr(StartPosition), [350]);  {Do not localize}
    InternalPut('STOR ' + ADestFile, LSourceStream, false);  {Do not localize}
    DoAfterPut;
  finally
    FreeAndNil(LSourceStream);
  end;
end;

diese eine neue Routine reicht aus! Nun folgt ein BEispiel aus der Praxis. Man beachte, dass hier die globale Variable "FTP_StartOffset" gesetzt wird, diese int64 Variable muss bei den Wartebalken-Routinen immer mit dazugezählt werden (Also bei OnBeginWork und bei OnWork).

// 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;

Embed Image in html-eMail content

See RFC 2557. You can insert a image inside html using something like this:

<IMG SRC="data:image/gif;base64,RAAAtuhhx4dbgYKAAA7...more data....." ALT="Larry">

Code: 

From: foo1atbar.net 
To: foo2atbar.net 
Subject: A simple example 
Mime-Version: 1.0 
Content-Type: multipart/related; boundary="boundary-example"; type="text/html" 

--boundary-example 
Content-Type: text/html; charset="US-ASCII"  

... text of the HTML document, which might contain a URI 
referencing a resource in another body part, for example 
through a statement such as: 
<IMG SRC="cid:foo4atfoo1atbar.net" ALT="IETF logo"> 

--boundary-example 
Content-Location: CID:somethingatelse ; this header is disregarded 
Content-ID: <foo4atfoo1atbar.net> 
Content-Type: IMAGE/GIF 
Content-Transfer-Encoding: BASE64 

R0lGODlhGAGgAPEAAP/////ZRaCgoAAAACH+PUNv 
cHlyaWdodCAoQykgMTk5LiBVbmF1dGhvcml6ZWQgZHV 
wbGljYXRpb24gcHJvaGliaXRlZC4A etc... 

--boundary-example--