Automation in Delphi COM Programming

Out-of-Process Automation Servers

In Chapter 2, I discussed the need for marshaling in out-of-process COM servers. Briefly, the data types that are automation compatible are Smallint, Integer, Single, Double, Currency, TDateTime, WideString, IDispatch, SCODE, WordBool, OleVariant, IUnknown, Shortint, and Byte. As you'll learn in a moment, Delphi also provides marshaling support for pictures, string lists, and fonts through the interfaces IPicture, IStrings, and IFonts.

Out-of-process Automation servers are desirable in cases where the Automation server should act as a standalone application in its own right, and they're required in cases where you want to access the server from a remote machine using DCOM (DCOM is discussed in Chapter 6, "DCOM").

HResult and Safecall

All methods in an Automation server must return an HResult, which indicates whether the method succeeded or failed. Any other return values must be returned in out parameters, discussed in Chapter 3.

This doesn't sound logical, given that the Convert method used in UnitSrv returns a Double. Once again, Delphi shields us from some of the complexities of COM. In a typical programming environment, you would need to write the Convert method as follows:

function Convert(Quantity: Double; InUnit: Integer; OutUnit: Integer; out Result: Double): HResult; stdcall;

The safecall calling convention allows you to code as if the method looked like the following:

function Convert(Quantity: Double; InUnit: Integer; OutUnit: Integer): Double; stdcall;

The safecall directive also tells Delphi to perform another major function behind the scenes. Safecall on the server side of the COM implementation instructs Delphi to automatically wrap all methods in a try/except block. For example, when you write the following code in an automation server,

function TMyServer.DoSomething: Integer;
begin
 Result := SomeFunctionThatReturnsAnInteger;
end;

Delphi compiles the equivalent of the following code into your application:

function TMyServer.DoSomething(out Ret: Integer): HResult;
begin
 try
  Ret := SomeFunctionThatReturnsAnInteger;
  Result := S_OK;
 except
  Result := E_UNEXPECTED;
 end;
end;

In other words, Delphi prevents an exception from escaping from a method of an automation server. Instead, it channels the exception back to the client application as an HResult.

On the client side, safecall causes the client to check the method for a HResult failure code and raise a Delphi exception if the method returns an error.

To understand why it's desirable for this to occur, consider the fact that an Automation server might not have a user interface. It could have a hidden main window, for example, or no window at all. If an exception suddenly popped up, it would be disconcerting for the end user, at best. Further, as you'll learn in Chapter 6, automation objects don't even have to reside on the same machine as the clients that use them. If the computer that hosts the automation object resides down the hall (or halfway around the world), the client app has no way of knowing when an exception is displayed on the server machine.

---

Marshaling Strings, Fonts, and Pictures

As I briefly mentioned earlier, Delphi provides marshaling support for pictures, string lists, and fonts. This is a welcome feature, because Delphi makes considerable use of both string lists and fonts in the VCL. I'm not going to list the declaration of those interfaces here, but if you're interested in looking into them on your own, IStrings is declared in stdvcl.pas, and IFont and IPicture are declared in activex.pas. The sample program shown in the next section shows how to use IStrings and IFonts in your applications.

---

Automating an Existing Application

In this section, we're going to take an existing application and add automation capability to it. The application is a very simple program with a memo and two buttons on the main form. One button changes the font of the memo, and the other button changes the color. Not very exciting, but it serves to illustrate the points I want to make here.

There are many cases in which you might want to automate an existing application. For instance, let's say you have written a checkbook application (ala Quicken) that contains functionality for looking up stock prices online. If you automate the price lookup functionality, you (or another programmer) could later write a client application that instructs the checkbook application to download the latest stock prices at certain intervals.

In this example, you'll learn not only how to add automation capability to an existing application, but you'll also see how to pass string lists, colors, and fonts as parameters to an automation method.

---

Note - In actuality, many out-of-process Automation servers, unlike the example shown here, are complete programs within themselves. Consider the fact that Microsoft Word is an Automation server. Word is a very complete (read: large) program in itself, yet it also makes almost all its functionality available through automation.

---

Listing 4.2 shows the source code for the main form of the MemoDemo application.

Listing 4.2  MemoDemo Application—MainForm.pas

unit MainForm;

interface

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

type
 TForm1 = class(TForm)
  Memo1: TMemo;
  btnFont: TButton;
  btnColor: TButton;
  FontDialog1: TFontDialog;
  ColorDialog1: TColorDialog;
  procedure btnFontClick(Sender: TObject);
  procedure btnColorClick(Sender: TObject);
 private
  { Private declarations }
 public
  { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.btnFontClick(Sender: TObject);
begin
 if FontDialog1.Execute then
  Memo1.Font.Assign(FontDialog1.Font);
end;

procedure TForm1.btnColorClick(Sender: TObject);
begin
 if ColorDialog1.Execute then
  Memo1.Color := ColorDialog1.Color;
end;

end.

As you can see, the source code for the application is almost insignificant. Figure 4.8 shows MemoDemo's main form at runtime.

Figure 4.8
MemoDemo isn't much, but it's a good starting point.

Enter some text into the memo. Click the Font button to change the font used in the memo, or the Color button to change the background color of the memo.

Adding an Automation Object

Now that you've seen MemoDemo—which isn't going to win any industry awards, I'm afraid—let's see what's required to add automation capabilities to it.

One of the most important things you can do when adding automation to an existing application is make use of the code that's already in the application. Ideally, the bodies of your automation methods should contain exactly one line of code, which is a call to an already existing function in your main application.

If you're writing a new application with automation in mind, it's not difficult to take this fact into account from the beginning. However, suppose automation was the farthest thing from my mind when I wrote MemoDemo. The fastest and easiest way to prepare for automation is to add the necessary support functions to the application first. For example, for MemoDemo, we want to be able to read and control the font, color, and text of the memo from another application. To state the obvious, we're going to want to add methods GetColor, SetColor, GetFont, SetFont, GetText, and SetText to the main form object. Listing 4.3 shows the result of these straightforward additions.

Listing 4.3  MemoSrv Application—MainForm.pas

unit MainForm;

interface

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

type
 TForm1 = class(TForm)
  Memo1: TMemo;
  btnFont: TButton;
  btnColor: TButton;
  FontDialog1: TFontDialog;
  ColorDialog1: TColorDialog;
  procedure btnFontClick(Sender: TObject);
  procedure btnColorClick(Sender: TObject);
 private
  { Private declarations }
 public
  { Public declarations }
  function GetColor: TColor;
  procedure SetColor(AColor: TColor);
  function GetFont: TFont;
  procedure SetFont(AFont: TFont);
  function GetText: TStrings;
  procedure SetText(AText: TStrings);
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.btnFontClick(Sender: TObject);
begin
 if FontDialog1.Execute then
  Memo1.Font.Assign(FontDialog1.Font);
end;

procedure TForm1.btnColorClick(Sender: TObject);
begin
 if ColorDialog1.Execute then
  Memo1.Color := ColorDialog1.Color;
end;

procedure TForm1.SetColor(AColor: TColor);
begin
 Memo1.Color := AColor;
end;

procedure TForm1.SetFont(AFont: TFont);
begin
 Memo1.Font.Assign(AFont);
end;

procedure TForm1.SetText(AText: TStrings);
begin
 Memo1.Lines.Assign(AText);
end;

function TForm1.GetColor: TColor;
begin
 Result := Memo1.Color;
end;

function TForm1.GetFont: TFont;
begin
 Result := Memo1.Font;
end;

function TForm1.GetText: TStrings;
begin
 Result := Memo1.Lines;
end;

end.

Now that the main form supports the access functions we need, it's time to add the automation object to MemoSrv. Select File, New from the Delphi main menu. Click the ActiveX tab of the Object Repository, and select Automation Object. Call the object MemoIntf, and click OK. Delphi creates a new source file for MemoIntf and displays the Type Library Editor.

We're going to add three properties to the type library: Color, Font, and Text.

1. Click the New Property button. If a popup menu is displayed, select Read, Write from the menu. Name the property Color, and set the Type to OLE_COLOR.

2. Add a read/write property named Font, and set the Type to IFontDisp. You won't find IFontDisp in the drop-down list of types, but the Type Library Editor will accept the declaration if you type it in.

3. Add a read/write property named Text, and set the Type to IStrings.

4. Click the Refresh Implementation button and close the Type Library Editor.

5. Save the source file as MemoIntf.pas.

6. Add ActiveX, StdVCL, and AxCtrls to the uses clause of the interface section of the unit, as these units define IFont, IStrings, and the GetOLEXxx procedures respectively.

7. Add MainForm to the uses clause of the implementation section.

8. Flesh out each of the methods in MemoIntf so that they call the corresponding TForm1 methods (see Listing 4.4).

You can now compile the program. Run it once to register the automation server with the Windows registry, and quit the application.

---

Note - Remember that out-of-process COM servers are registered with the Windows Registry every time you run them. To register an out-of-process server without actually running the application, you could run MemoSrv.exe /regserver. To unregister the server, run MemoSrv.exe /unregserver.

---

The source code for MemoIntf is shown in Listing 4.4.

Listing 4.4  MemoSrv Application—MemoIntf.pas

unit MemoIntf;

interface

uses
 ComObj, ActiveX, AXCtrls, StdVCL, MemoSrv_TLB;

type
 TMemoIntf = class(TAutoObject, IMemoIntf)
 protected
  function Get_Color: OLE_COLOR; safecall;
  procedure Set_Color(Value: OLE_COLOR); safecall;
  function Get_Font: IFontDisp; safecall;
  function Get_Text: IStrings; safecall;
  procedure Set_Font(const Value: IFontDisp); safecall;
  procedure Set_Text(const Value: IStrings); safecall;
  { Protected declarations }
 end;

implementation

uses ComServ, MainForm;

function TMemoIntf.Get_Color: OLE_COLOR;
begin
 Result := Form1.GetColor;
end;

procedure TMemoIntf.Set_Color(Value: OLE_COLOR);
begin
 Form1.SetColor(Value);
end;

function TMemoIntf.Get_Font: IFontDisp;
begin
 GetOleFont(Form1.GetFont, Result);
end;

function TMemoIntf.Get_Text: IStrings;
begin
 GetOleStrings(Form1.GetText, Result);
end;

procedure TMemoIntf.Set_Font(const Value: IFontDisp);
begin
 SetOleFont(Form1.GetFont, Value);
end;

procedure TMemoIntf.Set_Text(const Value: IStrings);
begin
 SetOleStrings(Form1.GetText, Value);
end;

initialization
 TAutoObjectFactory.Create(ComServer, TMemoIntf, Class_MemoIntf,
  ciMultiInstance, tmApartment);
end.

Building an Automation Client

Now that we have an application to automate, we're going to concentrate on writing a client application that automates it.

In most cases, when you want to use an Automation server, you won't have any source code for the interfaces that are provided by that server. In this book, we've written both the servers and the clients, so the source code was readily available to us. What if some other programmer had written MemoSrv?

I'm going to show you how you can import a type library into Delphi and have it automatically recreate the necessary source code for you.

Create a new Delphi application, and then select Project, Import Type Library from the Delphi main menu. You'll see the screen shown in Figure 4.9.

Figure 4.9
Importing a type library.

Scroll down through the list until you find MemoSrv (Version 1.0). If it does not appear in the list, click the Add... button, and select the file MemoSrv.exe from whatever directory it is installed in on your hard drive.

Highlight MemoSrv (Version 1.0) and click the OK button. Delphi will generate an import library named MemoSrv_TLB.pas for the MemoSrv Automation server. By default, the file will be placed in the Imports directory on your hard driver. If you installed Delphi with the default configuration, this directory will be C:\Program Files\Borland\DelphiX\Imports, where DelphiX represents the version of Delphi that you're using (Delphi4, Delphi5, and so on). Listing 4.5 shows the imported MemoSrv type library.

Listing 4.5  MemoCli Application—MemoSrv_TLB.pas

unit MemoSrv_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 10:50:09 AM from Type Library described below.

// ************************************************************************ //
// Type Lib: J:\Book\samples\Chap04\MemoSrv\MemoSrv.exe
// IID\LCID: {A1E420C7-F75F-11D2-B3B9-0040F67455FE}\0
// Helpfile: 
// HelpString: MemoSrv 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_MemoSrv: TGUID = '{A1E420C7-F75F-11D2-B3B9-0040F67455FE}';
 IID_IMemoIntf: TGUID = '{A1E420C8-F75F-11D2-B3B9-0040F67455FE}';
 CLASS_MemoIntf: TGUID = '{A1E420CA-F75F-11D2-B3B9-0040F67455FE}';
type

// *********************************************************************//
// Forward declaration of interfaces defined in Type Library      //
// *********************************************************************//
 IMemoIntf = interface;
 IMemoIntfDisp = dispinterface;

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


// *********************************************************************//
// Interface: IMemoIntf
// Flags:   (4416) Dual OleAutomation Dispatchable
// GUID:   {A1E420C8-F75F-11D2-B3B9-0040F67455FE}
// *********************************************************************//
 IMemoIntf = interface(IDispatch)
  ['{A1E420C8-F75F-11D2-B3B9-0040F67455FE}']
  function Get_Color: OLE_COLOR; safecall;
  procedure Set_Color(Value: OLE_COLOR); safecall;
  function Get_Font: IFontDisp; safecall;
  procedure Set_Font(const Value: IFontDisp); safecall;
  function Get_Text: IStrings; safecall;
  procedure Set_Text(const Value: IStrings); safecall;
  property Color: OLE_COLOR read Get_Color write Set_Color;
  property Font: IFontDisp read Get_Font write Set_Font;
  property Text: IStrings read Get_Text write Set_Text;
 end;

// *********************************************************************//
// DispIntf: IMemoIntfDisp
// Flags:   (4416) Dual OleAutomation Dispatchable
// GUID:   {A1E420C8-F75F-11D2-B3B9-0040F67455FE}
// *********************************************************************//
 IMemoIntfDisp = dispinterface
  ['{A1E420C8-F75F-11D2-B3B9-0040F67455FE}']
  property Color: OLE_COLOR dispid 2;
  property Font: IFontDisp dispid 1;
  property Text: IStrings dispid 3;
 end;

 CoMemoIntf = class
  class function Create: IMemoIntf;
  class function CreateRemote(const MachineName: string): IMemoIntf;
 end;

implementation

uses ComObj;

class function CoMemoIntf.Create: IMemoIntf;
begin
 Result := CreateComObject(CLASS_MemoIntf) as IMemoIntf;
end;

class function CoMemoIntf.CreateRemote(const MachineName: string): IMemoIntf;
begin
 Result := CreateRemoteComObject(MachineName, CLASS_MemoIntf) as IMemoIntf;
end;

end.

Add MemoSrv_TLB to the uses clause of your main form, and compile to make sure that Delphi found the import unit. If you get a compile error when trying to compile MemoSrv_TLB, check your Environment Options to make sure that $(Delphi)\Imports is in the library path (see Figure 4.10).

Figure 4.10
Make sure $(DELPHI)\Imports is in your list of library paths.

Now we can write the code that interfaces to the MemoSrv Automation server. Because we're using interfaces, the code to connect to and disconnect from the server is old hat.

procedure TForm1.btnConnectClick(Sender: TObject);
begin
 FMemo := CoMemoIntf.Create;
end;

procedure TForm1.btnDisconnectClick(Sender: TObject);
begin
 FMemo := nil;
end;

We'll also add three buttons to the main form for setting the font, color, and text of the remote memo. As I indicated earlier in the section "Marshaling and Automation Types," Delphi provides support for marshaling fonts, string lists, and pictures. This makes the amount of code we have to write trivial.

procedure TForm1.btnSetFontClick(Sender: TObject);
var
 FontDisp: IFontDisp;
begin
 if FontDialog1.Execute then begin
  Memo1.Font.Assign(FontDialog1.Font);

  GetOleFont(FontDialog1.Font, FontDisp);
  FMemo.Set_Font(FontDisp);
 end;
end;

GetOleFont is a Delphi procedure that "converts" a TFont object into an IFontDisp interface, suitable for passing across process boundaries. Similarly, GetOleStrings can create an IStrings interface from a TStrings object.

Listing 4.6 shows the complete source code for the client application.

Listing 4.6  MemoCli Application—MainForm.pas

unit MainForm;

interface

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

type
 TForm1 = class(TForm)
  btnSetColor: TButton;
  btnConnect: TButton;
  btnSetFont: TButton;
  btnSetText: TButton;
  btnDisconnect: TButton;
  btnGetColor: TButton;
  btnGetFont: TButton;
  btnGetText: TButton;
  Memo1: TMemo;
  FontDialog1: TFontDialog;
  ColorDialog1: TColorDialog;
  procedure btnConnectClick(Sender: TObject);
  procedure btnDisconnectClick(Sender: TObject);
  procedure btnSetColorClick(Sender: TObject);
  procedure btnSetFontClick(Sender: TObject);
  procedure btnSetTextClick(Sender: TObject);
  procedure btnGetColorClick(Sender: TObject);
  procedure btnGetFontClick(Sender: TObject);
  procedure btnGetTextClick(Sender: TObject);
 private
  { Private declarations }
  FMemo: IMemoIntf;
 public
  { Public declarations }
 end;

var
 Form1: TForm1;

implementation

uses
 ActiveX, AXCtrls, StdVCL;

{$R *.DFM}

procedure TForm1.btnConnectClick(Sender: TObject);
begin
 FMemo := CoMemoIntf.Create;
end;

procedure TForm1.btnDisconnectClick(Sender: TObject);
begin
 FMemo := nil;
end;

procedure TForm1.btnSetColorClick(Sender: TObject);
begin
 if ColorDialog1.Execute then begin
  Memo1.Color := ColorDialog1.Color;
  FMemo.Set_Color(ColorToRGB(ColorDialog1.Color));
 end;
end;

procedure TForm1.btnSetFontClick(Sender: TObject);
var
 FontDisp: IFontDisp;
begin
 if FontDialog1.Execute then begin
  Memo1.Font.Assign(FontDialog1.Font);

  GetOleFont(FontDialog1.Font, FontDisp);
  FMemo.Set_Font(FontDisp);
 end;
end;

procedure TForm1.btnSetTextClick(Sender: TObject);
var
 Strings: IStrings;
begin
 GetOleStrings(Memo1.Lines, Strings);
 FMemo.Set_Text(Strings);
end;

procedure TForm1.btnGetColorClick(Sender: TObject);
begin
 Memo1.Color := FMemo.Get_Color;
end;

procedure TForm1.btnGetFontClick(Sender: TObject);
var
 FontDisp: IFontDisp;
begin
 FontDisp := FMemo.Get_Font;
 SetOleFont(Memo1.Font, FontDisp);
end;

procedure TForm1.btnGetTextClick(Sender: TObject);
var
 Strings: IStrings;
begin
 Strings := FMemo.Get_Text;
 SetOleStrings(Memo1.Lines, Strings);
end;

end.

Figure 4.11 shows the MemoCli application connected to MemoSrv.

Figure 4.11
MemoCli controls the MemoSrv Automation server.

To recap this example, we performed the following steps to create an automation client:

• Create a new application.

• Import the automation server's type library.

• Add the import file to the client application's uses clause.

• Make method calls to the automation server.

At this point, we've covered the basics of automation. You now know how to create an Automation server, and how you can control that server using interfaces, dispinterfaces, and variants. In the next section, I'll discuss a more advanced feature of automation: COM events and callbacks.