Automation in Delphi COM Programming

COM Events and Callbacks

Delphi programmers take events for granted in their everyday programming tasks. So far, I haven't shown you any automation controllers that fire events. Even though this is not really an advanced feature, you're going to have to do just a little bit of work in Delphi to support events. It certainly is less work than what you would expect to do in other languages, but nonetheless, Delphi does not make COM events completely seamless. (Of course, we can always look forward to future versions of Delphi!)

You can use either dispinterfaces or interfaces for implementing a mechanism in which the server calls back into the client application. Both have their advantages and disadvantages. Delphi provides better support for events through dispinterfaces, and you must use dispinterfaces if you intend for your code to be compatible with Visual Basic. Interfaces are slightly faster than dispinterfaces, but they are not compatible with Visual Basic, and you will have to write more code to support them. The following two sections discuss each method in detail.

Regardless of the method used, the end result is the same. The client application provides the server with an interface that the server uses to call the client back.

Dispinterfaces

Delphi provides some automatic support for dispinterface events, so we'll take a look at creating a server and client that make use of dispinterface events first.

Creating the Automation Server

For illustrative purposes, let's create an Automation server that lets multiple connected clients send text back and forth. In other words, a simple chat server.

Delphi can automatically handle the creation of Automation servers that support dispinterface-based events. Create a new application, and then run the Automation Object Wizard by selecting Automation Object from the Object Repository.

Figure 4.12 shows the Automation Object Wizard filled out to support event handling. Click OK to generate the source code for this object and display the Type Library Editor.

Figure 4.12
Adding event handling to a dispinterface.

You'll notice that this time, Delphi creates two interfaces: one for the COM object and one for the events that will be fired by the object.

Add a method to the IEventIntf interface named SendText. Give it a parameter named Text, of type WideString. Next, add an event to the IEventIntfEvents dispinterface named OnText. Add a WideString parameter named Text.

Click the Refresh Implementation button in the Type Library Editor and then close the Type Library Editor. Save the file as EventIntf.pas. At this point, the source code for the Automation server will look like the code in Listing 4.7.

Listing 4.7  EventSrv Automation Server—EventIntf.pas

unit EventIntf;

interface

uses
 ComObj, ActiveX, AxCtrls, Project1_TLB;

type
 TEventIntf = class(TAutoObject, IConnectionPointContainer, IEventIntf)
 private
  { Private declarations }
  FConnectionPoints: TConnectionPoints;
  FEvents: IEventIntfEvents;
 public
  procedure Initialize; override;
 protected
  { Protected declarations }
  property ConnectionPoints: TConnectionPoints read FConnectionPoints
   implements IConnectionPointContainer;
  procedure EventSinkChanged(const EventSink: IUnknown); override;
  procedure SendText(const Text: WideString); safecall;
 end;

implementation

uses ComServ;

procedure TEventIntf.EventSinkChanged(const EventSink: IUnknown);
begin
 FEvents := EventSink as IEventIntfEvents;
end;

procedure TEventIntf.Initialize;
begin
 inherited Initialize;
 FConnectionPoints := TConnectionPoints.Create(Self);
 if AutoFactory.EventTypeInfo <> nil then
  FConnectionPoints.CreateConnectionPoint(AutoFactory.EventIID,
   ckSingle, EventConnect);
end;

procedure TEventIntf.SendText(const Text: WideString);
begin
end;

initialization
 TAutoObjectFactory.Create(ComServer, TEventIntf, Class_EventIntf,
  ciMultiInstance, tmApartment);
end.

All we need to do is flesh out the SendText method, so add the following code to the unit:

procedure TEventIntf.SendText(const Text: WideString);
begin
 FEvents.OnText(Text);
end;

Compile this server, and register it by running it once.

The source code for the automatically generated EventSrv_TLB.pas file is shown in Listing 4.8.

Listing 4.8  EventSrv Automation Server—EventSrv_TLB.pas

unit EventSrv_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 : $Revision:  1.11.1.75 $
// File generated on 7/31/99 2:22:22 PM from Type Library described below.

// ************************************************************************ //
// Type Lib: J:\Book\samples\Chap04\EventSrv\EventSrv.tlb
// IID\LCID: {34FB8111-476E-11D3-B83E-0040F67455FE}\0
// Helpfile: 
// HelpString: Project1 Library
// Version:  1.0
// ************************************************************************ //

interface

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

// *********************************************************************//
// 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
 LIBID_EventSrv: TGUID = '{34FB8111-476E-11D3-B83E-0040F67455FE}';
 IID_IEventIntf: TGUID = '{34FB8112-476E-11D3-B83E-0040F67455FE}';
 DIID_IEventIntfEvents: TGUID = '{34FB8114-476E-11D3-B83E-0040F67455FE}';
 CLASS_EventIntf: TGUID = '{34FB8116-476E-11D3-B83E-0040F67455FE}';
type

// *********************************************************************//
// Forward declaration of interfaces defined in Type Library      //
// *********************************************************************//
 IEventIntf = interface;
 IEventIntfDisp = dispinterface;
 IEventIntfEvents = dispinterface;

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


// *********************************************************************//
// Interface: IEventIntf
// Flags:   (4416) Dual OleAutomation Dispatchable
// GUID:   {34FB8112-476E-11D3-B83E-0040F67455FE}
// *********************************************************************//
 IEventIntf = interface(IDispatch)
  ['{34FB8112-476E-11D3-B83E-0040F67455FE}']
  procedure SendText(const Text: WideString); safecall;
 end;

// *********************************************************************//
// DispIntf: IEventIntfDisp
// Flags:   (4416) Dual OleAutomation Dispatchable
// GUID:   {34FB8112-476E-11D3-B83E-0040F67455FE}
// *********************************************************************//
 IEventIntfDisp = dispinterface
  ['{34FB8112-476E-11D3-B83E-0040F67455FE}']
  procedure SendText(const Text: WideString); dispid 1;
 end;

// *********************************************************************//
// DispIntf: IEventIntfEvents
// Flags:   (0)
// GUID:   {34FB8114-476E-11D3-B83E-0040F67455FE}
// *********************************************************************//
 IEventIntfEvents = dispinterface
  ['{34FB8114-476E-11D3-B83E-0040F67455FE}']
  procedure OnText(const Text: WideString); dispid 3;
 end;

 CoEventIntf = class
  class function Create: IEventIntf;
  class function CreateRemote(const MachineName: string): IEventIntf;
 end;

implementation

uses ComObj;

class function CoEventIntf.Create: IEventIntf;
begin
 Result := CreateComObject(CLASS_EventIntf) as IEventIntf;
end;

class function CoEventIntf.CreateRemote(const MachineName: string): IEventIntf;
begin
 Result := CreateRemoteComObject(MachineName, CLASS_EventIntf) as IEventIntf;
end;

end.

Creating the Client Application with Delphi 3 or Delphi 4

Whereas Delphi takes care of all the dirty work on the server side for us, we need to put a little bit of effort into the client side of the equation.

---

Note - Delphi 5 introduced new support for COM event handling that renders this section obsolete. I'm including this section for the benefit of readers using Delphi versions 3 and 4. If you're using Delphi 5, you can skip ahead to the section titled "Creating the Client Application with Delphi 5."

---

The TEventSink Component

---

Note - This isn't a book about writing Delphi components, but the functionality required for receiving events from a COM server is fairly boilerplate. For that reason, I have written a component named TEventSink. I'm not going to explain the steps of writing a component in this book. If you do not understand component development, you can check out any of the fine books listed in Appendix A, "Suggested Readings and Resources," of this book. Of course, you do not need to understand component development in order to use an existing component in your applications.

---

A short discussion of terminology would be useful here. An event sink implements an interface's events. An event source is responsible for calling the events defined by the interface. For the application we're currently writing, the server is the event source, and the client is the event sink. The server will call the events defined by the interface, and the events will be executed in the context of the client.

The code for the TEventSink component looks lengthy, but most of the methods are simply stubs for functionality that we do not need to implement. The important methods are QueryInterface, Invoke, Connect, and Disconnect.

QueryInterface first checks to see whether the caller is requesting an interface that we implement, which from the declaration of TAbstractEventSink we can see includes IUnknown and IDispatch. If the requested interface is not one of those two interfaces, then the code checks to see if the caller is requesting the events interface (FDispIntfIID). If that's the case, the IDispatch interface is returned.

function TAbstractEventSink.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
 // We need to return the event interface when it's asked for
 Result := E_NOINTERFACE;
 if GetInterface(IID, Obj) then
  Result := S_OK;
 if IsEqualGUID(IID, FDispIntfIID) and GetInterface(IDispatch, Obj) then
  Result := S_OK;
end;

The Invoke method simply passes its parameters to the containing TEventSink component. The owner of the TEventSink component can respond to the event in any desirable fashion.

function TAbstractEventSink.Invoke(DispID: Integer; const IID: TGUID;
 LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
 ArgErr: Pointer): HRESULT;
begin
 (FOwner as TEventSink).DoInvoke(DispID, IID, LocaleID, Flags,
  Params, VarResult, ExcepInfo, ArgErr);

 Result := S_OK;
end;

The Connect and Disconnect methods simply take care of connecting and disconnecting the event sink to and from the server. They perform this magic by calling the predefined Delphi methods InterfaceConnect and InterfaceDisconnect.

The source code for the TEventSink component is shown in Listing 4.9.

Listing 4.9  EventSink Component

unit EventSink;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ActiveX;

type
 TInvokeEvent = procedure(Sender: TObject; DispID: Integer;
  const IID: TGUID; LocaleID: Integer; Flags: Word;
  Params: TDispParams; VarResult, ExcepInfo, ArgErr: Pointer) of object;
 
 TAbstractEventSink = class(TInterfacedObject, IUnknown, IDispatch)
 private
  FDispatch: IDispatch;
  FDispIntfIID: TGUID;
  FConnection: Integer;
  FOwner: TComponent;
 protected
  { IUnknown }
  function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
  function _AddRef: Integer; stdcall;
  function _Release: Integer; 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(AOwner: TComponent);
  destructor Destroy; override;
  procedure Connect(AnAppDispatch: IDispatch; const AnAppDispIntfIID: TGUID);
  procedure Disconnect;
 end;

 TEventSink = class(TComponent)
 private
  { Private declarations }
  FSink: TAbstractEventSink;
  FOnInvoke: TInvokeEvent;
 protected
  { Protected declarations }
  procedure DoInvoke(DispID: Integer; const IID: TGUID;
   LocaleID: Integer; Flags: Word; var Params;
   VarResult, ExcepInfo, ArgErr: Pointer); virtual;
 public
  { Public declarations }
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  procedure Connect(AnAppDispatch: IDispatch; const AnAppDispIntfIID: TGUID);
 published
  { Published declarations }
  property OnInvoke: TInvokeEvent read FOnInvoke write FOnInvoke;
 end;

procedure Register;

implementation

uses
 ComObj;

procedure Register;
begin
 RegisterComponents('DCP', [TEventSink]);
end;

{$IFDEF VER100}
procedure InterfaceConnect(const Source: IUnknown; const IID: TIID;
 const Sink: IUnknown; var Connection: Longint);
var
 CPC: IConnectionPointContainer;
 CP: IConnectionPoint;
begin
 Connection := 0;
 if Succeeded(Source.QueryInterface(IConnectionPointContainer, CPC)) then
  if Succeeded(CPC.FindConnectionPoint(IID, CP)) then
   CP.Advise(Sink, Connection);
end;

procedure InterfaceDisconnect(const Source: IUnknown; const IID: TIID;
 var Connection: Longint);
var
 CPC: IConnectionPointContainer;
 CP: IConnectionPoint;
begin
 if Connection <> 0 then
  if Succeeded(Source.QueryInterface(IConnectionPointContainer, CPC)) then
   if Succeeded(CPC.FindConnectionPoint(IID, CP)) then
    if Succeeded(CP.Unadvise(Connection)) then Connection := 0;
end;
{$ENDIF}

{ TAbstractEventSink }

function TAbstractEventSink._AddRef: Integer;
begin
 Result := -1;
end;

function TAbstractEventSink._Release: Integer;
begin
 Result := -1;
end;

constructor TAbstractEventSink.Create(AOwner: TComponent);
begin
 inherited Create;

 FOwner := AOwner;
end;

destructor TAbstractEventSink.Destroy;
begin
 Disconnect;

 inherited Destroy;
end;

function TAbstractEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
 NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT;
begin
 Result := E_NOTIMPL;
end;

function TAbstractEventSink.GetTypeInfo(Index, LocaleID: Integer;
 out TypeInfo): HRESULT;
begin
 Result := E_NOTIMPL;
end;

function TAbstractEventSink.GetTypeInfoCount(out Count: Integer): HRESULT;
begin
 Count := 0;
 Result := S_OK;
end;

function TAbstractEventSink.Invoke(DispID: Integer; const IID: TGUID;
 LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
 ArgErr: Pointer): HRESULT;
begin
 (FOwner as TEventSink).DoInvoke(DispID, IID, LocaleID, Flags,
  Params, VarResult, ExcepInfo, ArgErr);
 Result := S_OK;
end;

function TAbstractEventSink.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
 // We need to return the event interface when it's asked for
 Result := E_NOINTERFACE;
 if GetInterface(IID,Obj) then
  Result := S_OK;
 if IsEqualGUID(IID, FDispIntfIID) and GetInterface(IDispatch,Obj) then
  Result := S_OK;
end;

procedure TAbstractEventSink.Connect(AnAppDispatch: IDispatch;
 const AnAppDispIntfIID: TGUID);
begin
 FDispIntfIID := AnAppDispIntfIID;
 FDispatch := AnAppDispatch;
 // Hook the sink up to the automation server
 InterfaceConnect(FDispatch, FDispIntfIID, Self, FConnection);
end;

procedure TAbstractEventSink.Disconnect;
begin
 if Assigned(FDispatch) then begin
  // Unhook the sink from the automation server
  InterfaceDisconnect(FDispatch, FDispIntfIID, FConnection);
  FDispatch := nil;
  FConnection := 0;
 end;
end;

{ TEventSink }

procedure TEventSink.Connect(AnAppDispatch: IDispatch;
 const AnAppDispIntfIID: TGUID);
begin
 FSink.Connect(AnAppDispatch, AnAppDispIntfIID);
end;

constructor TEventSink.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);

 FSink := TAbstractEventSink.Create(self);
end;

destructor TEventSink.Destroy;
begin
 FSink.Free;

 inherited Destroy;
end;

procedure TEventSink.DoInvoke(DispID: Integer; const IID: TGUID;
 LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
 ArgErr: Pointer);
begin
 if Assigned(FOnInvoke) then
  FOnInvoke(self, DispID, IID, LocaleID, Flags, TDispParams(Params),
   VarResult, ExcepInfo, ArgErr);
end;

end.

The Client Application

With the TEventSink component behind us, the client program is fairly simple to write, and is shown in Listing 4.10.

Listing 4.10  EventCli—MainForm.pas

unit MainForm;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, EventSrv_TLB, ActiveX, ComObj, EventSink, ExtCtrls;

type
 TForm1 = class(TForm)
  EventSink1: TEventSink;
  Panel1: TPanel;
  Panel2: TPanel;
  btnSend: TButton;
  Memo1: TMemo;
  Edit1: TEdit;
  procedure FormCreate(Sender: TObject);
  procedure btnSendClick(Sender: TObject);
  procedure EventSink1Invoke(Sender: TObject; DispID: Integer;
   const IID: TGUID; LocaleID: Integer; Flags: Word;
   Params: tagDISPPARAMS; VarResult, ExcepInfo, ArgErr: Pointer);
 private
  { Private declarations }
  F: IEventIntf;
 public
  { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
 F := CoEventIntf.Create;
 EventSink1.Connect(F, IEventIntfEvents);
end;

procedure TForm1.btnSendClick(Sender: TObject);
begin
 F.SendText(Edit1.Text);
end;

procedure TForm1.EventSink1Invoke(Sender: TObject; DispID: Integer;
 const IID: TGUID; LocaleID: Integer; Flags: Word; Params: tagDISPPARAMS;
 VarResult, ExcepInfo, ArgErr: Pointer);
var
 vText: OleVariant;
begin
 case DispID of
  1: begin
   vText := OleVariant(Params.rgvarg^[0]);
   Memo1.Lines.Add(vText);
  end;
 end;
end;

end.

The biggest headache with this method is that you have to decipher the parameters for yourself in EventSink1Invoke. The EventSink1Invoke method shown in Listing 4.10 shows how to do that.

procedure TForm1.EventSink1Invoke(Sender: TObject; DispID: Integer;
 const IID: TGUID; LocaleID: Integer; Flags: Word; Params: tagDISPPARAMS;
 VarResult, ExcepInfo, ArgErr: Pointer);
var
 vText: OleVariant;
begin
 case DispID of
  1: begin
   vText := OleVariant(Params.rgvarg^[0]);
   Memo1.Lines.Add(vText);
  end;
 end;
end;

Notice that this code knows the number and types of arguments pertaining to each DispID. Argument numbers start at zero, and dispid 1 (OnText) takes a single argument of type WideString. It is possible to write code that detects the number and types of arguments at runtime, but that is beyond the scope of this book.

Creating the Client Application with Delphi 5

With the introduction of Delphi 5, creating the client application is even easier than creating the server. Create a new application in Delphi, and then select Project, Import Type Library from the Delphi main menu. The Import Type Library dialog box appears, as shown in Figure 4.13.

Figure 4.13
Delphi 5 can automatically generate a component wrapper for the COM server.

Notice that Delphi 5's Import Type Library dialog box features an additional checkbox titled Generate Component Wrapper. Select EventSrv Library (Version 1.0) in the list box, and select DCP in the Palette page combo. If you prefer, you can install the component onto another page, such as ActiveX. Make sure you check the Generate Component Wrapper checkbox, and then click the Install...button.

Delphi will ask you what package to install the component into. You can accept the default and click OK. (Re)build the package when prompted to do so. If all goes well, Delphi will inform you that it has successfully installed the component onto the palette.

Create a new application, and drop a TEventIntf component onto the main form from the DCP page (or wherever you elected to install the component). TEventIntf publishes three properties that are of interest to us.

AutoConnect determines whether the application attempts to connect to the server automatically at startup. If AutoConnect is set to False, you must call EventIntf1.Connect to connect to the server. Set this property to True for this example.

ConnectKind tells the component how to connect to the server. Valid values for the ConnectKind property are shown in Table 4.1.

Table 4.1  Valid Values for ConnectKind

For this example, set this property to ckRunningOrNew.

The RemoteMachineName property only comes into play when connecting to a remote server. We'll explore this property in Chapter 6.

The TEventIntf component also publishes a single event named OnText. This corresponds to the event of the same name that we added to the IEventIntfEvents dispinterface.

The source code for the client application is shown in Listing 4.11.

Listing 4.11  EventCli5—MainForm.pas

unit MainForm;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 OleServer, EventSrv_TLB, StdCtrls, ExtCtrls;

type
 TForm1 = class(TForm)
  EventIntf1: TEventIntf;
  Panel1: TPanel;
  Panel2: TPanel;
  Memo1: TMemo;
  Edit1: TEdit;
  Button1: TButton;
  procedure Button1Click(Sender: TObject);
  procedure EventIntf1Text(Sender: TObject; var Text: OleVariant);
 private
  { Private declarations }
 public
  { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
 EventIntf1.SendText(Edit1.Text);
end;

procedure TForm1.EventIntf1Text(Sender: TObject; var Text: OleVariant);
begin
 Memo1.Lines.Add(Text);
end;

end.

Running the Client Application

Regardless of whether you used Delphi 3, 4, or 5 to create the client application, when you run it, it will look like Figure 4.14.

Figure 4.14
The EventCli/EventCli5 applications allow you to send lines of text to other connected clients.

Connecting Multiple Clients to the Server

There is one small problem with the server code as it stands. Although a single server will be started to service all clients, the server will only fire events to the first connected client. For this application, that is not what we want.

You'll need to make minor modifications to both the server and the client to fix this problem. Fortunately, the changes to both sides are minimal.

---

Note - If you're using Delphi 5, you can skip the changes to the client program. The TEventIntf component created automatically by Delphi 5 already takes care of this for you.

---

First, modify the server's Initialize method to look as follows:

procedure TEventIntf.Initialize;
begin
 inherited Initialize;
 FConnectionPoints := TConnectionPoints.Create(Self);
 if AutoFactory.EventTypeInfo <> nil then
  FConnectionPoints.CreateConnectionPoint(AutoFactory.EventIID,
   ckMulti, EventConnect);
end;

Notice that I changed the next-to-last parameter of the CreateConnectionPoint call from ckSingle to ckMulti. This is all you must do to make the server remember multiple client connections.

Now that the server tracks multiple connections, we need some way to iterate through all active connections to the server. The IConnectionPointContainer interface provides us with an enumerator that can be used to iterate through the connections. The following method can be used to obtain an enumerator on the connection:

function TEventIntf.GetEnumerator: IEnumConnections;
var
 Container: IConnectionPointContainer;
 ConnectionPoint: IConnectionPoint;
begin
 OleCheck(QueryInterface(IConnectionPointContainer, Container));
 OleCheck(Container.FindConnectionPoint(AutoFactory.EventIID, ConnectionPoint));
 ConnectionPoint.EnumConnections(Result);
end;

After you have an enumerator for the connection, you simply need to iterate through the connections, firing the event on each one. The following code shows how to modify the Trigger event to support multiple connections:

procedure TEventIntf.SendText(const Text: WideString);
var
 Enum: IEnumConnections;
 ConnectData: TConnectData;
 Fetched: Cardinal;
begin
 Enum := GetEnumerator;
 if Enum <> nil then begin
  while Enum.Next(1, ConnectData, @Fetched) = S_OK do
   if ConnectData.pUnk <> nil then
    (ConnectData.pUnk as IEventIntfEvents).OnText(Text);
 end;
end;

The final code change you need to make to the server is to register the server in Windows' running object table. To do this, simply add the following line of code to the end of the Initialize function:

RegisterActiveObject(self as IUnknown, CLASS_EventIntf, ACTIVEOBJECT_WEAK, FObjectID);

To remove the server from the running object table, create a Destroy method and add the following line of code to it:

RevokeActiveObject(FObjectID, nil);

Listing 4.12 shows the source code for the modified server.

Listing 4.12  EventMultSrv—EventIntf.pas

unit EventIntf;

interface

uses
 ComObj, ActiveX, AxCtrls, EventSrv_TLB;

type
 TEventIntf = class(TAutoObject, IConnectionPointContainer, IEventIntf)
 private
  { Private declarations }
  FConnectionPoints: TConnectionPoints;
  FEvents: IEventIntfEvents;
  FObjectID: Integer;
 public
  procedure Initialize; override;
  destructor Destroy; override;
 protected
  { Protected declarations }
  property ConnectionPoints: TConnectionPoints read FConnectionPoints
   implements IConnectionPointContainer;
  procedure EventSinkChanged(const EventSink: IUnknown); override;
  procedure SendText(const Text: WideString); safecall;
  function GetEnumerator: IEnumConnections;
 end;

implementation

uses Windows, ComServ;

procedure TEventIntf.EventSinkChanged(const EventSink: IUnknown);
begin
 FEvents := EventSink as IEventIntfEvents;
end;

procedure TEventIntf.Initialize;
begin
 inherited Initialize;

 FConnectionPoints := TConnectionPoints.Create(Self);
 if AutoFactory.EventTypeInfo <> nil then
  FConnectionPoints.CreateConnectionPoint(AutoFactory.EventIID,
   ckMulti, EventConnect);

 RegisterActiveObject(self as IUnknown, CLASS_EventIntf,
  ACTIVEOBJECT_WEAK, FObjectID);
end;

procedure TEventIntf.SendText(const Text: WideString);
var
 Enum: IEnumConnections;
 ConnectData: TConnectData;
 Fetched: Cardinal;
begin
 Enum := GetEnumerator;
 if Enum <> nil then begin
  while Enum.Next(1, ConnectData, @Fetched) = S_OK do
   if ConnectData.pUnk <> nil then
    (ConnectData.pUnk as IEventIntfEvents).OnText(Text);
 end;
end;

function TEventIntf.GetEnumerator: IEnumConnections;
var
 Container: IConnectionPointContainer;
 ConnectionPoint: IConnectionPoint;
begin
 OleCheck(QueryInterface(IConnectionPointContainer, Container));
 OleCheck(Container.FindConnectionPoint(AutoFactory.EventIID, ConnectionPoint));
 ConnectionPoint.EnumConnections(Result);
end;

destructor TEventIntf.Destroy;
begin
 RevokeActiveObject(FObjectID, nil);

 inherited Destroy;
end;

initialization
 TAutoObjectFactory.Create(ComServer, TEventIntf, Class_EventIntf,
  ciMultiInstance, tmApartment);

end.

On the client side, you need to modify the FormCreate method as follows:

procedure TForm1.FormCreate(Sender: TObject);
var
 Obj: IUnknown;
begin
 GetActiveObject(CLASS_EventIntf, nil, Obj);

 if Obj <> nil then
  F := Obj as IEventIntf
 else
  F := CoEventIntf.Create;

 EventSink1.Connect(F, IEventIntfEvents);
end;

GetActiveObject looks for a running instance of the EventMultSrv Automation server. If it finds one, that instance is used. If there is no active instance of the server, CoEventIntf.Create starts a new one running.

Figure 4.15 shows two clients simultaneously accessing the chat server.

Figure 4.15
The server can send events to multiple connected clients.

Callback Interfaces

The next method I will show you requires you to do a considerable amount of work on the server side, but not much work on the client side.

Rather than use dispinterfaces to send events back to the client application, you can create an interface in which you define callback methods. The callback interface is defined in the server, but implemented in the client.

In this section, we'll create a test client and server that illustrate the process of using a custom interface to call back from the server to the client.

Creating the Server

To create the server application, you'll create a new project and add an automation object to it, as you've done before. Select File, New Application from the Delphi main menu. Then select File, New... to display the Object Repository. On the ActiveX page, select Automation Object and click OK. The Automation Object Wizard is displayed.

Fill out the Automation Object Wizard to look like Figure 4.16.

Figure 4.16
The completed Automation Object Wizard.

The Type Library Editor is displayed. The first thing you need to do is create an interface that you'll use to call back into the client. Use the Type Library Editor to add a new interface named IIntfCallbackEvents. Then add a single method to the interface named OnText. OnText is defined in the following code snippet:

procedure OnText(Text: WideString); safecall;

You should be familiar enough with the Type Library Editor by now that you can add this method on your own.

Now add three methods to the IIntfCallback interface, named Connect, Disconnect, and SendText. Their declarations are shown in the following code:

function Connect(const Callback: ITestEvents): Integer;
function Disconnect(UserID: Integer): Boolean;
procedure SendText(Text: WideString);

Those are the only methods we'll define for this example. Click the Refresh Implementation button in the Type Library Editor, and then close the Type Library Editor.

---

Note - It should be apparent that I'm creating the same basic chat server as I did in the last section, although I am using a callback interface instead of COM events.

---

The IIntfCallbackEvents interface will be implemented in the client application, so I will not discuss how to implement OnText at this point. Rather, we'll concentrate on the three IIntfCallback methods Connect, Disconnect, and SendText.

Initializing the Server

When the server is requested by a client, the server's Initialize method is called. TIntfCallback.Initialize is coded as follows:

procedure TIntfCallback.Initialize;
begin
 inherited Initialize;

 // Add one to the global number of connections
 Inc(NumConnections);

 // Update the form to show # of connections
 if NumConnections = 1 then
  Form1.Label2.Caption := '(1 active connection)'
 else
  Form1.Label2.Caption := '(' + IntToStr(NumConnections) + ' active connections)';
end;

First, of course, we call the inherited Initialize procedure. After that, we increment the number of connections to the server. NumConnections is a global variable. It needs to be global because Initialize will be called when a client connects to the server. We want to keep track, in a centralized location, of the number of current connections to the server.

After the number of connections has been updated, the main form is updated to reflect the current number of connections.

Handling Client Connections

The client application will call the server's Connect method to establish a connection between the client and server.

---

Note - There's nothing magical about the name Connect. I could have just as easily named it RegisterClient or something else that made sense.

---

You'll typically want to allow multiple clients to connect to the server, so the Connect method adds the connecting client to an internal list of clients. In order to achieve this, I've created two helper classes named TConn and TConns. Refer to Listing 4.13 for the implementation of these classes.

TConn represents a single client connection. Each client must provide an implementation of the IIntfCallbackEvents interface for the server to use when calling the client. Also, each client is assigned a unique ID that is used to identify the client.

TConns contains a list of TConn objects, and also remembers the unique ID assigned to the most recently connected client. When the next client connects to the server, the unique ID is incremented, and so on.

You might notice that TConns contains three methods named Connect, Disconnect, and SendText. TIntfCallback (which implements the IIntfCallback interface) simply passes control to the TConns method with the same name.

Calling from the Server to the Clients

It's a simple matter to make calls from the server to all connected clients. The TConns list contains a list of all connected clients, along with a reference to their IIntfCallbackEvents interface, so you can simply walk the list of clients, calling a method of the IIntfCallbackEvents interface for each client. The following code shows how this is done:

procedure TConns.SendText(Text: WideString);
var
 Index: Integer;
 C: TConn;
begin
 for Index := 0 to FConns.Count - 1 do begin
  C := TConn(FConns[Index]);
  C.FCallback.OnText(Text);
 end;
end;

This simple procedure calls the OnText method on the IIntfCallbackEvents interface of all connected clients.

The Completed Server Application

I've discussed the most important sections of code in the server application. Listing 4.13 shows the complete source code for IntfUnit.pas.

Listing 4.13  IntfSrv Automation Server—IntfUnit.pas

unit IntfUnit;

interface

uses
 Windows, classes, sysutils, ComObj, ActiveX, IntfSrv_TLB;

type
 // Class to handle a single connection
 TConn = class
 public
  FUserID: Integer;
  FCallback: IIntfCallbackEvents;
  destructor Destroy; override;
 end;

 // Class to handle the list of current connections
 TConns = class
 private
  FConns: TList;
  FLastUserID: Integer;
 public
  constructor Create;
  destructor Destroy; override;
  function Connect(const Callback: IIntfCallbackEvents): Integer;
  function Disconnect(UserID: Integer): Boolean;
  procedure SendText(Text: WideString);
 end;

 // COM Object that the client actually "talks" to
 TIntfCallback = class(TAutoObject, IIntfCallback)
 protected
  function Connect(const Callback: IIntfCallbackEvents): Integer; safecall;
  function Disconnect(UserID: Integer): WordBool; safecall;
  procedure SendText(const Text: WideString); safecall;
 public
  procedure Initialize; override;
  destructor Destroy; override;
  function Connections: TConns;
 end;

// These two variables are global so there will only be a single
// instance in the server app.
const
 NumConnections: Integer = 0;

var
 GlobalConnections: TConns;

implementation

uses ComServ, MainForm;

{ TIntfCallback }

procedure TIntfCallback.SendText(const Text: WideString);
begin
 // Pass the text on to the list of connections
 Connections.SendText(Text);
end;

function TIntfCallback.Connect(const Callback: IIntfCallbackEvents): Integer;
// Tell the list of connections to add a new connection
begin
 Result := Connections.Connect(Callback);
end;

destructor TIntfCallback.Destroy;
begin
 // Decrement the number of connections
 Dec(NumConnections);

 // If there are no connections left, dispose of the connection list
 // This isn't required - you could hang on to the empty list.
 if NumConnections = 0 then begin
  GlobalConnections.Free;
  GlobalConnections := nil;
 end;

 // Update the main form to show # of current connections
 if NumConnections = 1 then
  Form1.Label2.Caption := '(1 active connection)'
 else
  Form1.Label2.Caption := '(' + IntToStr(NumConnections) + ' active connections)';

 inherited Destroy;
end;

// Initialize of a member of TAutoObject. We override it here.
// It functions much like a constructor. Use this function instead
// of a constructor.
procedure TIntfCallback.Initialize;
begin
 inherited Initialize;

 // Add one to the global number of connections
 Inc(NumConnections);

 // Update the form to show # of connections
 if NumConnections = 1 then
  Form1.Label2.Caption := '(1 active connection)'
 else
  Form1.Label2.Caption := '(' + IntToStr(NumConnections) + ' active connections)';
end;

function TIntfCallback.Disconnect(UserID: Integer): WordBool;
begin
 // Handle a disconnect request from the client
 Result := Connections.Disconnect(UserID);
end;

function TIntfCallback.Connections: TConns;
begin
 // Connections function returns a global connection list
 if GlobalConnections = nil then
  GlobalConnections := TConns.Create;

 Result := GlobalConnections;
end;

{ TConn }

destructor TConn.Destroy;
begin
 // Explicitly free the event interface
 FCallback := nil;

 inherited Destroy;
end;

{ TConns }

function TConns.Connect(const Callback: IIntfCallbackEvents): Integer;
var
 C: TConn;
begin
 // Assign each connection a unique user ID
 Inc(FLastUserID);

 // Create a new connection
 C := TConn.Create;

 // Remember the event interface
 C.FCallback := Callback;

 // Set the user ID
 C.FUserID := FLastUserID;

 // Add the user to the list
 FConns.Add(C);

 // Return the assigned user ID
 Result := FLastUserID;
end;

constructor TConns.Create;
begin
 FLastUserID := 0;
 FConns := TList.Create;
end;

destructor TConns.Destroy;
var
 Index: Integer;
 C: TConn;
begin
 for Index := 0 to FConns.Count - 1 do begin
  C := TConn(FConns[Index]);
  C.Free;
 end;
 FConns.Free;
end;

function TConns.Disconnect(UserID: Integer): Boolean;
var
 Index: Integer;
 C: TConn;
begin
 Result := False;

 for Index := 0 to FConns.Count - 1 do begin
  C := TConn(FConns[Index]);
  if C.FUserID = UserID then begin
   C.Free;
   FConns.Delete(Index);
   Result := True;
   exit;
  end;
 end;
end;

procedure TConns.SendText(Text: WideString);
var
 Index: Integer;
 C: TConn;
begin
 for Index := 0 to FConns.Count - 1 do begin
  C := TConn(FConns[Index]);
  C.FCallback.OnText(Text);
 end;
end;

initialization
 // Change this to ciSingleInstance, and each copy of the client
 // will start its own copy of the server.
 TAutoObjectFactory.Create(ComServer, TIntfCallback, Class_IntfCallback,
  ciMultiInstance, tmApartment);
end.

Listing 4.14 shows the source code for the server's main form. Figure 4.17 shows the server at runtime.

Figure 4.17
The IntfSrv application at runtime.

Listing 4.14  IntfSrv Automation Server—MainForm.pas

unit MainForm;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, IntfUnit;

type
 TForm1 = class(TForm)
  Label1: TLabel;
  Label2: TLabel;
 private
  { Private declarations }
 public
  { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

end.

Listing 4.15 shows the Delphi-generated type library for the server.

Listing 4.15  IntfSrv Automation Server—IntfSrv_TLB.pas

unit IntfSrv_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 : $Revision:  1.11.1.75 $
// File generated on 7/31/99 2:59:14 PM from Type Library described below.

// ************************************************************************ //
// Type Lib: J:\Book\samples\Chap04\IntfSrv\IntfSrv.tlb
// IID\LCID: {E9D7678E-F7E3-11D2-909B-0040F6741DE2}\0
// Helpfile: 
// HelpString: IntfSrv Library
// Version:  1.0
// ************************************************************************ //

interface

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

// *********************************************************************//
// 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
 LIBID_IntfSrv: TGUID = '{E9D7678E-F7E3-11D2-909B-0040F6741DE2}';
 IID_IIntfCallback: TGUID = '{E9D7678F-F7E3-11D2-909B-0040F6741DE2}';
 CLASS_IntfCallback: TGUID = '{E9D76791-F7E3-11D2-909B-0040F6741DE2}';
 IID_IIntfCallbackEvents: TGUID = '{E9D76793-F7E3-11D2-909B-0040F6741DE2}';
type

// *********************************************************************//
// Forward declaration of interfaces defined in Type Library      //
// *********************************************************************//
 IIntfCallback = interface;
 IIntfCallbackDisp = dispinterface;
 IIntfCallbackEvents = interface;
 IIntfCallbackEventsDisp = dispinterface;

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


// *********************************************************************//
// Interface: IIntfCallback
// Flags:   (4416) Dual OleAutomation Dispatchable
// GUID:   {E9D7678F-F7E3-11D2-909B-0040F6741DE2}
// *********************************************************************//
 IIntfCallback = interface(IDispatch)
  ['{E9D7678F-F7E3-11D2-909B-0040F6741DE2}']
  procedure SendText(const Text: WideString); safecall;
  function Connect(const Callback: IIntfCallbackEvents): Integer; safecall;
  function Disconnect(UserID: Integer): WordBool; safecall;
 end;

// *********************************************************************//
// DispIntf: IIntfCallbackDisp
// Flags:   (4416) Dual OleAutomation Dispatchable
// GUID:   {E9D7678F-F7E3-11D2-909B-0040F6741DE2}
// *********************************************************************//
 IIntfCallbackDisp = dispinterface
  ['{E9D7678F-F7E3-11D2-909B-0040F6741DE2}']
  procedure SendText(const Text: WideString); dispid 1;
  function Connect(const Callback: IIntfCallbackEvents): Integer; dispid 2;
  function Disconnect(UserID: Integer): WordBool; dispid 3;
 end;

// *********************************************************************//
// Interface: IIntfCallbackEvents
// Flags:   (4416) Dual OleAutomation Dispatchable
// GUID:   {E9D76793-F7E3-11D2-909B-0040F6741DE2}
// *********************************************************************//
 IIntfCallbackEvents = interface(IDispatch)
  ['{E9D76793-F7E3-11D2-909B-0040F6741DE2}']
  procedure OnText(const Text: WideString); safecall;
 end;

// *********************************************************************//
// DispIntf: IIntfCallbackEventsDisp
// Flags:   (4416) Dual OleAutomation Dispatchable
// GUID:   {E9D76793-F7E3-11D2-909B-0040F6741DE2}
// *********************************************************************//
 IIntfCallbackEventsDisp = dispinterface
  ['{E9D76793-F7E3-11D2-909B-0040F6741DE2}']
  procedure OnText(const Text: WideString); dispid 1;
 end;

 CoIntfCallback = class
  class function Create: IIntfCallback;
  class function CreateRemote(const MachineName: string): IIntfCallback;
 end;

implementation

uses ComObj;

class function CoIntfCallback.Create: IIntfCallback;
begin
 Result := CreateComObject(CLASS_IntfCallback) as IIntfCallback;
end;

class function CoIntfCallback.CreateRemote(const MachineName: string): IIntfCallback;
begin
 Result := CreateRemoteComObject(MachineName, CLASS_IntfCallback) as IIntfCallback;
end;

end.

Creating the Client

After the server is complete, it's a straightforward task to create the client application that will connect to the server.

Start a new application in Delphi. Either add the server's copy of IntfSrv_TLB.pas to the uses clause of this application, or import the server's type library into Delphi using the technique described earlier in this chapter.

Implementing the Callback Interface

The client application is where we'll implement the ITestEvents interface that we defined in the server's type library. Because there is only one method on the interface, the declaration is simple.

type
 TEventHandler = class(TAutoIntfObject, IIntfCallbackEvents)
  procedure OnText(const Text: WideString); safecall;
 end;

There is one point of interest about this declaration. TEventHandler derives from TAutoIntfObject. TAutoIntfObject is a lightweight automation-compatible class that you can use when you want to implement an interface that should not be advertised in Windows. In other words, IIntfCallbackEvents is a private interface that only this particular server and client know about. You don't want another application to be able to create an instance of IIntfCallbackEvents, because it makes no sense outside of this context.

---

Note - You might remember that TInterfacedObject is also a lightweight COM class. TAutoIntfObject differs from TInterfacedObject in that TAutoIntfObject requires a type library, supports late binding via IDispatch, and can be called from out-of-process COM clients. TInterface supports none of this functionality, and is intended for use strictly within a single application.

---

IIntfCallbackEvents only contains one method, OnText, and I've provided a very simple implementation that displays the passed-in string on the main form.

Constructing the Callback Object

When the client application starts, it creates the TEventHandler object. This process, although straightforward, is unlike anything you've seen so far. In order to create the class, the code calls LoadRegTypeLib, passing in the GUID and version number of the type library. LoadRegTypeLib returns a reference to the ITypeLib interface. TEventHandler.Create uses this reference to construct an instance of TEventHandler.

procedure TForm1.FormCreate(Sender: TObject);
var
 TypeLib : ITypeLib;
begin
 OleCheck(LoadRegTypeLib(LIBID_IntfSrv, 1, 0, 0, TypeLib));

 FCallback := TEventHandler.Create(TypeLib, IIntfCallbackEvents);
end;

Connecting to the Server

The rest of the code is similar to code you've seen previously. When the user presses the Connect button, the code calls CoTest.Create to create an instance of the server. Then, it calls Connect on the server, passing in a reference to the IIntfCallbackEvents interface implemented by TEventHandler. Actually, it passes in the TEventHandler itself, Delphi automatically converts it to an IIntfCallbackEvents interface.

When the user clicks the Trigger button, the code simply calls the server's Trigger method, which in turn calls the DoIt method for all connected clients.

Listing 4.16 shows the source code for the client application.

Listing 4.16  IntfCli—MainForm.pas

unit MainForm;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, ComObj, ActiveX, IntfSrv_TLB, StdCtrls, ExtCtrls;

type
 TEventHandler = class(TAutoIntfObject, IIntfCallbackEvents)
  procedure OnText(const Text: WideString); safecall;
 end;

 TForm1 = class(TForm)
  Panel1: TPanel;
  Panel2: TPanel;
  btnSend: TButton;
  Memo1: TMemo;
  btnConnect: TButton;
  btnDisconnect: TButton;
  Edit1: TEdit;
  procedure FormCreate(Sender: TObject);
  procedure FormDestroy(Sender: TObject);
  procedure btnConnectClick(Sender: TObject);
  procedure btnDisconnectClick(Sender: TObject);
  procedure btnSendClick(Sender: TObject);
 private
  { Private declarations }
  FCallback: TEventHandler;
  FServer: IIntfCallback;
  FID: Integer;
 public
  { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

{ TEventHandler }

procedure TEventHandler.OnText(const Text: WideString);
begin
 Form1.Memo1.Lines.Add(Text);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 TypeLib : ITypeLib;
begin
 // Have to LoadRegTypeLib to get at the event interface
 OleCheck(LoadRegTypeLib(LIBID_IntfSrv, 1, 0, 0, TypeLib));

 FCallback := TEventHandler.Create(TypeLib, IIntfCallbackEvents);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 // Don't free FCallback here - the server will kill it for us
end;
procedure TForm1.btnConnectClick(Sender: TObject);
begin
 // Connect to the server
 FServer := CoIntfCallback.Create;
 FID := FServer.Connect(FCallback);

 btnConnect.Enabled := False;
 btnDisconnect.Enabled := True;
 btnSend.Enabled := True;
 Edit1.Enabled := True;
end;

procedure TForm1.btnDisconnectClick(Sender: TObject);
begin
 FServer.Disconnect(FID);
 FServer :=NIL;
 btnConnect.Enabled := True;
 btnDisconnect.Enabled := False;
 btnSend.Enabled := False;
 Edit1.Enabled := False;
end;

procedure TForm1.btnSendClick(Sender: TObject);
begin
 FServer.SendText(Edit1.Text);
end;

end.

As you've seen, you can handle server callbacks through either dispinterfaces or interfaces. Both methods have their advantages and disadvantages. Dispinterfaces are required if you want your code to work with Visual Basic, for example. Also, Delphi provides better support for dispinterfaces through the Automation Object Wizard. However, you still need to write some code if you want multiple clients to connect to a single instance of the server.

Interfaces provide some benefits in terms of speed, and they also shield you from the hassles of having to implement IDispatch's Invoke method and manually decipher the parameters that are passed into your event handler.

My goal here was simply to familiarize you with the different mechanisms you can use to handle COM callbacks and let you decide which one best serves your needs. That said, I would say that, especially if you're using Delphi 5, unless you have an overwhelming reason to use a callback interface, you should stick with dispinterfaces and COM events.

In Chapter 6, I'll show you a real-world situation in which implementing COM events can be extremely beneficial. In the following section, I'll discuss a common automation server (Microsoft ADO), and show you how to write a COM client in Delphi that accesses it.