Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Erstellen eines SMTP transport event sink in Delphi (https://www.delphipraxis.net/85554-erstellen-eines-smtp-transport-event-sink-delphi.html)

mkinzler 1. Feb 2007 13:24
Erstellen eines SMTP transport event sink in Delphi
 
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 2. Feb 2007 13:33
Re: Erstellen eines SMTP transport event sink in Delphi
 
push

mkinzler 5. Feb 2007 10:15
Re: Erstellen eines SMTP transport event sink in Delphi
 
Kennt sich hier wirklich Keiner mit diesem Thema aus?

shmia 5. Feb 2007 12:47
Re: Erstellen eines SMTP transport event sink in Delphi
 
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 6. Feb 2007 07:07
Re: Erstellen eines SMTP transport event sink in Delphi
 
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 6. Feb 2007 09:33
Re: Erstellen eines SMTP transport event sink in Delphi
 
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 6. Feb 2007 10:51
Re: Erstellen eines SMTP transport event sink in Delphi
 
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 6. Feb 2007 11:30
Re: Erstellen eines SMTP transport event sink in Delphi
 
Danke Achim, werds mal korrigieren.

mkinzler 9. Feb 2007 09:48
Re: Erstellen eines SMTP transport event sink in Delphi
 
Wie müß dann die Angabe im Registrierungsskript lauten?

shmia 9. Feb 2007 10:03
Re: Erstellen eines SMTP transport event sink in Delphi
 
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.

Remko 14. Feb 2007 18:33
Re: Erstellen eines SMTP transport event sink in Delphi
 
Liste der Anhänge anzeigen (Anzahl: 1)
Might be too late, but I attached a sample for a store event sink, it implements OnSave and OnDelete.
Delphi-Quellcode:
unit DemoEventObject;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, MyEventSink_TLB, StdVcl, Exoledb_TLB;

type
  TExchangeEventSinkDemo = class(TAutoObject, IExchangeEventSinkDemo, IExStoreAsyncEvents)
  public
    function OnSave(const pEventInfo: IExStoreEventInfo;
      const bstrURLItem: WideString; lFlags: Integer): HRESULT; stdcall;
    function OnDelete(const pEventInfo: IExStoreEventInfo;
      const bstrURLItem: WideString; lFlags: Integer): HRESULT; stdcall;
  end;

implementation

uses ComServ, SysUtils, Logging, ADODB_TLB;

{ TExchangeEventSinkDemo }

function TExchangeEventSinkDemo.OnDelete(const pEventInfo: IExStoreEventInfo;
  const bstrURLItem: WideString; lFlags: Integer): HRESULT;
begin
  LogMessageToFile('TExchangeEventSinkDemo.OnDelete');
  try
    LogMessageToFile(' Deleted item URL = "'+bstrURLItem+'"');
    LogMessageToFile(' Flags = '+IntToStr(lFlags));
  except
    on Ex: Exception do begin
      LogMessageToFile('Unhandled exception: "'+Ex.Message+'"');
    end;
  end;
  Result := S_OK;
end;

function TExchangeEventSinkDemo.OnSave(const pEventInfo: IExStoreEventInfo;
  const bstrURLItem: WideString; lFlags: Integer): HRESULT;
var
  ADORecord : ADODB_TLB._Record;
  ADOConn  : ADODB_TLB.Connection;

begin
  LogMessageToFile('TExchangeEventSinkDemo.OnSave');
  try
    LogMessageToFile(' Saved item URL = "'+bstrURLItem+'"');
    LogMessageToFile(' Flags = '+IntToStr(lFlags));
    { open the item given by the URL with ADO }
    ADOConn := CoConnection.Create();
    ADOConn.Provider := 'Exoledb.DataSource.1';
    ADOConn.Open(bstrURLItem,'','',0);
    ADORecord := CoRecord_.Create();
    ADORecord.Open(bstrURLItem,ADOConn.ConnectionString,
      adModeRead,adFailIfNotExists,adOpenSource,'','');
    LogMessageToFile(' Subject = '+ADORecord.Fields['urn:schemas:mailheader:subject'].Value);
    LogMessageToFile(' From = '+ADORecord.Fields['urn:schemas:mailheader:from'].Value);
    { clean up }
    ADORecord.Close;
    ADOConn.Close;
    LogMessageToFile('Done processing OnSave event');
  except
    on Ex: Exception do begin
      LogMessageToFile('Unhandled exception: "'+Ex.Message+'"');
    end;
  end;
  Result := S_OK;
end;

initialization
  LogMessageToFile('Initializing MyEventSink v1.0');
  TAutoObjectFactory.Create(ComServer, TExchangeEventSinkDemo, Class_ExchangeEventSinkDemo,
    ciMultiInstance, tmNeutral);
  LogMessageToFile('Initialization done');
end.
Delphi-Quellcode:
unit MyEventSink_TLB;

// ************************************************************************ //
// WARNING                                                                  
// -------                                                                   
// The types declared in this file were generated from data read from a      
// Type Library. If this type library is explicitly or indirectly (via      
// another type library referring to this type library) re-imported, or the  
// 'Refresh' command of the Type Library Editor activated while editing the  
// Type Library, the contents of this file will be regenerated and all      
// manual modifications will be lost.                                        
// ************************************************************************ //

// PASTLWTR : 1.2
// File generated on 3.5.2006 19:17:14 from Type Library described below.

// ************************************************************************  //
// Type Lib: E:\Documents\Magazines\The Delphi Magazine\Exchange Programming\Example Apps\Event Sink Test\MyEventSink.tlb (1)
// LIBID: {8F99DE0D-AE29-4787-A3F0-4BA9996B88EF}
// LCID: 0
// Helpfile:
// HelpString: MyEventSink Library
// DepndLst:
//   (1) v2.0 stdole, (C:\WINDOWS\system32\STDOLE2.TLB)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface

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

// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:      
//   Type Libraries    : LIBID_xxxx                                    
//   CoClasses         : CLASS_xxxx                                    
//   DISPInterfaces    : DIID_xxxx                                      
//   Non-DISP interfaces: IID_xxxx                                      
// *********************************************************************//
const
  // TypeLibrary Major and minor versions
  MyEventSinkMajorVersion = 1;
  MyEventSinkMinorVersion = 0;

  LIBID_MyEventSink: TGUID = '{8F99DE0D-AE29-4787-A3F0-4BA9996B88EF}';

  IID_IExchangeEventSinkDemo: TGUID = '{908B4257-30B4-4E88-B944-DBB2D085B903}';
  CLASS_ExchangeEventSinkDemo: TGUID = '{D6EEB042-98CD-4707-9A19-2081A6F39AEF}';
type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary                  
// *********************************************************************//
  IExchangeEventSinkDemo = interface;
  IExchangeEventSinkDemoDisp = dispinterface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library                      
// (NOTE: Here we map each CoClass to its Default Interface)            
// *********************************************************************//
  ExchangeEventSinkDemo = IExchangeEventSinkDemo;


// *********************************************************************//
// Interface: IExchangeEventSinkDemo
// Flags:    (4416) Dual OleAutomation Dispatchable
// GUID:     {908B4257-30B4-4E88-B944-DBB2D085B903}
// *********************************************************************//
  IExchangeEventSinkDemo = interface(IDispatch)
    ['{908B4257-30B4-4E88-B944-DBB2D085B903}']
  end;

// *********************************************************************//
// DispIntf: IExchangeEventSinkDemoDisp
// Flags:    (4416) Dual OleAutomation Dispatchable
// GUID:     {908B4257-30B4-4E88-B944-DBB2D085B903}
// *********************************************************************//
  IExchangeEventSinkDemoDisp = dispinterface
    ['{908B4257-30B4-4E88-B944-DBB2D085B903}']
  end;

// *********************************************************************//
// The Class CoExchangeEventSinkDemo provides a Create and CreateRemote method to        
// create instances of the default interface IExchangeEventSinkDemo exposed by            
// the CoClass ExchangeEventSinkDemo. The functions are intended to be used by            
// clients wishing to automate the CoClass objects exposed by the        
// server of this typelibrary.                                          
// *********************************************************************//
  CoExchangeEventSinkDemo = class
    class function Create: IExchangeEventSinkDemo;
    class function CreateRemote(const MachineName: string): IExchangeEventSinkDemo;
  end;

implementation

uses ComObj;

class function CoExchangeEventSinkDemo.Create: IExchangeEventSinkDemo;
begin
  Result := CreateComObject(CLASS_ExchangeEventSinkDemo) as IExchangeEventSinkDemo;
end;

class function CoExchangeEventSinkDemo.CreateRemote(const MachineName: string): IExchangeEventSinkDemo;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_ExchangeEventSinkDemo) as IExchangeEventSinkDemo;
end;

end.
Delphi-Quellcode:
unit Exoledb_TLB;

// ************************************************************************ //
// WARNING                                                                  
// -------                                                                   
// The types declared in this file were generated from data read from a      
// Type Library. If this type library is explicitly or indirectly (via      
// another type library referring to this type library) re-imported, or the  
// 'Refresh' command of the Type Library Editor activated while editing the  
// Type Library, the contents of this file will be regenerated and all      
// manual modifications will be lost.                                        
// ************************************************************************ //

// PASTLWTR : 1.2
// File generated on 10.4.2006 20:32:51 from Type Library described below.

// ************************************************************************  //
// Type Lib: E:\Documents\Borland Studio Projects\Exchange Events\exoledb.dll (2)
// LIBID: {9DA0E107-86CE-11D1-8699-00C04FB98036}
// LCID: 0
// Helpfile:
// HelpString: EXOLEDB Type Library
// DepndLst:
//   (1) v2.0 stdole, (C:\WINDOWS\system32\STDOLE2.TLB)
// Parent TypeLibrary:
//   (0) v1.0 MyExchangeEvents, (E:\Documents\Borland Studio Projects\Exchange Events\MyExchangeEvents.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface

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

// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:      
//   Type Libraries    : LIBID_xxxx                                    
//   CoClasses         : CLASS_xxxx                                    
//   DISPInterfaces    : DIID_xxxx                                      
//   Non-DISP interfaces: IID_xxxx                                      
// *********************************************************************//
const
  // TypeLibrary Major and minor versions
  ExoledbMajorVersion = 1;
  ExoledbMinorVersion = 0;

  LIBID_Exoledb: TGUID = '{9DA0E107-86CE-11D1-8699-00C04FB98036}';

  IID_IExStoreEventInfo: TGUID = '{9DA0E100-86CE-11D1-8699-00C04FB98036}';
  IID_IExStoreDispEventInfo: TGUID = '{9DA0E110-86CE-11D1-8699-00C04FB98036}';
  IID_IExStoreAsyncEvents: TGUID = '{9DA0E0FE-86CE-11D1-8699-00C04FB98036}';
  IID_IExStoreSyncEvents: TGUID = '{9DA0E0FF-86CE-11D1-8699-00C04FB98036}';
  IID_IExStoreSystemEvents: TGUID = '{9DA0E101-86CE-11D1-8699-00C04FB98036}';
  IID_IExStoreLockEvents: TGUID = '{9DA0E10E-86CE-11D1-8699-00C04FB98036}';
  IID_IGetLockRow: TGUID = '{9DA0E0EF-86CE-11D1-8699-00C04FB98036}';
  IID_IExStoreEventLogonInfo: TGUID = '{9DA0E111-86CE-11D1-8699-00C04FB98036}';
  IID_IGetSourceURL: TGUID = '{9DA0E10B-86CE-11D1-8699-00C04FB98036}';
  IID_IExStoreEventRegistrationURL: TGUID = '{9DA0E117-86CE-11D1-8699-00C04FB98036}';
  IID_ICreateRegistration: TGUID = '{9DA0E11C-86CE-11D1-8699-00C04FB98036}';
  IID_IExStoreNotification: TGUID = '{9DA0E129-86CE-11D1-8699-00C04FB98036}';
  IID_IExStoreRegisterNotification: TGUID = '{9DA0E12A-86CE-11D1-8699-00C04FB98036}';
  IID_IExoledbUrlMapper: TGUID = '{9DA0E11D-86CE-11D1-8699-00C04FB98036}';
  CLASS_ExoledbUrlMapper: TGUID = '{9DA0E11E-86CE-11D1-8699-00C04FB98036}';
  IID_IStoreGuidFromUrl: TGUID = '{9DA0E10C-86CE-11D1-8699-00C04FB98036}';
  CLASS_StoreGuidFromUrl: TGUID = '{9DA0E10D-86CE-11D1-8699-00C04FB98036}';

// *********************************************************************//
// Declaration of Enumerations defined in Type Library                  
// *********************************************************************//
// Constants for enum EVT_SINK_FLAGS
type
  EVT_SINK_FLAGS = TOleEnum;
const
  EVT_NEW_ITEM = $00000001;
  EVT_IS_COLLECTION = $00000002;
  EVT_REPLICATED_ITEM = $00000004;
  EVT_IS_DELIVERED = $00000008;
  EVT_SYNC_BEGIN = $01000000;
  EVT_SYNC_COMMITTED = $02000000;
  EVT_SYNC_ABORTED = $04000000;
  EVT_SOFTDELETE = $00000010;
  EVT_HARDDELETE = $00000020;
  EVT_INITNEW = $00000040;
  EVT_MOVE = $00000100;
  EVT_COPY = $00000200;
  EVT_DRAFT_CREATE = $00000400;
  EVT_DRAFT_SAVE = $00000800;
  EVT_DRAFT_CHECKIN = $00001000;
  EVT_INVALID_SOURCE_URL = $20000000;
  EVT_INVALID_URL = $40000000;
  EVT_ERROR = $80000000;
  EVT_LOCKTYPE_READ = $00010000;
  EVT_LOCKTYPE_WRITE = $00020000;
  EVT_LOCKTYPE_CHECKOUT = $00040000;
  EVT_LOCKTYPE_READWRITE = $00030000;
  EVT_LOCKSCOPE_SHARED = $00080000;
  EVT_LOCKSCOPE_EXCLUSIVE = $00100000;
  EVT_UNLOCK_CHECKIN_ABORT = $00200000;
  EVT_UNLOCK_CHECKIN_KEEP_LOCKED = $00400000;
  EVT_LOCKDEPTH_DEEP = $00800000;
  EVT_LOCK_TRANSIENT = $00002000;
  EVT_VIRUS_CLEANED = $00004000;

type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary                  
// *********************************************************************//
  IExStoreEventInfo = interface;
  IExStoreDispEventInfo = interface;
  IExStoreDispEventInfoDisp = dispinterface;
  IExStoreAsyncEvents = interface;
  IExStoreSyncEvents = interface;
  IExStoreSystemEvents = interface;
  IExStoreLockEvents = interface;
  IGetLockRow = interface;
  IExStoreEventLogonInfo = interface;
  IGetSourceURL = interface;
  IExStoreEventRegistrationURL = interface;
  IExStoreEventRegistrationURLDisp = dispinterface;
  ICreateRegistration = interface;
  IExStoreNotification = interface;
  IExStoreRegisterNotification = interface;
  IExoledbUrlMapper = interface;
  IExoledbUrlMapperDisp = dispinterface;
  IStoreGuidFromUrl = interface;
  IStoreGuidFromUrlDisp = dispinterface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library                      
// (NOTE: Here we map each CoClass to its Default Interface)            
// *********************************************************************//
  ExoledbUrlMapper = IExoledbUrlMapper;
  StoreGuidFromUrl = IStoreGuidFromUrl;


// *********************************************************************//
// Declaration of structures, unions and aliases.                        
// *********************************************************************//
  PUserType1 = ^TGUID; {*}
  PUserType2 = ^_SID; {*}

  LONG_PTR = Integer;

  _SID_IDENTIFIER_AUTHORITY = packed record
    Value: array[0..5] of Byte;
  end;

  _SID = packed record
    Revision: Byte;
    SubAuthorityCount: Byte;
    IdentifierAuthority: _SID_IDENTIFIER_AUTHORITY;
    SubAuthority: ^LongWord;
  end;

  ULONG_PTR = LongWord;

// *********************************************************************//
// Interface: IExStoreEventInfo
// Flags:    (0)
// GUID:     {9DA0E100-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IExStoreEventInfo = interface(IUnknown)
    ['{9DA0E100-86CE-11D1-8699-00C04FB98036}']
    function RemoteGetEventItem(var riid: TGUID; out pdwBindStatus: LongWord;
                                out ppunkEventItem: IUnknown): HResult; stdcall;
    function RemoteGetEventSession(var riid: TGUID; out ppSession: IUnknown): HResult; stdcall;
    function Abort(lErrorCode: Integer): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IExStoreDispEventInfo
// Flags:    (4416) Dual OleAutomation Dispatchable
// GUID:     {9DA0E110-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IExStoreDispEventInfo = interface(IDispatch)
    ['{9DA0E110-86CE-11D1-8699-00C04FB98036}']
    function Get_EventConnection: IDispatch; safecall;
    function Get_EventRecord: IDispatch; safecall;
    procedure AbortChange(lErrorCode: Integer); safecall;
    function Get_SourceURL: WideString; safecall;
    function Get_UserGuid: WideString; safecall;
    function Get_StoreGuid: WideString; safecall;
    function Get_UserSid: OleVariant; safecall;
    function Get_Data: LONG_PTR; safecall;
    procedure Set_Data(plData: LONG_PTR); safecall;
    property EventConnection: IDispatch read Get_EventConnection;
    property EventRecord: IDispatch read Get_EventRecord;
    property SourceURL: WideString read Get_SourceURL;
    property UserGuid: WideString read Get_UserGuid;
    property StoreGuid: WideString read Get_StoreGuid;
    property UserSid: OleVariant read Get_UserSid;
    property Data: LONG_PTR read Get_Data write Set_Data;
  end;

// *********************************************************************//
// DispIntf: IExStoreDispEventInfoDisp
// Flags:    (4416) Dual OleAutomation Dispatchable
// GUID:     {9DA0E110-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IExStoreDispEventInfoDisp = dispinterface
    ['{9DA0E110-86CE-11D1-8699-00C04FB98036}']
    property EventConnection: IDispatch readonly dispid 1610743808;
    property EventRecord: IDispatch readonly dispid 1610743809;
    procedure AbortChange(lErrorCode: Integer); dispid 1610743810;
    property SourceURL: WideString readonly dispid 1610743811;
    property UserGuid: WideString readonly dispid 1610743812;
    property StoreGuid: WideString readonly dispid 1610743813;
    property UserSid: OleVariant readonly dispid 1610743814;
    property Data: LONG_PTR dispid 1610743815;
  end;

// *********************************************************************//
// Interface: IExStoreAsyncEvents
// Flags:    (0)
// GUID:     {9DA0E0FE-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IExStoreAsyncEvents = interface(IUnknown)
    ['{9DA0E0FE-86CE-11D1-8699-00C04FB98036}']
    function OnSave(const pEventInfo: IExStoreEventInfo; const bstrURLItem: WideString;
                    lFlags: Integer): HResult; stdcall;
    function OnDelete(const pEventInfo: IExStoreEventInfo; const bstrURLItem: WideString;
                      lFlags: Integer): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IExStoreSyncEvents
// Flags:    (0)
// GUID:     {9DA0E0FF-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IExStoreSyncEvents = interface(IUnknown)
    ['{9DA0E0FF-86CE-11D1-8699-00C04FB98036}']
    function OnSyncSave(const pEventInfo: IExStoreEventInfo; const bstrURLItem: WideString;
                        lFlags: Integer): HResult; stdcall;
    function OnSyncDelete(const pEventInfo: IExStoreEventInfo; const bstrURLItem: WideString;
                          lFlags: Integer): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IExStoreSystemEvents
// Flags:    (0)
// GUID:     {9DA0E101-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IExStoreSystemEvents = interface(IUnknown)
    ['{9DA0E101-86CE-11D1-8699-00C04FB98036}']
    function OnTimer(const bstrURLItem: WideString; lFlags: Integer): HResult; stdcall;
    function OnMDBStartUp(const bstrMDBGuid: WideString; const bstrMDBName: WideString;
                          lFlags: Integer): HResult; stdcall;
    function OnMDBShutDown(const bstrMDBGuid: WideString; lFlags: Integer): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IExStoreLockEvents
// Flags:    (0)
// GUID:     {9DA0E10E-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IExStoreLockEvents = interface(IUnknown)
    ['{9DA0E10E-86CE-11D1-8699-00C04FB98036}']
    function OnSyncLock(const pEventInfo: IExStoreEventInfo; const bstrURLItem: WideString;
                        lFlags: Integer): HResult; stdcall;
    function OnSyncUnlock(const pEventInfo: IExStoreEventInfo; const bstrURLItem: WideString;
                          lFlags: Integer): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IGetLockRow
// Flags:    (0)
// GUID:     {9DA0E0EF-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IGetLockRow = interface(IUnknown)
    ['{9DA0E0EF-86CE-11D1-8699-00C04FB98036}']
    function GetLockRow(var riid: TGUID; out pdwBindStatus: LongWord; out ppunkLockRow: IUnknown): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IExStoreEventLogonInfo
// Flags:    (0)
// GUID:     {9DA0E111-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IExStoreEventLogonInfo = interface(IUnknown)
    ['{9DA0E111-86CE-11D1-8699-00C04FB98036}']
    function GetUserGuid(var pguid: TGUID): HResult; stdcall;
    function GetStoreGuid(var pguid: TGUID): HResult; stdcall;
    function GetUserSid(out ppsid: PUserType2): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IGetSourceURL
// Flags:    (0)
// GUID:     {9DA0E10B-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IGetSourceURL = interface(IUnknown)
    ['{9DA0E10B-86CE-11D1-8699-00C04FB98036}']
    function GetSourceURL(out pbstrURL: WideString): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IExStoreEventRegistrationURL
// Flags:    (4416) Dual OleAutomation Dispatchable
// GUID:     {9DA0E117-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IExStoreEventRegistrationURL = interface(IDispatch)
    ['{9DA0E117-86CE-11D1-8699-00C04FB98036}']
    function Get_EventRegistrationURL: WideString; safecall;
    property EventRegistrationURL: WideString read Get_EventRegistrationURL;
  end;

// *********************************************************************//
// DispIntf: IExStoreEventRegistrationURLDisp
// Flags:    (4416) Dual OleAutomation Dispatchable
// GUID:     {9DA0E117-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IExStoreEventRegistrationURLDisp = dispinterface
    ['{9DA0E117-86CE-11D1-8699-00C04FB98036}']
    property EventRegistrationURL: WideString readonly dispid 1610743808;
  end;

// *********************************************************************//
// Interface: ICreateRegistration
// Flags:    (0)
// GUID:     {9DA0E11C-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  ICreateRegistration = interface(IUnknown)
    ['{9DA0E11C-86CE-11D1-8699-00C04FB98036}']
    function Register(const pEventInfo: IExStoreEventInfo; const bstrURLItem: WideString;
                      lFlags: Integer; out phr: Integer): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IExStoreNotification
// Flags:    (0)
// GUID:     {9DA0E129-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IExStoreNotification = interface(IUnknown)
    ['{9DA0E129-86CE-11D1-8699-00C04FB98036}']
    function OnChange(dwHandle: ULONG_PTR; dwFlags: LongWord): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IExStoreRegisterNotification
// Flags:    (0)
// GUID:     {9DA0E12A-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IExStoreRegisterNotification = interface(IUnknown)
    ['{9DA0E12A-86CE-11D1-8699-00C04FB98036}']
    function Register(const bstrURL: WideString; const pSink: IExStoreNotification;
                      dwFlags: LongWord; out pdwHandle: ULONG_PTR): HResult; stdcall;
    function UnRegister(dwHandle: ULONG_PTR): HResult; stdcall;
    function Ready(dwHandle: ULONG_PTR; out pdwRemaining: LongWord): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IExoledbUrlMapper
// Flags:    (4416) Dual OleAutomation Dispatchable
// GUID:     {9DA0E11D-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IExoledbUrlMapper = interface(IDispatch)
    ['{9DA0E11D-86CE-11D1-8699-00C04FB98036}']
    function HttpUrlToFilePath(const bstrHttpUrl: WideString): WideString; safecall;
    function FilePathToHttpUrls(const bstrFilePath: WideString): PSafeArray; safecall;
    function FilePathToExoledbFileUrl(const bstrFilePath: WideString): WideString; safecall;
    function ExoledbFileUrlToFilePath(const bstrExoledbFileUrl: WideString): WideString; safecall;
  end;

// *********************************************************************//
// DispIntf: IExoledbUrlMapperDisp
// Flags:    (4416) Dual OleAutomation Dispatchable
// GUID:     {9DA0E11D-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IExoledbUrlMapperDisp = dispinterface
    ['{9DA0E11D-86CE-11D1-8699-00C04FB98036}']
    function HttpUrlToFilePath(const bstrHttpUrl: WideString): WideString; dispid 1610743808;
    function FilePathToHttpUrls(const bstrFilePath: WideString): {??PSafeArray}OleVariant; dispid 1610743809;
    function FilePathToExoledbFileUrl(const bstrFilePath: WideString): WideString; dispid 1610743810;
    function ExoledbFileUrlToFilePath(const bstrExoledbFileUrl: WideString): WideString; dispid 1610743811;
  end;

// *********************************************************************//
// Interface: IStoreGuidFromUrl
// Flags:    (4416) Dual OleAutomation Dispatchable
// GUID:     {9DA0E10C-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IStoreGuidFromUrl = interface(IDispatch)
    ['{9DA0E10C-86CE-11D1-8699-00C04FB98036}']
    function StoreGuidFromUrl(const bstrURL: WideString): WideString; safecall;
  end;

// *********************************************************************//
// DispIntf: IStoreGuidFromUrlDisp
// Flags:    (4416) Dual OleAutomation Dispatchable
// GUID:     {9DA0E10C-86CE-11D1-8699-00C04FB98036}
// *********************************************************************//
  IStoreGuidFromUrlDisp = dispinterface
    ['{9DA0E10C-86CE-11D1-8699-00C04FB98036}']
    function StoreGuidFromUrl(const bstrURL: WideString): WideString; dispid 1610743808;
  end;

// *********************************************************************//
// The Class CoExoledbUrlMapper provides a Create and CreateRemote method to        
// create instances of the default interface IExoledbUrlMapper exposed by            
// the CoClass ExoledbUrlMapper. The functions are intended to be used by            
// clients wishing to automate the CoClass objects exposed by the        
// server of this typelibrary.                                          
// *********************************************************************//
  CoExoledbUrlMapper = class
    class function Create: IExoledbUrlMapper;
    class function CreateRemote(const MachineName: string): IExoledbUrlMapper;
  end;

// *********************************************************************//
// The Class CoStoreGuidFromUrl provides a Create and CreateRemote method to        
// create instances of the default interface IStoreGuidFromUrl exposed by            
// the CoClass StoreGuidFromUrl. The functions are intended to be used by            
// clients wishing to automate the CoClass objects exposed by the        
// server of this typelibrary.                                          
// *********************************************************************//
  CoStoreGuidFromUrl = class
    class function Create: IStoreGuidFromUrl;
    class function CreateRemote(const MachineName: string): IStoreGuidFromUrl;
  end;

implementation

uses ComObj;

class function CoExoledbUrlMapper.Create: IExoledbUrlMapper;
begin
  Result := CreateComObject(CLASS_ExoledbUrlMapper) as IExoledbUrlMapper;
end;

class function CoExoledbUrlMapper.CreateRemote(const MachineName: string): IExoledbUrlMapper;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_ExoledbUrlMapper) as IExoledbUrlMapper;
end;

class function CoStoreGuidFromUrl.Create: IStoreGuidFromUrl;
begin
  Result := CreateComObject(CLASS_StoreGuidFromUrl) as IStoreGuidFromUrl;
end;

class function CoStoreGuidFromUrl.CreateRemote(const MachineName: string): IStoreGuidFromUrl;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_StoreGuidFromUrl) as IStoreGuidFromUrl;
end;

end.

mkinzler 14. Feb 2007 18:38
Re: Erstellen eines SMTP transport event sink in Delphi
 
Thanks Remoko, I will have look on it.


Alle Zeitangaben in WEZ +1. Es ist jetzt 15:08 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz