unit SrvUnit2;interfaceuses  ComObj, ActiveX, AxCtrls, Classes, SrvEvent_TLB, StdVcl, Srvunit1;type  TSimpleEventServer = class(TAutoObject, IConnectionPointContainer, ISimpleEventServer)  private    {
     Private declarations }    FConnectionPoints: TConnectionPoints;    FConnectionPoint: TConnectionPoint;    FEvents: ISimpleEventServerEvents;    {
     note: FEvents maintains a *single* event sink. For access to more      than one event sink, use FConnectionPoint.SinkList, and iterate      through the list of sinks. }  public    procedure Initialize; override;  protected    {
     Protected declarations }    property ConnectionPoints: TConnectionPoints read FConnectionPoints      implements IConnectionPointContainer;    procedure EventSinkChanged(const EventSink: IUnknown); override;    procedure CallServer; safecall;  end;implementationuses ComServ;procedure TSimpleEventServer.EventSinkChanged(const EventSink: IUnknown);begin  FEvents := EventSink as ISimpleEventServerEvents;end;procedure TSimpleEventServer.Initialize;begin  inherited Initialize;  FConnectionPoints := TConnectionPoints.Create(Self);  if AutoFactory.EventTypeInfo <> nil then    FConnectionPoint := FConnectionPoints.CreateConnectionPoint(      AutoFactory.EventIID, ckSingle, EventConnect)  else FConnectionPoint := nil;end;procedure TSimpleEventServer.CallServer;begin  Form1.Memo1.Lines.Add('I have been called by a client');  if FEvents <> nil then  begin    FEvents.EventFired;    Form1.Memo1.Lines.Add('I am firing an Event');  end;end;initialization  TAutoObjectFactory.Create(ComServer, TSimpleEventServer, Class_SimpleEventServer,    ciMultiInstance, tmApartment);end.

 

unit ClientUnit;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs,SrvEvent_TLB,ActiveX, ComObj, StdCtrls;type  TForm2 = class(TForm)    Button1: TButton;    Memo1: TMemo;    procedure FormCreate(Sender: TObject);    procedure Button1Click(Sender: TObject);    procedure FormDestroy(Sender: TObject);  private    {
     Private declarations }    FServer: ISimpleEventServer;    FEventSink: IUnknown;    FConnectionToken: integer;  public    {
     Public declarations }    procedure OnEventFired;  end;  TEventSink = class(TInterfacedObject, IUnknown,IDispatch)  private    FController: TForm2;    {
    IUknown methods}    function QueryInterface(const IID: TGUID; out Obj):HResult;stdcall;    {
    Idispatch}    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;    function GetIDsOfNames(const IID: TGUID; Names: Pointer;      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;  public    constructor Create(Controller: TForm2);  end;var  Form2: TForm2;implementation{
    $R *.dfm}procedure TForm2.OnEventFired;begin  Memo1.Lines.Add('I have recieved an event');end;constructor TEventSink.Create(Controller: TForm2);begin  inherited Create;  FController := Controller;end;function TEventSink.Invoke(DispID: integer; const IID: TGUID; LocaleID: integer; Flags: Word; var Params; VarResult,ExcepInfo,ArgErr:Pointer): HResult;begin  Result := S_OK;  case DispID of    1: FController.OnEventFired;  end;end;function TEventSink.QueryInterface(const IID: TGUID; out Obj):HResult;stdcall;begin  if GetInterFace(IID,Obj) then    Result := S_OK  else if IsEqualIID(IID,ISimpleEventServerEvents) then    Result := QueryInterface(IDispatch,Obj)  else    Result := E_NOINTERFACE;end;function TEventSink.GetTypeInfoCount(out Count: Integer): HResult;begin  Result := S_OK;end;function TEventSink.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;begin  Result := S_OK;end;function TEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;begin  Result := S_OK;end;procedure TForm2.FormCreate(Sender: TObject);begin  FServer := CoSimpleEventServer.Create;  FEventSink := TEventSink.Create(form2);  InterfaceConnect(FServer, ISimpleEventServerEvents,FEventSink,FConnectionToken);end;procedure TForm2.Button1Click(Sender: TObject);begin  Memo1.Lines.Add('I am calling the Server');  FServer.CallServer;end;procedure TForm2.FormDestroy(Sender: TObject);begin  InterfaceDisconnect(FServer,ISimpleEventServer,FConnectionToken);  FServer := nil;  FEventSink := nil;end;end.