Erstellen eines SMTP transport event sink in Delphi

[mkinzler]

Habe versucht dies in Delphi zu Realisieren: http://support.microsoft.com/default...b;en-us;317327
Erstellen hat funktioniert, Registrieren ging auch on Fehler, es passiert aber nicht.
Im Registrierungsskript muß man den (VB-)Modulnamen angeben, da Delphi ,.W. sowas nicht hat habe ich ihn weggelassen, könnte das der Grund sein?

[mkinzler]

push

[mkinzler]

Kennt sich hier wirklich Keiner mit diesem Thema aus?

[shmia]

Der Weg geht ungefähr so:
1.) Datei-> Neu -> ActiveX -> ActiveX-Bibliothek
Projekt Speichern unter: SMTPEventSink
2.) Datei-> Neu -> ActiveX -> Automatisierungsobjekt
Name: Discalimer
3.) Projekt->Ansicht->Typbibliothek
4.) im TBL-Editor auf "Verwendet" gehen
im Contextmenue: "Alle Typbibliotheken anzeigen"
5.) "Microsoft CDO for Windows 2000" ankreuzen
6.) im Kontextmenu: "Auswahl anzeigen"
jetzt haben wir die fremde TLB includiert
7.) CoClass "Discalaimer" anwählen, auf Seite "Implementierung" gehen
8.) im Kontextmenue die Schnittstelle "IDisclaimer" entfernen und Schnittstelle "ISMTPOnArrival" hinzufügen
9.) im TLB-Editor auf den Button "Implementierung aktualisieren" klicken
nun sieht der Sourcecode so aus:

Delphi-Quellcode:

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

10.) Methode OnArrival ausprogrammieren. Zunächst empfiehlt es sich, nur einen
Aufruf von MessageDlg zu machen:

Delphi-Quellcode:

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.

Was jetzt noch fehlt, ist die Registrierung der CoClass.
Kämpf dich mal so weit vor und frag dann nochmal falls du nicht weiterkommst.

[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.

[shmia]

Das sieht soweit ganz gut aus.
Du solltest noch die Procedure Initialize überschreiben und dort eine MessageBox oder Logdateiausgabe platzieren.
Einfach nur um herauszufinden, ob deine CoClass überhaupt erzeugt wird.

[marabu]

Hallo Markus,

ich fürchte du hast da eine eindeutige Protokollverletzung eingebaut:

Delphi-Quellcode:

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

Freundliche Grüße

[mkinzler]

Danke Achim, werds mal korrigieren.

[mkinzler]

Wie müß dann die Angabe im Registrierungsskript lauten?

[shmia]

Deine TLB heisst: SMTPEventSink
Deine CoClass heisst: SMTPOnArrival
Also ist die ProgID: SMTPEventSink.SMTPOnArrival

Zitat:

Register the event sink
To register the event sink, use the Smtpreg.vbs file that is installed with the Exchange software development kit (SDK). 1. At a command prompt, locate the \Exchange SDK\SDK\Support\CDO\Scripts folder, and then type the following: cscript smtpreg.vbs /add 1 OnArrival SMTPDisclaimer ProgId "mail from=*@your-domain-here.com"

If this command succeeds, you receive a success message that is generated by the script.
2. To unregister this event, type the following: cscript smtpreg.vbs /remove 1 OnArrival SMTPDisclaimer

Ich schätze mal, der Name "SMTPDisclaimer" ist frei wählbar, um damit später die Registrierung wieder aufheben zu können.