Erstellen eines SMTP transport event sink in Delphi

[mkinzler]

Erstmal Danke, daß du dich meinem Problem angenommen hat. Die Schritte zum Erstellen hatte ich egentlich, soweit durchgeführt. Die Dll wurde auch erstellt und mit dem VB-Skript registriert.
Meine Implemnetierung weicht nur in kleinen Teilen von deiner ab. Ich stelle sie mal ein, vielleicht liegt es ja an dem kleinen Unterschied.

SMTPEventSink_TLB.pas:

Delphi-Quellcode:

unit SMTPEventSink_TLB;

// ************************************************************************ //
// WARNUNG                                                                    
// -------                                                                    
// Die in dieser Datei deklarierten Typen wurden aus Daten einer Typbibliothek
// generiert. Wenn diese Typbibliothek explizit oder indirekt (ueber eine     
// andere Typbibliothek) reimportiert wird oder wenn der Befehl            
// 'Aktualisieren' im Typbibliotheks-Editor waehrend des Bearbeitens der     
// Typbibliothek aktiviert ist, wird der Inhalt dieser Datei neu generiert und 
// alle manuell vorgenommenen Aenderungen gehen verloren.                                        
// ************************************************************************ //

// PASTLWTR : 1.2
// Datei generiert am 06.02.2007 08:00:26 aus der unten beschriebenen Typbibliothek.

// ************************************************************************  //
// Typbib: D:\Entwicklung\Projekte\SMTPEventSink\SMTPEventSink.tlb (1)
// LIBID: {DB781A8F-4AC3-4BF7-8EB1-EACA510B4B34}
// LCID: 0
// Hilfedatei: 
// Hilfe-String: SMTPEventSink Bibliothek
// DepndLst: 
//   (1) v1.0 CDO, (C:\WINDOWS\system32\cdosys.dll)
//   (2) v2.0 stdole, (C:\WINDOWS\system32\stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit muss ohne Typueberpruefung fuer Zeiger compiliert werden. 
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface

uses Windows, ActiveX, CDO_TLB, Classes, Graphics, StdVCL, Variants;
  

// *********************************************************************//
// In dieser Typbibliothek deklarierte GUIDS . Es werden folgende        
// Praefixe verwendet:                                                     
//   Typbibliotheken     : LIBID_xxxx                                      
//   CoClasses          : CLASS_xxxx                                      
//   DISPInterfaces     : DIID_xxxx                                       
//   Nicht-DISP-Interfaces: IID_xxxx                                        
// *********************************************************************//
const
  // Haupt- und Nebenversionen der Typbibliothek
  SMTPEventSinkMajorVersion = 1;
  SMTPEventSinkMinorVersion = 0;

  LIBID_SMTPEventSink: TGUID = '{DB781A8F-4AC3-4BF7-8EB1-EACA510B4B34}';

  CLASS_SMTPOnArrival: TGUID = '{272E0DC8-7EAC-42CB-9B37-EBF02299CE9D}';
type

// *********************************************************************//
// Deklaration von in der Typbibliothek definierten CoClasses             
// (HINWEIS: Hier wird jede CoClass ihrem Standard-Interface zugewiesen)              
// *********************************************************************//
  SMTPOnArrival = ISMTPOnArrival;


// *********************************************************************//
// Die Klasse CoSMTPOnArrival stellt die Methoden Create und CreateRemote zur      
// Verfuegung, um Instanzen des Standard-Interface ISMTPOnArrival, dargestellt 
// von CoClass SMTPOnArrival, zu erzeugen. Diese Funktionen koennen                     
// von einem Client verwendet werden, der die CoClasses automatisieren    
// will, die von dieser Typbibliothek dargestellt werden.                                            
// *********************************************************************//
  CoSMTPOnArrival = class
    class function Create: ISMTPOnArrival;
    class function CreateRemote(const MachineName: string): ISMTPOnArrival;
  end;

implementation

uses ComObj;

class function CoSMTPOnArrival.Create: ISMTPOnArrival;
begin
  Result := CreateComObject(CLASS_SMTPOnArrival) as ISMTPOnArrival;
end;

class function CoSMTPOnArrival.CreateRemote(const MachineName: string): ISMTPOnArrival;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_SMTPOnArrival) as ISMTPOnArrival;
end;

end.

Implementor.pas:

Delphi-Quellcode:

unit Implementor;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, CDO_TLB, SMTPEventSink_TLB, StdVcl;

type
  TSMTPOnArrival = class( TAutoObject, IDisclaimer, ISMTPOnArrival)
  protected
       procedure OnArrival(const Msg: IMessage; var EventStatus: CdoEventStatus); safecall;
  end;

implementation

uses ComServ;

const
   ln = #10#13;
   TextDisclaimer =
   ...

   HTMLDisclaimer =
   ...

procedure TSMTPOnArrival.OnArrival(const Msg: IMessage; var EventStatus: CdoEventStatus); safecall;
var
   part1, part2: string;
   p: integer;
begin
     //Textversion
     If Msg.TextBody <> '' Then
     begin
       Msg.TextBody := Msg.TextBody + ln + TextDisclaimer + ln;
     end;
     //HTML-Version
     if Msg.HTMLBody <> '' then
     begin
          p := pos( '</body>', Msg.HTMLBody);
          part1 := Copy( Msg.HTMLBody, 0, p-1);
          part2 := Copy( Msg.HTMLBody, p, Length( Msg.HTMLBody));
          Msg.HTMLBody := Part1+HTMLDisclaimer+Part2;
     end;
     //Änderubgen Zurückschreiben
     Msg.DataSource.Save;
     EventStatus := cdoRunNextSink;
end;

initialization
  TAutoObjectFactory.Create(ComServer, TSMTPOnArrival, Class_SMTPOnArrival,
    ciMultiInstance, tmApartment);
end.