More Automation In Delphi
If you find this article useful then please consider making a donation. It will be appreciated however big or small it might be and will encourage Brian to continue researching and writing about interesting subjects in the future.
This paper assumes a basic knowledge of Automation techniques, including how to connect an application to an Automation server in order to control it, and also how to build a basic Automation server. For more information on these topics, see Reference 1.
What this talk focuses on are the next levels in Automation, topics that are a little more involved. This includes Automation events, instancing options, the Running Object Table, Automation object hierarchies and collections.
Whilst all the information presented is valid for Delphi 4 and most of it for Delphi 3, the version assumed to be used is Delphi 5. In places, menu item captions or code generated by Delphi will differ slightly between versions.
Click here to download the files associated with this paper.
When creating an Automation object using the Delphi wizard, one of the available choices allows you to specify the object's instancing option. This option only affects the behaviour of an out-of-process Automation server when a client (or clients) creates multiple objects from the server. It is ignored for in-process servers.
There are three available instancing options available in Delphi 5 as shown in Figure 1.
Figure 1: Automation instancing options
In many cases, it will be fine for multiple Automation objects to live in the same executable, and so the default option of multiple instancing is usually fine.
The Automation object behind Microsoft Word has demonstrated both single instancing and multiple instancing over its history. Word 6 used the single instancing approach, such that only one instance of Word executed at any time. Word 97 changed that and moved across to multiple instancing. This can be observed by creating several instances of the Word 97 Automation object and observing that they all exists in separate instances of Word.
Notice this option applies to when clients create multiple instances of the Automation object. It is technically possible for a client to create an Automation object from a server, and then for additional client applications to try and connect to the very same object. However, this relies on the object doing something that it does not do by default, which is to register itself in the Running Object Table, or ROT.
In order to make a single Automation object instance accessible to multiple client applications, you can make it register itself as the running object (of that type) in the Running Object Table. With this done, client applications can try and connect to the running object of a given type, if one exists, or else create a new instance.
The plan is that when the first instance of the class is created, it should use the appropriate API to add a reference to itself into the ROT. Then, subsequent client applications can either access the registered object instance (using GetActiveOleObject) or create new additional instances (using CreateOleObject).
When the registered object instance is finally destroyed after all clients have disconnected, it should unregister itself from the ROT. To register an object in the ROT, and later unregister it, you use the RegisterActiveObject and RevokeActiveObject, declared in the ActiveX unit (or the OLE2 unit in Delphi 2).
To get help on these APIs, you need to load up OLE.HLP from wherever the Microsoft SDK help files were installed (or look it up on your MSDN Library CD if you subscribe to that program). Delphi 5 allows you to get directly to the Microsoft SDK help files from the Help menu.
The help for this routine has quite a lot to say: you should have a good read through it. The Delphi declaration of this routine, which looks a little off-putting when expressed in C in the help file, is:
function RegisterActiveObject(unk: IUnknown; const clsid: TCLSID; dwFlags: Longint; out dwRegister: Longint): HResult; stdcall;
Registering An Automation Object In The ROT
To register the Automation object in the running object table you pass a number of parameters to RegisterActiveObject. To identify which object instance, you pass a reference to your object's IUnknown interface which it will definitely have (all COM objects implement this interface). You also pass the objects ClassID, which is a GUID defined as a constant in your type library import unit, and is added into the registry as another way to reference your object in addition to the ProgID. The third parameter indicates the type of registration required, where you can choose weak or strong.
Strong registration (as indicated by passing 0, or ActiveObject_Strong) means the API calls _AddRef on your object and so the object's reference count increments. When all the Automation clients of this object have dropped their connections, the object will not disappear due to the reference count not reaching zero. To remove the object from the ROT, you must call RevokeActiveObject at some point.
Weak registration (requested with 1 or ActiveObject_Weak) does not increment the reference count, but still keeps a reference to the object in the ROT. When the last Automation client drops the reference to a weakly registered object, it will no longer be available.
The last parameter to RegisterActiveObject is a cookie variable that must be passed to RevokeActiveObject (if called at all) to identify which entry to remove from the ROT.
There is a lot of information on the RegisterActiveObject help page, but if you are writing an Automation server with no UI, much of it will be fairly irrelevant. All we really need to do is perform a weak registration of the object's IUnknown interface in the ROT when it is created.
This should be done in the overridden Initialize method, not the Create method as we would do in normal objects. COM objects have a variety of constructors that may get called, but each one ensures that the Initialize routine is called as a standard point of initialisation.
In the object's destructor we should revoke the object from the ROT, just to be on the safe side. The ROT cookie must be held in private instance data throughout the life of the Automation object. A basic Automation object adhering to these rules is shown in Listing 1.
Listing 1: Registering an Automation object in the ROT
type
TAutoServer = class(TAutoObject, IAutoServer)
private
FROTCookie: Longint;
public
procedure Initialize; override;
destructor Destroy; override;
end;
...
procedure TAutoServer.Initialize;
begin
inherited;
//Register object in ROT
OleCheck(RegisterActiveObject(Self, Class_AutoServer, ActiveObject_Weak, FROTCookie))
end;
destructor TAutoServer.Destroy;
begin
//Remove object from ROT
OleCheck(RevokeActiveObject(FROTCookie, nil));
inherited;
end;
Note that the object's ClassID is represented by a constant in the type library import unit. If the coclass name of the Automation object is XXXX, the ClassID constant is called Class_XXXX.
Connecting An Automation Client To A Running Object
The next job is to see how the Automation client application takes advantage of this ROT registration. Listing 2 shows the code normally used to connect to an Automation object in Delphi. In this case it uses a Variant, but the commented code shows how it would work with an interface reference variable. Listing 3 shows how to adapt this to try and connect to a running object, or failing that creating a new Automation object instance.
Note that if GetActiveOleObject fails to find a running object it will raise an exception indicating this fact. If the IDE is still set to the default option of intercepting exceptions, it will notify you of the error as it occurs. If this happens, ignore the error and continue running the program (press Run).
Listing 2: An Automation client creating an Automation object instance
uses
ComObj;
...
var
Server: Variant;
//Server: IAutoServer;
...
Server := CreateOleObject('Project1.AutoServer');
//Server := CreateOleObject('Project1.AutoServer') as IAutoServer;
Listing 3: An Automation client trying to connect to an existing instance
uses
ComObj;
...
var
Server: Variant;
//Server: IAutoServer;
...
try
Server := GetActiveOleObject('Project1.AutoServer');
//Server := GetActiveOleObject('Project1.AutoServer') as IAutoServer;
except
Server := CreateOleObject('Project1.AutoServer');
//Server := CreateOleObject('Project1.AutoServer') as IAutoServer;
end
When writing Automation servers it is common to focus on the functionality implemented in the server. However sometimes, an Automation server caters for a certain amount of useful functionality being implemented by the client application. This is done using event interfaces.
The standard situation is that the Automation server has a stock of behaviour that can be called upon. This behaviour is accessed by normal COM interfaces (potentially accessed through a Variant) implemented in the server. Sometimes the server may wish to signal progress through a lengthy operation, or indicate some service has become available or unavailable. This is handled with events.
The server fires an event that one or more client applications may be interested in picking up. When the event is triggered, behaviour in the client application executes in response. The available events for a given server are defined in one or more (although typically just one) events interface. This interface declares methods corresponding to all the different events that might happen. Each event method declaration may have a variety of parameters (rather like the type definition of an event property in a Delphi VCL component).
Unlike most interfaces, this events interface is implemented by the client application. So, in an Automation scenario where events are handled by a client application, there will be at least one interface implemented by the client, and one or more interfaces implemented by the server.
Before getting into the details of how this all works, let's work through some terminology. A client application that implements an events interface is called an event sink (the events are fired off and disappear into interested clients, somewhat like water disappearing into a sink).
Most interfaces are implemented by the Automation server. Calls to interface methods therefore typically come from client applications and go to the server. Normal interfaces are called incoming interfaces to reflect this. An events interface goes the other way, from server to client, and is called an outgoing interface.
Another term used for an events interface is a connection point, as it acts as a mechanism for a client to connect to interesting behaviour in the server. As mentioned earlier, it is possible for an Automation object to support multiple events interfaces, and so it would have multiple connection points. This, however, is less common than having a single connection point.
An Automation object that can handle outgoing interfaces and all that goes with them is called a connectable object.
COM allows an Automation server to manage its connection points with four interfaces (which are implemented by helper objects in the VCL): IConnectionPoint, IConnectionPointContainer, IEnumConnectionPoints and IEnumConnections.
In order for an Automation event to be picked up by more than one client application requires the Automation object be accessible by more than one application. This typically means that the Automation object must register itself in the ROT, as explained above.
Since Delphi-generated Automation objects do not, by default, deal with the ROT in any way, Delphi's event-handling code does not cater for the possibility of more than one client wishing to react to events. It is not too traumatic to change it, but it is worth noting that it is designed with single clients in mind.
Incidentally, this event handling can be done entirely by writing the appropriate code by hand, but Delphi 4 makes it rather easier by generating VCL code in the Automation object that manages the client application connection. Delphi 5 added support to make the job of writing the client events interface implementation completely automatic.
Looking Closer At An Events Interface
We will be looking at real code very soon now, but some more information is worthwhile at this point. An events interface may define a number of methods corresponding to potential events, much like a given component can define a number of events. A client application may only be interested in reacting to a small number of these events, just as you may choose to ignore a number of available events that a component offers.
Here we come to a difference between normal interfaces and events interfaces. With a normal interface, an object that implements it must provide an implementation for each and every method in the interface. Interfaces (defined with the reserved word interface) are represented at run-time by vtables, which are lists of addresses of the corresponding method. Objects must implement every method so the compiler can set the interface vtable up properly, with each entry pointing at the corresponding method implementation.
In the case of events interfaces, there needs to be more flexibility. The client must not be forced into implementing every method in the interface. Instead the client must be given the freedom and choice to implement as few of the methods as it likes, and ignore the rest.
Because of this, events interfaces are not defined using the interface word. Instead, they are defined using dispinterface. A dispinterface is a description of a number of methods that are understood by a given IDispatch implementation.
When you create an Automation object in Delphi, it generates both an interface and a dispinterface for the normal incoming interfaces. This allows client applications the choice of whether to use early-bound vtable access to the interface, or late-bound IDispatch access to it (so called dual interfaces). Early bound access is more efficient, but is has the strict criteria of implementing all methods to satisfy the compiler.
To allow the flexibility required by events interfaces, they are defined with dispinterface and implemented by a client object that only purports to support IDispatch in its definition (not the events interface). This way, the appropriate IDispatch method that performs late-bound execution (Invoke) can choose whether to respond to any given entry in the interface or not bother.
It's the implementation of IDispatch.Invoke that responds to the events interface method calls. It has the choice of executing code in response, or ignoring the event method call altogether.
At last we get to the business of writing code so we can see an events interface at work. This will be a two stage development. Firstly we will need to see how the server is built, defining the events interface (this is quite straightforward thanks to an option on the Automation object wizard in Delphi 4 and later). Having created the server, we then need to focus on how the client application acts as an event sink. The client will be built both by hand, and using automatically generated code/components
An Automation Server With Events
In a new project (saved as Clock.dpr), choose an Automation object from the ActiveX page of the File | New... dialog. This invokes the same dialog we saw in Figure 1, but this time we need to ensure the Generate Event support code checkbox is checked (Figure 2). Leave the Threading Model option set to Apartment, as a sensible default. For more information on threading models and apartment types, see Reference 2.
Figure 2: Requesting extra code to handle new events interface
When OK is pressed, the wizard gets to work. It creates a new type library (Clock.tlb), displayed in the type library editor, containing the definition of the coclass (Application) and some interfaces. This includes the normal incoming interface, called IApplication, and the outgoing events interface, IApplicationEvents. You can see the type library editor at any time by choosing View | Type Library.
With the project called Clock.dpr and the coclass called Application, standard Automation code (using Variants for late-bound Automation) could connect to the object (if registered) using the ProgID Clock.Application.
Figure 3 shows the events interface. Notice the different icon used to represent it in the left-hand tree view. This corresponds to the type library editor's Dispatch button (as opposed to the Interface button, used for vtable interfaces).
Figure 3: The events interface in the type library
Another unit is also created in the project which contains Pascal representations of the entities defined in the type library. This type library import unit is called Clock_TLB.pas. You can see the unit either by choosing it from the list of source files in the project (Ctrl+F12, or View | Units) or by pressing F12 on the type library editor. At this stage we do not need to worry about the content of this file.
The wizard also creates another new (unnamed) unit containing the implementation of the Automation object. This unit should be saved as ClockImpl.pas. This unit has more code than usual in order to help support events. Listing 4 shows what the wizard would generate without the event support code. This can be viewed in contrast to Listing 5, which shows the full code with event support.
Listing 4: A new Automation object without events
type
TApplication = class(TAutoObject, IApplication)
protected
{ Protected declarations }
end;
...
initialization
TAutoObjectFactory.Create(ComServer, TApplication, Class_Application,
ciMultiInstance, tmApartment);
end.
Listing 5: A new Automation object with events
type
TApplication = class(TAutoObject, IConnectionPointContainer, IApplication)
private
{ Private declarations }
FConnectionPoints: TConnectionPoints;
FConnectionPoint: TConnectionPoint; //missing in Delphi 4 code
FSinkList: TList; //missing in Delphi 4 code
FEvents: IApplicationEvents;
public
procedure Initialize; override;
protected
{ Protected declarations }
property ConnectionPoints: TConnectionPoints read FConnectionPoints
implements IConnectionPointContainer;
procedure EventSinkChanged(const EventSink: IUnknown); override;
end;
...
procedure TApplication.EventSinkChanged(const EventSink: IUnknown);
begin
FEvents := EventSink as IApplicationEvents;
if FConnectionPoint <> nil then //missing in Delphi 4 code
FSinkList := FConnectionPoint.SinkList; //missing in Delphi 4 code
end;
procedure TApplication.Initialize;
begin
inherited Initialize;
FConnectionPoints := TConnectionPoints.Create(Self);
//Result of CreateConnectionPoint not assigned in Delphi 4 code
if AutoFactory.EventTypeInfo <> nil then
FConnectionPoint := FConnectionPoints.CreateConnectionPoint(
AutoFactory.EventIID, ckSingle, EventConnect)
else FConnectionPoint := nil;
end;
initialization
TAutoObjectFactory.Create(ComServer, TApplication, Class_Application,
ciMultiInstance, tmApartment);
end.
We should look at the extra code in Listing 5 and see what it is all for. The first difference is that the class definition claims to implement the IConnectionPointContainer interface. This is achieved through interface implementation delegation. The protected property ConnectionPoints is only defined to tell the compiler that the FConnectionPoints private data field is a TConnectionPoints object that implements IConnectionPointContainer on behalf of the object. This object is created in the Initialize method and is used to manage all connection points in the server. Typically, you will only have one connection point.
Initialize
does more than create a TConnectionPoints object. It also creates a TConnectionPoint object via a call to the CreateConnectionPoint method of the TConnectionPoints object. This new TConnectionPoint object represents the primary events interface and is stored in the FConnectionPoint private data field.Notice one of the parameters passed to CreateConnectionPoint is ckSingle. This value tells the connection point that it will only ever have a single client application connected to it. If we register our object in the ROT, then we may have a need to service more than one client. We will come back to this code later and change it to cater for this possibility.
When a client application states that it will be acting as an event sink for the events interface, the EventSinkChanged method will execute in the server. This sets the private FEvents data field to refer to the client's implementation of the events interface, and sets the FSinkList data field to refer to a TList that will be populated with event sinks (references to the events interface in all the clients).
Since the assumption has been made that this is (currently) a single client system, FEvents points to that client whilst it is connected. As soon as we add support for multiple clients, FEvents will be useless, as it will always refer to the last client that connected. FSinkList will be more useful as it holds references to all clients.
You can see from the comments that the Delphi 4 wizard generated less code that the Delphi 5 wizard. It is easy to add the missing sections to a Delphi 4 Automation object if you know what is missing. A simple comparison with Listing 5 will help out here.
Now that we have some explanation of all the extra code, let's try and create some methods in the IApplication interface and some events (more methods) in the IApplicationEvents interface.
The purpose of this Automation server is to act as a simple alarm clock. The client applications can connect to the alarm clock, find the current data and time, and also set an alarm call. The Automation object will ultimately be registered in the ROT to allow multiple clients to connect to the same alarm clock object. When the alarm is set, one event will be triggered that all connected clients can react to. When the alarm time arrives, another event will be similarly triggered.
To add methods to either interface, you can select the interface in the tree view, then either right-click and choose the item you want from the New submenu or press the tool buttons to add members. Alternatively, you can select the interface and choose the Text page on the right of the type library editor. Here you can just type in all the method declarations you need. This is done easiest if the type library editor is displaying Pascal syntax as opposed to IDL syntax. You can check this on the Type Library page of the environment options dialog.
Let's start with the incoming interface. In the Text page, it currently looks like Listing 6, although the GUID (marked as a UUID) will be different.
Listing 6: The empty IApplication interface
IApplication = interface(IDispatch)
[ uuid '{5C901961-5BDB-11D4-96EC-0060978E1359}',
version 1.0,
helpstring 'Dispatch interface for Application Object',
dual,
oleautomation ]
end;
Listing 7 shows how it looks when finished. It has read-only CurrentDateTime and AlarmSet properties. It also has an Alarm property that can be read to find the current alarm time, or written to in order to set a new alarm time.
Listing 7: The finished IApplication
IApplication = interface(IDispatch)
[ uuid '{5C901961-5BDB-11D4-96EC-0060978E1359}',
version 1.0,
helpstring 'Dispatch interface for Application Object',
dual,
oleautomation ]
function CurrentDateTime: TDateTime [propget, dispid 1]; safecall;
function Alarm: TDateTime [propget, dispid 2]; safecall;
procedure Alarm(Value: TDateTime) [propput, dispid 2]; safecall;
function AlarmSet: WordBool [propget, dispid 3]; safecall;
end;
When you press the type library editor's Refresh button, the implementation unit, ClockImpl.pas, will be updated accordingly with stub methods for all these property readers and writers. These need to be filled in to implement the basic functionality of the alarm clock. Since the alarm clock will be managed by a timer component, this will also involve adding a custom destructor to ensure the timer is freed and a method that can be used as the timer's OnTimer event handler (see Listing 8).
Listing 8: The alarm clock implementation
uses
...
ExtCtrls, SysUtils, Windows;
type
TApplication = class(TAutoObject, IConnectionPointContainer, IApplication)
private
...
//New stuff
FAlarmTime: TDateTime;
FTimer: TTimer;
procedure TimerTick(Sender: TObject);
public
...
destructor Destroy; override;
protected
...
function Get_Alarm: TDateTime; safecall;
function Get_AlarmSet: WordBool; safecall;
function Get_CurrentDateTime: TDateTime; safecall;
procedure Set_Alarm(Value: TDateTime); safecall;
end;
...
destructor TApplication.Destroy;
begin
FTimer.Free;
inherited;
end;
function TApplication.Get_AlarmSet: WordBool;
begin
//Alarm is set if the timer has been created and is enabled
Result := Assigned(FTimer) and FTimer.Enabled
end;
function TApplication.Get_CurrentDateTime: TDateTime;
begin
Result := Now
end;
function TApplication.Get_Alarm: TDateTime;
begin
if Get_AlarmSet then
Result := FAlarmTime
else
raise EOleSysError.Create(
'Alarm is not set', //error message
MakeResult(SEVERITY_ERROR, FACILITY_ITF, 1), //custom interface error
0) //help context
end;
procedure TApplication.Set_Alarm(Value: TDateTime);
begin
if not Assigned(FTimer) then
begin
FTimer := TTimer.Create(nil);
FTimer.Interval := 100;
FTimer.Enabled := False;
FTimer.OnTimer := TimerTick
end;
FAlarmTime := Value;
FTimer.Enabled := True;
//Trigger alarm set event
end;
procedure TApplication.TimerTick(Sender: TObject);
begin
if Now >= FAlarmTime then
begin
FTimer.Enabled := False;
//Trigger alarm ring event
end
end;
As you can see, the code is quite simple so far, although it is missing the logic to trigger the events. Additionally, the event methods have yet to be defined.
Overcoming A Possible Name Clash
Before adding events to the server, we should be aware of a possible name clash. Figure 2 shows how the Automation object wizard is set up to create the Automation object. Notice the name of the coclass was chosen as Application. This name was used to create the interface names, IApplication and IApplicationEvents, and also the implementation class name, TApplication.
In the type library import unit (Clock_TLB.pas), a type definition exists to map the name of the represented coclass to the name of its primary interface:
type Application = IApplication;
However, VCL applications already have a symbol called Application, defined in the Forms unit. This poses a problem for the project source file which refers to the VCL Application object, but also has the type library import unit in its uses clause (after the Forms unit). To remedy the problem, either ensure that the Forms unit is after the type library import unit in the uses clause, or make the references to the Application object fully qualified as shown in Listing 9.
Listing 9: A working project source file
program Clock;
uses
Forms,
ClockMainForm in 'ClockMainForm.pas' {Form1},
Clock_TLB in 'Clock_TLB.pas',
ClockImpl in 'ClockImpl.pas' {Application: CoClass};
{$R *.TLB}
{$R *.RES}
begin
Forms.Application.Initialize;
Forms.Application.Title := 'Clock Server';
Forms.Application.CreateForm(TForm1, Form1);
Forms.Application.Run;
end.
Now we can add event methods to the outgoing interface. In this case, we will just add two methods, one that will be called when the alarm is set (AlarmSet) and one called when the alarm time arrives (AlarmRing). Both methods take a couple of parameters. The first parameter is a reference to the IApplication interface of the alarm clock whose event is being triggered. The second parameter will be the date/time that the alarm was set for.
The Text page of the IApplicationEvents interface in the type library editor can be made to look like Listing 10 to get the method added.
Listing 10: Textual view of the events interface
IApplicationEvents = dispinterface
[ uuid '{5C901963-5BDB-11D4-96EC-0060978E1359}',
version 1.0,
helpstring 'Events interface for Application Object' ]
procedure AlarmRing(Clock: IApplication; AlarmDateTime: TDateTime) [dispid 1]; safecall;
procedure AlarmSet(Clock: IApplication; AlarmDateTime: TDateTime) [dispid 2]; safecall;
end;
Note that if you try to add the method using the tool buttons or the tree view context menu, the textual view will not look quite the same. This is because Delphi only applies the safecall calling convention to either dual interface methods (normal Automation methods) or any vtable interface (either COM or Automation methods).
A dispinterface does not fall into either of these categories and so uses stdcall calling convention by default. Editing the definition in the Text page allows you to avoid being faced with HResult return values whilst entering the details, although when the type library is saved and reopened, it will probably go back to the stdcall version. For more information on the implications on the safecall calling convention, see Reference 3.
The current state of play in the type library editor is shown in Figure 4.
Figure 4: The finished interfaces
Calling Events In (Potentially) Multiple Clients
Now that the IApplicationEvents interface has some members we can go back to the Automation server code and finish off the job of triggering the event. This involves looping through the list of event sinks (FSinkList) and calling the method for all event sinks that are still connected. When an event sink disconnects, its value in FSinkList becomes nil. Listing 11 shows the results.
Listing 11: Triggering an event method
procedure TApplication.Set_Alarm(Value: TDateTime);
var
I: Integer;
begin
if not Assigned(FTimer) then
begin
FTimer := TTimer.Create(nil);
FTimer.Interval := 100;
FTimer.Enabled := False;
FTimer.OnTimer := TimerTick
end;
FAlarmTime := Value;
FTimer.Enabled := True;
//Trigger alarm set event
if Assigned(FSinkList) then
for I := 0 to FSinkList.Count - 1 do
if Assigned(FSinkList[I]) then
(IUnknown(FSinkList[I]) as IApplicationEvents).AlarmSet(Self, FAlarmTime);
end;
procedure TApplication.TimerTick(Sender: TObject);
var
I: Integer;
begin
if Now >= FAlarmTime then
begin
FTimer.Enabled := False;
//Trigger alarm ring event
if Assigned(FSinkList) then
for I := 0 to FSinkList.Count - 1 do
if Assigned(FSinkList[I]) then
(IUnknown(FSinkList[I]) as IApplicationEvents).AlarmRing(Self, FAlarmTime);
end
end;
Notice that a TList simply holds pointers, so each pointer must be typecast into an IUnknown interface reference before querying for the IApplicationEvents interface.
The final key job in the server is to make sure it is set up correctly for multiple clients. We saw above that the Delphi wizard sets things up for single client access only. To fix this, change ckSingle to ckMulti in the call to CreateConnectionPoint (the original version is shown in Listing 5).
Adding The Automation Server To The ROT
All that is now left is to make the object register itself in the ROT so that multiple clients can connect to it. We saw how to do this earlier, so there is no need to go over it again.
This finishes the server, so it can now be registered, either by running it, or running it with a command-line parameter of /regserver.
A Handcrafted Automation Client Event Sink
Now that the server has been completed we can focus our attention on what needs to happen in the client application (ClockClient.dpr). This first client application starts off as a simple one form project, but it needs to implement (some of) the events interface. This will be done in a separate unit called ClockClientImpl.pas.
This new unit needs to define a class that will act as the event sink. To do so it must implement IUnknown and IDispatch. TInterfacedObject implements the three IUnknown methods already so that is a suitable class to inherit from, however we must re-implement the QueryInterface method to indicate run-time support for the events interface as well.
This means we still need to add IUnknown in the implemented interfaces section of the class, despite TInterfacedObject already doing so. The definitions of IUnknown's QueryInterface and the set of IDispatch methods can be found in the System.pas unit source code.
It is easiest to copy all the method declarations into the class definition (along with a method resolution clause to allow QueryInterface to be redefined) as shown in Listing 12, then use Class Completion to finish off the typing (Shift+Ctrl+C).
Listing 12: The start of the event sink
uses
ComObj;
type
TClockSink = class(TInterfacedObject, IUnknown, IDispatch)
protected
//IUnknown
//Method resolution clause to allow QueryInterface to be redefined
function IUnknown.QueryInterface = QueryInterface;
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;
end;
Implementing IUnknown.QueryInterface
QueryInterface
needs to be rewritten because of the deceit involved in supporting a dispinterface. The class itself claims not to support the events interface as far as the definition goes, but at run-time, IDispatch can handle events interface method calls.So if the events interface is queried for, QueryInterface will return a reference to IDispatch. Anything else will be handled in the usual way. The TInterfacedObject version of QueryInterface uses a call to TObject.GetInterface, so that is what we will do for all other interfaces.
Most of the IDispatch methods (with the exception of Invoke) have appropriately formed stub implementations to satisfy any calls that may come along, which are easy to fill in. Listing 13 shows what we have so far.
Listing 13: Simple IDispatch methods
uses
Windows, ActiveX, Clock_TLB;
function TClockSink.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
Result := E_NOINTERFACE;
//If events interface requested, return IDispatch
if IsEqualIID(IID, DIID_IApplicationEvents) then
begin
if GetInterface(IDispatch, Obj) then
Result := S_OK
end
else
//Handle other interface requests normally
if GetInterface(IID, Obj) then
Result := S_OK
end;
function TClockSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL
end;
function TClockSink.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Result := E_NOTIMPL
end;
function TClockSink.GetTypeInfoCount(out Count: Integer): HResult;
begin
Count := 0;
Result := S_OK
end;
All that is left in the event sink object is the implementation of IDispatch.Invoke, the method that will be called when any event interface method is triggered. Any given client application may wish to respond to its own selection of events, however in this case we will respond to both of them.
When the server object calls an event method, it is translated into a call to IDispatch.Invoke. The particular event interface method being called is identified by its dispatch identifier (or DispID). As you can see in Listing 10, AlarmRing has a DispID of 1, and AlarmSet has a DispID of 2. Reacting to the methods is as simple as writing a case statement based upon the value of the DispID parameter passed to Invoke. Listing 14 shows how.
Listing 14: Responding to the events
function TClockSink.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
begin
Result := S_OK;
//This is called to trigger an event interface method, if implemented
//We need to check which one it is (by DispID) and do something sensible if we
//support the triggered event
case DispID of
1: ShowMessage('Alarm is ringing'); // AlarmRing
2: ShowMessage('Alarm has been set') // AlarmSet
else
//Ignore other events
end
end;
Connecting The Event Sink To The Server
The next challenge is to connect this event sink object to the server and see if it works. The first thing to do here is make sure the client form unit uses the client event sink implementation unit (ClockClientImpl.pas) as well as the server's type library import unit.
If the server and client are not in the same directory you will need to modify the compiler's unit search path in the Directories/Conditionals page of the project options dialog. This will allow the client to access the server's interface definitions.
The form's OnCreate and OnDestroy event handlers then contain all the required code. The OnCreate handler connects to a running copy of the server (or failing that, creates a new copy). Then it connects a new instance of the event sink object to the server using InterfaceConnect. The OnDestroy event handler uses InterfaceDisconnect to break the event sink link before closing down.
Listing 15 shows the code in question. InterfaceConnect is passed four parameters. The first is the event source (i.e. the Automation object) and the second is the events interface GUID (this is the interface ID, or IID).
Listing 15: Managing the link between event sink and server
procedure TClockClientForm.FormCreate(Sender: TObject);
const
ProgID = 'Clock.Application';
begin
try
ClockServer := GetActiveOleObject(ProgID) as IApplication;
except
ClockServer := CreateOleObject(ProgID) as IApplication;
end;
//No need to keep hold of event sink. It will be destroyed
//through interface reference counting when the client
//disconnects from the server in the form's OnDestroy event handler
InterfaceConnect(ClockServer, IApplicationEvents, TClockSink.Create, FSinkCookie)
end;
procedure TClockClientForm.FormDestroy(Sender: TObject);
begin
InterfaceDisconnect(ClockServer, IApplicationEvents, FSinkCookie);
end;
Delphi is very helpful when routines want GUIDs to be passed. You can pass the interface type name instead and it saves you struggling to work out how to represent the GUID. You can either pass IApplicationEvents, or the appropriate constant from the type library import unit, DIID_IApplicationEvents.
The third parameter is the event sink object. The routine wants its IUnknown interface reference, but Delphi can extract that from an object reference where the object claims to support the relevant interface.
As the comments suggest, unless you have a need to refer to this sink object again, there is no need to keep hold of a reference to it. Since it is being passed through an interface reference parameter, reference counting will ensure the object is destroyed when the last connection to it is broken.
To make the client talk to the server, reading the date and time, and setting alarm calls, add a timer to the form along with a label, a button and a disabled checkbox. The timer will periodically read the server's CurrentDateTime property and write the results in the label. It also checks if the alarm is set and updates the checkbox accordingly. The button sets the alarm for five seconds later than the current time.
Listing 16: Using the server
procedure TClockClientForm.Timer1Timer(Sender: TObject);
begin
try
lblDateTime.Caption := DateTimeToStr(ClockServer.CurrentDateTime);
chkAlarmSet.Checked := ClockServer.AlarmSet;
except
lblDateTime.Caption := 'Date/time server not available right now';
chkAlarmSet.State := cbGrayed;
end
end;
procedure TClockClientForm.btnSetAlarmClick(Sender: TObject);
begin
if not ClockServer.AlarmSet then
ClockServer.Alarm := Now + (5 / SecsPerDay)
else
ShowMessage('Alarm already set!')
end;
To prove this works, run two copies of the client program(each automatically connects to the same server object on startup). You should see the time and date being read by both programs, along with the fact that no alarm time has been set.
If you press the button, the alarm will be set, and the server will trigger an event in both clients to indicate this (both clients will generate a message box, one at a time). When the five seconds are up, the alarm will ring and another event is triggered to highlight this new fact (see Figure 5). Again each client produces a message box in turn.
Figure 5: The AlarmRing event triggering
Accessing Event Method Parameters
The next challenge involves trying to access the parameters passed along with the event method calls. You will recall that both event methods had a pair of parameters defined.
Looking back at Listing 14, you can see an untyped var parameter called Params. This parameter is actually a variable of type TDispParams (dispatch parameters), which is a record type defined in the ActiveX unit. The first field of this record is called rgvarg and is a PVariantArgList, a pointer to a TVariantArgList, which is an array of up to 64k elements of type TVariantArg.
is a formal record definition representing the content of an OleVariant, so rgvarg is basically a pointer to an array of OleVariant elements. The passed parameters are stored in reverse order, so the last parameter is at element 0 and the first parameter is at element TDispParams(Params).cArgs - 1. In this case, the cArgs field will be 2 for both method calls.Listing 17 shows an updated version of the IDispatch.Invoke method implementation, which can be found in ClockClient2.dpr. The event sink object uses the main form unit and consequently is able to write to the components on it. This version of the client application removes the checkbox and label from the form and replaces them with a status bar. The form's timer event handler therefore also changes a little and is also shown.
Listing 17: Responding to the events and accessing parameters
function TClockSink.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
var
Args: PVariantArgList;
Clock: IApplication;
AlarmDateTime: TDateTime;
begin
Result := S_OK;
//Both event methods happen to have the same parameters,
//so we can extract them just once to save duplication
Args := TDispParams(Params).rgvarg;
Clock := IUnknown(OleVariant(Args^[1])) as IApplication;
AlarmDateTime := OleVariant(Args^[0]);
case DispID of
1: {AlarmRing} ClockClientForm.Bar.Panels[2].Text := Format(
'Alarm rang at %s. Time is now %s',
[DateTimeToStr(AlarmDateTime),
TimeToStr(Clock.CurrentDateTime)]);
2: {AlarmSet} ClockClientForm.Bar.Panels[2].Text := Format(
'Alarm set for %s. Time is now %s',
[DateTimeToStr(AlarmDateTime),
TimeToStr(Clock.CurrentDateTime)])
else
//Ignore other events
end
end;
...
procedure TClockClientForm.Timer1Timer(Sender: TObject);
begin
try
Bar.Panels[0].Text := DateTimeToStr(ClockServer.CurrentDateTime);
if ClockServer.AlarmSet then
Bar.Panels[1].Text := 'Alarm set'
else
Bar.Panels[1].Text := 'Alarm not set';
except
Bar.Panels[0].Text := 'N/A';
Bar.Panels[1].Text := 'N/A';
end
end;
Figure 6 shows the new client application after the alarm time arrives and the AlarmRing event method has been called.
Figure 6: An event firing in the client
A common way to keep the implementation of the event sink free from details about components on forms is to define event properties in the class. These event properties will work just like normal component properties and can have event handlers set up in any object.
The plan is to allow the form to add functionality to the event sink using event handlers of its own, rather than writing all the custom functionality in the event sink unit. Because of this new change (which is implemented in ClockClient3.dpr), the event sink unit no longer needs to use the main form unit.
Listing 18 shows how the event sink class and Invoke method look after the changes.
Listing 18: Changing the event sink implementation to surface event properties of its own
type
TClockEvent = procedure(Clock: IApplication; AlarmDateTime: TDateTime) of object;
TClockSink = class(TInterfacedObject, IUnknown, IDispatch)
private
FOnAlarmRing,
FOnAlarmSet: TClockEvent;
protected
...
public
property OnAlarmRing: TClockEvent read FOnAlarmRing write FOnAlarmRing;
property OnAlarmSet: TClockEvent read FOnAlarmSet write FOnAlarmSet;
end;
...
function TClockSink.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
var
Args: PVariantArgList;
Clock: IApplication;
AlarmDateTime: TDateTime;
begin
Result := S_OK;
//This is called to trigger an event interface method, if implemented
//We need to check which one it is (by DispID) and do something sensible if we
//support the triggered event
//Both event methods happen to have the same parameters,
//so we can extract them just once to save duplication
Args := TDispParams(Params).rgvarg;
//Params are in reverse order:
//Last parameter is at pos. 0
//First parameter is at pos. cArgs - 1
Clock := IUnknown(OleVariant(Args^[1])) as IApplication;
AlarmDateTime := OleVariant(Args^[0]);
case DispID of
1: if Assigned(FOnAlarmRing) then
FOnAlarmRing(Clock, AlarmDateTime);
2: if Assigned(FOnAlarmSet) then
FOnAlarmSet(Clock, AlarmDateTime);
else
//Ignore other events
end
end;
This now allows the form to define a couple of methods to act as event handlers for these new events, as shown in Listing 19. If you look in the OnAlarmRing event handler, you will see that extra code has been added to simplistically animate a label to highlight the fact that the alarm is ringing (see Figure 7).
Listing 19: New event handlers in the form class
type
TClockClientForm = class(TForm)
...
public
ClockServer: IApplication;
procedure AlarmClockRing(Clock: IApplication; AlarmDateTime: TDateTime);
procedure AlarmClockSet(Clock: IApplication; AlarmDateTime: TDateTime);
end;
...
procedure TClockClientForm.FormCreate(Sender: TObject);
const
ProgID = 'Clock.Application';
var
Sink: TClockSink;
begin
try
ClockServer := GetActiveOleObject(ProgID) as IApplication;
except
ClockServer := CreateOleObject(ProgID) as IApplication;
end;
//Create event sink
Sink := TClockSink.Create;
//Set up event sink event handlers
Sink.OnAlarmRing := AlarmClockRing;
Sink.OnAlarmSet := AlarmClockSet;
//Connect to server
InterfaceConnect(ClockServer, IApplicationEvents, Sink, FSinkCookie)
end;
...
procedure TClockClientForm.AlarmClockRing(Clock: IApplication;
AlarmDateTime: TDateTime);
var
I: Integer;
begin
Bar.Panels[2].Text := Format(
'Alarm rang at %s. Time is now %s',
[DateTimeToStr(AlarmDateTime),
TimeToStr(Clock.CurrentDateTime)]);
lblMsg.Caption := 'Ring!!!';
for I := 0 to 8 do
begin
lblMsg.Font.Size := Succ(I mod 3) * 8;
lblMsg.Update;
Sleep(100)
end;
lblMsg.Caption := '';
end;
procedure TClockClientForm.AlarmClockSet(Clock: IApplication;
AlarmDateTime: TDateTime);
begin
Bar.Panels[2].Text := Format(
'Alarm set for %s. Time is now %s',
[DateTimeToStr(AlarmDateTime),
TimeToStr(Clock.CurrentDateTime)])
end;
Figure 7: An event handler in the form class
A Machine-Generated Automation Client
We have spent some time looking at how to set up an Automation client by hand. We should now look at how we can ask Delphi 5 (and later) to do all the hard work for us.
We can ask Delphi to import any COM server's type library and manufacture a wrapper component within the type library import unit for each Automation object defined therein. The wrapper components are not present in the type library import unit being managed by the server, but can be added in by an explicit import operation.
The component allows you to connect to the Automation server without writing any connection code. The component also acts as an event sink with events that correspond to the methods of the events interface, assuming one exists. These events are much like those we set up manually earlier.
This allows us to create a fourth client project (this one is called ClockClient4.dpr). With the project open and the Automation server registered, we can ask Delphi to import the server's type library. Choose Project | Import Type Library... and you will see a dialog listing all the registered type libraries (see Figure 8).
Figure 8: Importing a registered type library
This dialog will manufacture a type library import unit, with some optional enhancements. Assuming the checkbox at the bottom of the dialog is checked, the unit will also include the definition of a wrapper component that serves two purposes. The wrapper component suggested in Figure 8 is called TApplication (remember the coclass was called Application) and will be placed (by default) on the ActiveX page of the Component Palette. The target location of the import unit is customisable and it is often sensible to place it in the directory of the project that will be using it.
You can either press Create Unit to create the import unit, and not install it or, preferably, the Install... button. This will produce another dialog (Figure 9) that asks you which component package you wish to add the import unit to (the default suggestion is fine).
Figure 9: Installing a component that represents an Automation server
Press OK and accept Delphi's offer to recompile the package and you will be told that the component has been installed (see Figure 10).
Figure 10: Delphi reports successful installation of the component wrapper
Now get a TApplication component from the ActiveX page of the Component Palette and drop it on the form. Rename it to ClockServer for consistency. Change the AutoConnect property to True so we need not worry about establishing a connection to the Automation Server. The Events page of the Object Inspector shows the event properties surfaced from the events interface (see Figure 11). You can make event handlers as normal and add the same code in as before.
Figure 11: The component wrapper events
The code for the timer's OnTimer event handler is exactly as it was before, so the application is ready to run.
The component wrapper makes the connection to an Automation server less tedious than it was previously. It also simplifies the job of writing an event sink by doing it for you, and surfacing the events to the Object Inspector.
Many Automation servers employ a mechanism where the externally created Automation object can provide access to internally created objects.
Take Microsoft Word as a typical example. You create the VBA Application object from the client, then you use properties and methods to create Document (and other) objects. It is not possible to create a Document object directly from the client, only indirectly through the Application object.
To mimic this arrangement of having lots of objects accessible through one externally created object we require additional Automation objects which have no class factories, and therefore are not registered in the Windows registry. The normal Automation object takes responsibility for creating the additional objects as required.
To test the idea, make a new project. The one that accompanies this paper is called Hierarchy.dpr and can be found in the Hierarchy 1 directory. Create an Automation object using the Delphi wizard, giving it a coclass name of Application. Save the unit that contains this object's implementation as ApplicationImpl.pas.
The Application object will have a read-only Clock property whose job is to return an IClock interface of a Clock object. To start off, make a second Automation object with a coclass of Clock, and save the created unit as ClockImpl.pas.
Making An Automation Object Inaccessible To The Outside World
As it stands, the Automation object implementation unit contains an initialisation section that creates a class library for the Automation object. This is not required for internally created Automation objects, so you can delete the whole initialisation section.
Additionally, in the Automation object class definition, the class we inherit from should be changed from TAutoObject to TAutoIntfObject. TAutoIntfObject has no class factory support, but still implements the normal Automation interfaces of IDispatch and ISupportErrorInfo (the latter is used for exception handling with safecall routines, see Reference 3).
To allow access to the new Clock object, make new read-only property in the IApplication interface called Clock, and set the type to be IClock. After pressing Refresh, the TApplication.Get_Clock method can be implemented as in Listing 20.
Listing 20: Creating a Clock object
function TApplication.Get_Clock: IClock; begin Result := TClock.Create(ComServer.TypeLib, IClock) end;
Notice that the TAutoIntfObject constructor takes an ITypeLib interface reference as its first parameter and the dispatch interface GUID as the second parameter. The type library interface can be extracted readily from the ComServer object (defined in the ComServ unit).
For a Delphi generated Automation object, the interface and dispatch interface share the same GUID (see the Hierarchy_TLB.pas unit to clarify this; the embedded GUID inside IApplication and IApplicationDisp are identical). To pass the GUID, you can either use the constant defined in Hierachy_TLB.pas (IID_IApplication) or pass either of the interface reference types and Delphi will extract it for you. The code above takes the latter option.
Now that the clock object can be created (via the Application object), we can define properties in the IClock interface. Date, Time, and DateTime can be defined as read-only TDateTime properties. Their implementations are shown in Listing 21.
Listing 21: Some clock property readers
function TClock.Get_Date: TDateTime; begin Result := Date end; function TClock.Get_DateTime: TDateTime; begin Result := Now end; function TClock.Get_Time: TDateTime; begin Result := Time end;
For something different, we will make another read-only property that returns constant values from an enumeration. This requires you to press the Enum button on the type library editor, and then use the Const button (visible when an enumeration is selected) to add in each element in the enumeration.
The enumeration is called TDayOfWeek and it contains seven constants dowSunday (with a value of 1) to dowSaturday (with a value of 7) as shown in Figure 12.
Figure 12: An enumeration defined in the type library
You can now make a read-only IClock property called DayOfWeek, of type TDayOfWeek, which has a simple implementation:
Result := DayOfWeek(Now)
A new client application can readily access all these properties once the server has been registered. A sample client project accompanies this paper and is called HierarchyClient.dpr. Some of the code can be seen in Listing 22.
Listing 22: A client accessing the clock
type
THierarchyClientForm = class(TForm)
...
public
Server: IApplication;
Clock: IClock;
end;
...
procedure THierarchyClientForm.FormCreate(Sender: TObject);
begin
Server := CreateOleObject('Hierarchy.Application') as IApplication;
Clock := Server.Clock
end;
procedure THierarchyClientForm.Timer1Timer(Sender: TObject);
begin
try
lblDateTime.Caption := DateTimeToStr(Clock.DateTime);
lblDate.Caption := DateToStr(Clock.Date);
lblTime.Caption := TimeToStr(Clock.Time);
lblDayOfWeek.Caption := LongDayNames[Clock.DayOfWeek]
except
lblDateTime.Caption := 'N/A';
lblDate.Caption := 'N/A';
lblTime.Caption := 'N/A';
lblDayOfWeek.Caption := 'N/A'
end
end;
The code works fairly well, however with one important proviso. Whilst the Application object will provide access to the Clock object, the lifetime of the Automation server is governed by the Application object. What this means is that if the client drops its connections to the Application object (but still has a connection to the Clock object) the Automation server will be closed down, and the IClock interface references will cause Access Violations or other unpleasant errors.
This is because the Automation server only pays attention to the number of externally accessible objects that are alive. When that number drops to zero, the server is shut down, regardless of the existence of any other objects in the application.
This is why Listing 22 declares Server as a form data field, rather than a local variable in the form's OnCreate event handler, FormCreate (the only place it is referred to). If it were declared locally the server would be shut down as soon as the OnCreate handler exits. This is clear as long as you understand that Delphi automatically increments an interface's reference count when you assign it to an interface reference variable, and automatically decrements it when that variable goes out of scope.
To avoid the problem, we must get every Clock object instance to increment the Application object's reference count when created and decrement it when destroyed.
The result of this will be that even if the client drops all references to the Application object, any existing Clock object will still have a reference to it. This means that the reference count will be higher than zero and so the Application object will not destroy itself. When the Clock reference count gets to zero, the Application reference count will be decremented and the Application object can then destroy itself if it needs to.
There are various ways to accomplish this reference counting modification. The easiest is for the TClock constructor to take an IApplication interface reference as a parameter, and then store it in a private data field (storing it will increment the reference count, and when the Clock is destroyed the reference count will be automatically decremented).
A modified server application can be found along with another copy of the client in the Hierarchy 2 directory. The modified constructor can be seen in Listing 23. Instead of the old pair of parameters (which are passed in by the new implementation), it now takes just an IApplication interface reference.
Listing 23: The modified TClock constructor
type
TClock = class(TAutoIntfObject, IClock)
private
FApplication: IApplication;
...
function Get_Application: IApplication;
public
constructor Create(const Application: IApplication);
end;
...
constructor TClock.Create(const Application: IApplication);
begin
inherited Create(ComServer.TypeLib, IClock);
FApplication := Application
end;
...
function TClock.Get_Application: IApplication;
begin
Result := FApplication
end;
Listing 23 also shows the property reader for a new Application property. The Platform SDK recommends that any Automation server with an object hierarchy should firstly have an Application object, but also that all objects should have both an Application property and a Parent property. These properties should return IDispatch interface references. The Application and Parent properties of the Application object should return the Application object.
However, Microsoft Word is a prime example of an Automation server, and all its Application properties are defined in terms of the corresponding Application interface, rather than IDispatch.
The implementation of the Clock property reader now changes from Listing 20 to be simply:
Result := TClock.Create(Self)
With this change, Listing 22 could be successfully modified to declare Server as a local variable in the FormCreate method, as was being discussed above.
Automation applications often manage a selection of items of a given type using a collection. For example Microsoft Word manages all its Document objects in a collection called Documents. Similarly, Microsoft Excel manages all its WorkBook objects in a collection called WorkBooks.
VB (Visual Basic) and VBA (Visual Basic for Applications) are examples of languages that have special knowledge of collections and provide a syntactic mechanism to allow easy manipulation of them. Consequently, in order to allow such mechanisms to work correctly, we must follow certain rules.
A collection is itself an Automation object (an object implementing IDispatch). There are some things it must support.
Building A Collection In An Automation Server
With the rules laid down, we can now build an Automation server with a collection in it (stored as Collection.dpr beneath the Collections directory in the files that accompany this paper). The server will have a visible UI whilst active, and has a handful of edit controls on the form. These edit controls keep their default names of Edit1, Edit2 and so on.
The server will have an Application Automation object whose primary job is to allow a client application access to the edit controls. This is achieved by representing each edit with an object that implements IEditControl.
The edits will be accessible through a collection object which implements the IEditControls interface. This collection will be available through the Application object's EditControls read-only property.
All three interfaces (IApplication, IEditControl and IEditControls) will have an Application property, as per the earlier guideline (the Parent property will be skipped).
Start by creating a new Automation object with a coclass called Application, then save the implementation unit as ApplicationImpl.pas. Add the read-only Application property of type IApplication (the implementation returns Self).
Next, add another Automation object with a coclass called EditControl, in a unit called EditControlImpl.pas. This is not to be directly accessible, so change the ancestor class to TAutoObjectIntf and delete the initialisation section.
To add functionality to this edit control interface, add the following members to IEditControl using the type library editor.
Also define a new constructor for the class that takes an IApplication interface reference and a TEdit object reference for it to represent. These two values are stored in new private data fields. Listing 24 shows how the final code looks.
Listing 24: The edit control Automation object
type
TEditControl = class(TAutoIntfObject, IEditControl)
private
FApplication: IApplication;
FEdit: TEdit;
protected
function Get_Application: IApplication; safecall;
function Get_Name: WideString; safecall;
function Get_Text: WideString; safecall;
procedure Clear; safecall;
procedure Set_Text(const Value: WideString); safecall;
{ Protected declarations }
public
constructor Create(Application: IApplication; Edit: TEdit);
end;
implementation
uses
ComServ;
constructor TEditControl.Create(Application: IApplication; Edit: TEdit);
begin
inherited Create(ComServer.TypeLib, IEditControl);
FApplication := Application;
FEdit := Edit
end;
function TEditControl.Get_Application: IApplication;
begin
Result := FApplication
end;
function TEditControl.Get_Name: WideString;
begin
Result := FEdit.Name
end;
function TEditControl.Get_Text: WideString;
begin
Result := FEdit.Text
end;
procedure TEditControl.Set_Text(const Value: WideString);
begin
FEdit.Text := Value
end;
procedure TEditControl.Clear;
begin
FEdit.Clear
end;
The Collection (IEditControls)
Add a final Automation object with a coclass of EditControls in a unit called EditControlsImpl.pas and make the changes to prevent the object being directly accessible to clients (change the ancestor class to TAutoIntfObject and remove the initialisation section).
This class when constructed will create a TInterfaceList and store IEditControl interface references to TEditControl objects that represent each of the edit controls on the main form. It also requires the _NewEnum, Count and Item read-only properties as described above and shown in Listing 25.
Listing 25: The textual versions of the key collection methods from the type library editor
function _NewEnum: IUnknown [propget, dispid $FFFFFFFC, restricted]; safecall; function Item(Index: OleVariant): IEditControl [propget, dispid 0, defaultcollelem]; safecall; function Application: IApplication [propget, dispid 1]; safecall; function Count: Integer [propget, dispid 2]; safecall;
The implementation of these methods (and the new constructor and destructor) in the collection class can be seen in Listing 26. The constructor stores the Application interface reference passed in, and sets up the Automation objects that represent the edit controls. These objects are then stored in a TInterfaceList object. The destructor simply frees the TInterfaceList object.
Listing 26: The collection object
type
TEditControls = class(TAutoIntfObject, IEditControls)
private
FApplication: IApplication;
FEditList: TInterfaceList;
protected
function Get__NewEnum: IUnknown; safecall;
function Get_Application: IApplication; safecall;
function Get_Count: Integer; safecall;
function Get_Item(Index: OleVariant): IEditControl; safecall;
public
constructor Create(Application: IApplication);
destructor Destroy; override;
end;
constructor TEditControls.Create(Application: IApplication);
var
I: Integer;
begin
inherited Create(ComServer.TypeLib, IEditControls);
FApplication := Application;
FEditList := TInterfaceList.Create;
//Qualify the Forms unit, as Application is ambiguous in this unit
with Forms.Application.MainForm do
for I := 0 to ComponentCount - 1 do
if Components[I] is TEdit then
FEditList.Add(TEditControl.Create(FApplication, TEdit(Components[I])))
end;
destructor TEditControls.Destroy;
begin
FEditList.Free;
inherited;
end;
function TEditControls.Get__NewEnum: IUnknown;
begin
Result := TEnumerator.Create(Self)
end;
function TEditControls.Get_Application: IApplication;
begin
Result := FApplication
end;
function TEditControls.Get_Count: Integer;
begin
Result := FEditList.Count
end;
function TEditControls.Get_Item(Index: OleVariant): IEditControl;
var
I: Integer;
begin
Result := nil;
if VarType(Index) = varOleStr then
begin
//find by name
for I := 0 to FEditList.Count - 1 do
if CompareText((FEditList[I] as IEditControl).Name, Index) = 0 then
begin
Result := FEditList[I] as IEditControl;
Break
end
end
else
try
//Assume an integer was passed, and cater for collection starting at 1
Result := FEditList[Index - 1] as IEditControl
except
//Bad index
end
end;
The interesting methods are the Item property reader, and the _NewEnum property reader (which we will address shortly).
Get_Item
tries to support indexing by number and by name. It first checks if the index type is a string. If it is, the value is assumed to be an edit component name, and the edit list is cycled through looking for a match.If the index is not a string, it is assumed to be an integer (although an exception handler picks up cases where this is not the case), which is used as an index into the list. Remember that collections should be 1-based, not 0-based like the list, which explains the subtraction of 1 from the index.
The Get__NewEnum method is required to return the IUnknown interface reference of an object that implements IEnumVARIANT. As you can see in Listing 26, TEnumerator is the class that does this (which is shown in Listing 27).
Listing 27: The enumerator class
type
IEnumVariant = interface(IUnknown)
['{00020404-0000-0000-C000-000000000046}']
function Next(celt: LongWord; out elt;
pceltFetched: PLongWord): HResult; stdcall;
function Skip(celt: LongWord): HResult; stdcall;
function Reset: HResult; stdcall;
function Clone(out Enum: IEnumVariant): HResult; stdcall;
end;
TEnumerator = class(TInterfacedObject, IEnumVariant)
private
FEnumPos: Integer;
FEditControls: IEditControls;
protected
function Next(celt: LongWord; out elt;
pceltFetched: PLongWord): HResult; stdcall;
function Skip(celt: LongWord): HResult; stdcall;
function Reset: HResult; stdcall;
function Clone(out Enum: IEnumVariant): HResult; stdcall;
public
constructor Create(EditControls: IEditControls);
end;
constructor TEnumerator.Create(EditControls: IEditControls);
begin
inherited Create;
FEditControls := EditControls
end;
function TEnumerator.Clone(out Enum: IEnumVariant): HResult;
var
Enumerator: TEnumerator;
begin
Result := S_OK;
try
Enumerator := TEnumerator.Create(FEditControls);
Enumerator.FEnumPos := FEnumPos;
Enum := Enumerator;
except
Enum := nil;
Result := E_OUTOFMEMORY
end
end;
function TEnumerator.Next(celt: LongWord; out elt;
pceltFetched: PLongWord): HResult;
var
I: Integer;
EditDispatch: IDispatch;
begin
Result := S_FALSE;
try
if Assigned(pceltFetched) then
pcEltFetched^ := 0;
for I := 0 to celt - 1 do
begin
if FEnumPos >= FEditControls.Count then
Exit;
EditDispatch := FEditControls.Item[FEnumPos + 1] as IDispatch;
//Interface reference is about to be stored in a pointer field.
//Must therefore do lifetime management manually, as Delphi will not do it
EditDispatch._AddRef;
TVariantArgList(elt)[I].vt := varDispatch;
TVariantArgList(elt)[I].dispVal := Pointer(EditDispatch);
Inc(FEnumPos);
if Assigned(pceltFetched) then
Inc(pceltFetched^)
end
except
//Hide any errors
end;
if (not Assigned(pceltFetched)) or (Assigned(pceltFetched) and (pceltFetched^ = celt)) then
Result := S_OK
end;
function TEnumerator.Reset: HResult;
begin
FEnumPos := 0;
Result := S_OK
end;
function TEnumerator.Skip(celt: LongWord): HResult;
begin
if FEnumPos + Integer(celt) > FEditControls.Count - 1 then
begin
FEnumPos := FEditControls.Count - 1;
Result := S_FALSE;
end
else
begin
Inc(FEnumPos, celt);
Result := S_OK
end
end;
This interface is used internally by VB and VBA to iterate across a collection, so the TEnumerator class must have a close link with the IEditControls interface (a reference is passed to the constructor). A data field FEnumPos defines how far through the collection the enumeration has got. It defaults to position 0 (again, remember that collections themselves should start at position 1).
The Reset method is designed to reset the enumeration at any time. Its implementation is straightforward, setting FEnumPos back to 0.
The Clone method allows the state of the enumeration to be recorded at any time. This is done by creating another TEnumerator object based on the same IEditControls interface, and setting its FEnumPos field to the same value as the original enumerator's.
As its name suggests, the Skip method skips over a number of elements in the collection. If it is asked to skip more elements than there are left, it returns S_FALSE instead of S_OK and positions on the last element.
The least trivial method is Next, which is designed to retrieve one or more elements from the collection, starting with the current element. The number of elements to retrieve is passed in celt and the elements are supposed to be stored in the elt parameter, which is an array of TVariantArg records, celt elements in size. The type TVariantArgList is defined to be an array of 64k TVariantArg elements and so is useful for typecasting elt to.
TVariantArg
(from the ActiveX unit) is quite similar to TVarData (from the System unit) in that you can typecast a Variant (or preferably an OleVariant, which cannot hold a Delphi long string) into either type to access its contents. However, interface references are stored as pointers only in the case of TVariantArg. This means that when you assign an interface reference to the appropriate field, Delphi will not increment the reference count of the interface for you. Also, there is no predefined type that is an array of TVarData records.The IEnumVariant interface is already defined in the ActiveX unit, but is redefined here to accommodate issues with some of the parameter definitions. The ActiveX unit version of Next defines the second parameter to be a single OleVariant, not an array of them.
Also, the third parameter, pceltFetched, designed to tell the caller how many elements were retrieved is declared as an out parameter of type LongWord. This would be fine except the caller can pass nil along for this parameter which will cause problems. It is better defined as a pointer to a LongWord, which can easily take on a nil value and be tested for it.
At the machine level, these two parameter list declarations boil down to the same thing, but at the Pascal level, these differences can be significant in usability.
The implementation of Next is very careful about the pceltFetched pointer parameter, checking it is non-nil before writing to the LongWord pointed to by it. Apart from that, a read through the code should explain most of it. If the enumeration has reached the end of the collection, it skips out. If not, a loop gets the next edit control, increments its reference count (it won't be done by assigning into the output parameter) and stores it in the appropriate array element as an IDispatch interface.
The enumeration position is then incremented to allow the remaining elements to be retrieved. The routine returns S_OK if all the elements requested were retrieved (assuming the caller is interested in checking), otherwise it returns S_FALSE.
The Application (IApplication)
The only change remaining in the Application Automation object is to define the read-only collection property EditControls, of type IEditControls. This is straightforward and the implementation can be seen in Listing 28.
Listing 28: The Application object with a collection property
type
TApplication = class(TAutoObject, IApplication)
protected
function Get_Application: IApplication; safecall;
function Get_EditControls: IEditControls; safecall;
end;
function TApplication.Get_Application: IApplication;
begin
Result := Self
end;
function TApplication.Get_EditControls: IEditControls;
begin
Result := TEditControls.Create(Self)
end;
All that remains is to make sure the server compiles successfully, and then to register it.
Delphi has no built in knowledge of Automation collections, so we will need to use the indexing method Item in order to access the collection elements. Remember that we can index either with the numeric position (starting at 1) or the component name.
A simple client can be built with a listbox and three buttons. The form's OnCreate event handler connects to the server and gets hold of the collection object. One of the buttons clears the listbox. The second one loops through all the buttons indexing by number, reading all the values and also modifying them slightly (appending an exclamation mark). The other button does much the same thing but indexes the controls by their name.
The client code can be seen in Listing 29 and the client and server can be seen running together in Figure 13.
Listing 29: A Delphi client for the collection server
type
TCollectionClientForm = class(TForm)
lstEditText: TListBox;
btnNumericIndex: TButton;
btnStringIndex: TButton;
btnClearList: TButton;
procedure FormCreate(Sender: TObject);
procedure btnClearListClick(Sender: TObject);
procedure btnNumericIndexClick(Sender: TObject);
procedure btnStringIndexClick(Sender: TObject);
public
EditControls: IEditControls;
end;
...
procedure TCollectionClientForm.FormCreate(Sender: TObject);
var
Server: IApplication;
begin
Server := CreateOleObject('Collection.Application') as IApplication;
EditControls := Server.EditControls;
end;
procedure TCollectionClientForm.btnClearListClick(Sender: TObject);
begin
lstEditText.Items.Clear;
end;
procedure TCollectionClientForm.btnNumericIndexClick(Sender: TObject);
var
I: Integer;
Edit: IEditControl;
begin
for I := 1 to 5 do
begin
//Item is the default member of the collection object, so is optional
//Edit := EditControls.Item[I];
Edit := EditControls[I];
lstEditText.Items.Add(Edit.Text);
Edit.Text := Edit.Text + '!'
end
end;
procedure TCollectionClientForm.btnStringIndexClick(Sender: TObject);
var
I: Integer;
EditName: String;
Edit: IEditControl;
begin
for I := 1 to 5 do
begin
EditName := Format('Edit%d', [I]);
Edit := EditControls[EditName];
lstEditText.Items.Add(Edit.Text);
Edit.Text := Edit.Text + '!'
end
end;
Figure 13: The collection server in action
Having said that Delphi has no built in knowledge of collections, there is nothing stopping you defining your own generic routine to fill the gap, as shown in Listing 30. The code to execute for each item is placed in a callback method that is passed to each element in turn. It is also passed a Boolean var parameter that allows the callback to terminate the iteration by setting it to False.
To enumerate, you pass the collection's IDispatch interface and the callback routine to the Enumerate procedure.
Listing 30: Iterating across a collection in Delphi
type
TEnumerateCallBack = procedure(Item: IDispatch; var Continue: Boolean) of object;
procedure Enumerate(Collection: IDispatch; CallBack: TEnumerateCallBack);
var
EnumUnk, Element: OleVariant;
Enum: IEnumVariant;
Fetched: Cardinal;
Continue: Boolean;
const
DispParamNoArgs: TDispParams =
(rgvarg: nil; rgdispidNamedArgs: nil; cArgs: 0; cNamedArgs: 0);
begin
//Call _NewEnum via its DispID and get enumerator object's IUnknown interface
OleCheck(Collection.Invoke(DISPID_NEWENUM, GUID_NULL, 0,
DISPATCH_PROPERTYGET, DispParamNoArgs, @EnumUnk, nil, nil));
//Check we got an IUnknown and get IEnumVariant from it
if VarType(EnumUnk) = varUnknown then
begin
Enum := IUnknown(EnumUnk) as IEnumVariant;
Continue := True;
//Use enumeration method to cycle through elements
while (Enum.Next(1, Element, Fetched) = S_OK) and Continue do
CallBack(Element, Continue)
end
end;
//Custom method in form class that acts as a callback routine
procedure TCollectionClientForm.EnumerationCallBack(Item: IDispatch; var Continue: Boolean);
var
Edit: IEditControl;
begin
Edit := Item as IEditControl;
lstEditText.Items.Add(Edit.Text);
Edit.Text := Edit.Text + '!'
end;
//Initiating the enumeration with a button
procedure TCollectionClientForm.btnEnumerateClick(Sender: TObject);
begin
Enumerate(EditControls as IDispatch, EnumerationCallBack)
end;
To test the collection against VBA, you can use Microsoft Word (Word 97 is assumed, in case of any UI changes in Word 2000).
Start Microsoft Word and invoke the VBA editor (Tools | Macro | Visual Basic Editor, or Alt+F11). Choose Insert | UserForm to get a new form, then add a button and a listbox on it from the Toolbox.
Now ensure the application knows about the relevant server by choosing Tools | References..., then checking the Collection Library entry.
Press F7 to view the Code window (View | Code) and select (General) from the top left combobox. Where the cursor is left, insert the Automation server variable definition:
Dim Server As Collection.Application
Now select UserForm from the top left combobox and then Initialize from the top right combobox. This makes an Initialize event handler where we connect to the Automation server:
Set Server = CreateObject("Collection.Application")
Now select CommandButton1 from the top left combobox and ensure Click is selected in the top right combobox. In this button Click event handler, we can enumerate the collection, as shown in Listing 31. You should find this works much the same as the Delphi version did.
Listing 31: Testing the collection from VBA
Private Sub CommandButton1_Click()
Dim Edit As EditControl
For Each Edit In Server.EditControls
ListBox1.AddItem (Edit.Text)
Edit.Text = Edit.Text + "!"
Next
End Sub
As you can see there are many facets to Automation over and above simple properties and methods in a server, as covered in typical introductory Automation papers, such as Reference 1.
This paper has covered instancing options, Automation events, Automation object hierarchies, Automation collections and the Running Object Table in an attempt to open up additional avenues to Automation programmers.
For information on further topics, such as the safecall calling convention and a full discussion on apartments and multi-threading with COM (and Automation) see the other articles in the References section.
Click here to download the files associated with this paper.
Brian Long used to work at Borland UK, performing a number of duties including Technical Support on all the programming tools. Since leaving in 1995, Brian has spent the intervening years as a trainer, trouble-shooter and mentor focusing on the use of the C#, Delphi and C++ languages, and of the Win32 and .NET platforms. In his spare time Brian actively researches and employs strategies for the convenient identification, isolation and removal of malware.
If you need training in these areas or need solutions to problems you have with them, please get in touch or visit Brian's Web site.
Brian authored a Borland Pascal problem-solving book