TDisclaimer = class(TAutoObject, IDisclaimer, ISMTPOnArrival)
  protected
    procedure OnArrival(const Msg: IMessage; var EventStatus: CdoEventStatus);
      safecall;
    { Protected-Deklarationen }
  end;

uses
  ComObj, ActiveX, SMTPEventSink_TLB, StdVcl, CDO_TLB;

type
  TDisclaimer = class(TAutoObject, IDisclaimer, ISMTPOnArrival)
  protected
    procedure OnArrival(const Msg: IMessage; var EventStatus: CdoEventStatus);
      safecall;
    { Protected-Deklarationen }
  end;

implementation

uses ComServ, Dialogs, Windows;

procedure TDisclaimer.OnArrival(const Msg: IMessage;
  var EventStatus: CdoEventStatus);
begin
   MessageDlg('in TDisclaimer.OnArrival'#13#10+msg.TextBody, mtInformation, [mbOK], 0);
end;

initialization
  TAutoObjectFactory.Create(ComServer, TDisclaimer, Class_Disclaimer,
    ciMultiInstance, tmApartment);
end.

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.

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.

const
   ln = #10#13; // besser sLineBreak oder #13#10
   TextDisclaimer =
   ...