An Automation Server (automation object) allows the client (automation controller) to control what happens on the server.

To develop the Server:

• Setup Delphi for safecall code generation.
  • Select Tools > Options > Delphi Options > Type Library.
    • SafeCall function mapping = All v-table intefaces
    • Language: Pascal
• Create In-process Server (ActiveX DLL).
  • Select New > ActiveX > ActiveX Library.
  • Select New > ActiveX > Automation Object.
    • CoClass Name: MySvr (name to be known to the world).
    • Threading Model: Apartment.
  • Create interface and class methods and properties using the Type Library Editor.
    • Select IMySvr, then add Method or Property.
• Register the COM Server. Perform one of these:
  • Select Run > Register ActiveX Server.
  • Setup project to auto register server, to avoid littering the Windows Registry while developing.
    • Select Project > Options > Linker > Auto register type library.
• Class Constructor. For the Class, if variables or objects need to be initialized, create an Initialize method to handle the work, instead of a Create constructor. COM Objects do not use the constructor Create. The Class factory does the actual construction of your COM object so even if you declare a constructor Create, COM will ignore it when it builds your com object. Override the Initialize procedure. When your Com Object is created, and this abstract method is defined in the DLL, COM will call it right away.

  procedure TMySvr.Initialize;
  begin
    inherited;
   
    AnObj := TMyCustomClass.Create;
  end;

To develop the Client:

• Create a project with a form.
• Include the Type Library file (*.tlb) in the project, and add it to the form. If this does not exist, create it by importing the Type Library (Component > Import Component > Import a Type Library).
• Write some code to create an instance of the server (launch the server), and to communicate with it:

  unit clientMain;
   
  interface
   
  uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, MySvr_TLB;
   
  type
    TfrmClientMain = class(TForm)
      btnLaunchSvr: TButton;
      btnGetSvrVersion: TButton;
      btnClose: TButton;
      edServerVersion: TEdit;
      lblServerVersion: TLabel;
      procedure btnGetEarClick(Sender: TObject);
      procedure btnCloseClick(Sender: TObject);
      procedure btnLaunchOptimizerClick(Sender: TObject);
    private
      { Private declarations }
      svr: IMySvr;
    public
      { Public declarations }
    end;
   
  var
    frmClientMain: TfrmClientMain;
   
  implementation
   
  {$R *.dfm}
   
  procedure TfrmClientMain.btnCloseClick(Sender: TObject);
  begin
    Close;
  end;
   
  procedure TfrmClientMain.btnGetSvrVersionClick(Sender: TObject);
  begin
    edServerVersion.Text := svr.GetSvrVersion;
  end;
   
  procedure TfrmClientMain.btnLaunchSvrClick(Sender: TObject);
  begin
    svr    := CoMySvr.Create();
    if Assigned(svr) then begin
      btnGetSvrVersion.Enabled := True;
    end else begin
      btnGetSvrVersion.Enabled := False;
    end;
  end;
   
  end.

• Open an existing Delphi application project.
  • Select New > ActiveX > Automation Object.
    • CoClass Name: MySvr (name to be known to the world).
    • Threading Model: Apartment.
  • Create interface and class methods and properties using the Type Library Editor.
    • Select IMySvr, then add Method or Property.
• Register the COM Server. Perform one of these:
  • Select Run > Register ActiveX Server.
  • Setup project to auto register server, to avoid littering the Windows Registry while developing.
    • Select Project > Options > Linker > Auto register type library.

Override the AfterConstruction and BeforeDestruction methods in the interface class definition. In AfterConstruction, register the object instance so that multiple clients can lookup the object instance in the Running Object Table (ROT).

Class for Interface definition (Server Automation):

//-----------------------------------------------------------------------------
// description: Code to initialize after object construction.
// parameters : None
// return     : None
//-----------------------------------------------------------------------------
procedure TMySvr.AfterConstruction;
var
  Unknown: Iunknown;
begin
  inherited;
 
  // Operation: Register at startup of main (application) object in the
  //            so-called Running Object Table (ROT).
  // Purpose: Instead of starting a new instance, an automation client
  //          can connect to the running instance of the application using
  //          the GetActiveObject() and QueryInterface() methods.
  if (GetActiveObject(MySvr_TLB.Class_MySvr, nil, Unknown) <> MK_E_UNAVAILABLE)  then begin
    RegisterActiveObject(self as IMySvr, Class_MySvr, ACTIVEOBJECT_WEAK, cookie);  // register with Running Object Table (ROT)
    CoLockObjectExternal(self as IMySvr, true {lock}, true);                       // to prevent premature unloading
  end;
end;
 
//-----------------------------------------------------------------------------
// description: Destroy and cleanup before object destruction.
// parameters : None
// return     : None
//-----------------------------------------------------------------------------
procedure TMySvr.BeforeDestruction;
begin
  // Unregister from the Running Object Table (ROT).
  // See AfterConstruction() method for more details.
  CoLockObjectExternal(self as IMySvr, false {lock}, true); // unlock to allow unloading
  RevokeActiveObject(cookie, nil);                          // unregister from Running Object Table (ROT)
  CoDisconnectObject(self as IMySvr, 0);
 
  inherited;
end;

Client code to call the same object instance as the first client that created it:

procedure TfrmClientMain.btnLaunchMySvrClick(Sender: TObject);
var
  Unknown: Iunknown;
begin
  if not Assigned(svr) then begin
    // Check if server object is registered with Running Object Table (ROT).
    // Use the existing object instance, or create a new one of it does not exist.
    if (GetActiveObject(MySvr_TLB.Class_MySvr, nil, Unknown) = MK_E_UNAVAILABLE)  then begin
       svr := CoMySvr.Create();   // create a new one, since object does not exist in ROT
    end else begin
       Unknown.QueryInterface(MySvr_TLB.IID_IMySvr, svr);  // use obj in ROT
    end;
  end;
end;

var
  sfArrBounds: TSafeArrayBound;
  sfArrData: pointer;
  sfArr: PSafeArray;
begin
  // create safearray
  sfArrBounds.lLbound   := 0;  // lower boundary
  sfArrBounds.cElements := 12; // element count
  sfArr := SafeArrayCreate( varInteger, 1 {dimension}, sfArrBounds {lower & upper boundaries});
  ...
end;

//-----------------------------------------------------------------------------
// description: Print the contents of a safearray, using SafeArrayAccessData().
// parameters : sfArr: PSafeArray (assumed the array has been allocated already).
// return     : None
//-----------------------------------------------------------------------------
procedure PrnSafearray(sfArr: PSafeArray);
var
  LBound, UBound: integer;
  ElemData: integer;
  i: integer;
  str: string;
begin
  // get PSafeArray boundaries
  SafeArrayGetLBound(sfArr, 1, LBound);
  SafeArrayGetUBound(sfArr, 1, UBound);
 
  // read data from safearray
  str := '';
  for i := LBound to UBound do begin
    SafearrayGetElement(sfArr, i, ElemData);
    str := str + format('sfArr[%d] = %d', [i, ElemData]); // get data from safearray and print it
  end;
end;
 
 
//-----------------------------------------------------------------------------
// description: Print the contents of a safearray, using SafearrayGutElement().
// parameters : sfArr: PSafeArray (assumed the array has been allocated already).
// return     : None
//-----------------------------------------------------------------------------
procedure PrnSafearray(sfArr: PSafeArray); 
var
  LBound, UBound : integer;
  ElemData: integer;
  i: integer;
  str: string;
begin
  // get PSafeArray boundaries
  SafeArrayGetLBound(sfArr, 1, LBound);
  SafeArrayGetUBound(sfArr, 1, UBound );
 
  // read data from safearray
  str := '';
  for i := LBound to UBound do begin
    SafearrayGetElement(sfArr, i, ElemData);
    str := str + format('sfArr[%d] = %d', [i, ElemData]); // get data from safearray and print it
  end;
  ShowMessage(str);
  ...
end;

Example of how to convert a safearray to an integer array:

//-----------------------------------------------------------------------------
// description: Convert from SafeArray to integer array.
// parameters : sfArr: PSafeArray
// return     : TIntegerArray (array of Integer)
//-----------------------------------------------------------------------------
function SafeArrayToIntArr(sfArr: PSafeArray): TIntegerArray;
var
  ArrayBounds: TSafeArrayBound;
  ArrayData: pointer;
  i: integer;
  LBound, UBound: integer;
  Arr: TIntegerArray;
begin
  // Get boundaries
  SafeArrayGetLBound(sfArr, 1, LBound);
  SafeArrayGetUBound(sfArr, 1, UBound);
 
  // alloc integer array with same size as safearray
  SetLength(arr, UBound+1);
 
  // copy data from safearray to integer array
  if SafeArrayAccessData( sfArr, ArrayData ) = S_OK then begin
    for i:= LBound to UBound do begin
       arr[i] := TIntegerArray(ArrayData)[i];
    end;
    SafeArrayUnAccessData(sfArr);
  end;
 
  result := Arr;
end;

//-----------------------------------------------------------------------------
// description: Initialize a safearray to 99, using SafeArrayAccessData().
// parameters : sfArr: PSafeArray (assumed the array has been allocated already).
// return     : None
//-----------------------------------------------------------------------------
procedure InitSafearrayTo99(var sfArr: PSafeArray); 
var
  LBound, HBound: integer;
begin
  // get PSafeArray boundaries
  SafeArrayGetLBound(sfArr, 1, LBound);
  SafeArrayGetUBound(sfArr, 1, HBound);
 
  // copy data to safearray
  if SafeArrayAccessData( sfArr, sfArrData ) = S_OK then begin
    for i := LBound to UBound do begin
        TIntegerArray(sfArrData)[i] := 99; // copy data to safearray
    end;
  end;
  SafeArrayUnAccessData(sfArr);
  ...
end;
 
//-----------------------------------------------------------------------------
// description: Initialize a safearray to 99, using SafearrayPutElement().
// parameters : sfArr: PSafeArray (assumed the array has been allocated already).
// return     : None
//-----------------------------------------------------------------------------
procedure InitSafearrayTo99(var sfArr: PSafeArray); 
var
  LBound, HBound: integer;
  i: integer;
  ElemData: integer;
begin
  // get PSafeArray boundaries
  SafeArrayGetLBound(sfArr, 1, LBound);
  SafeArrayGetUBound(sfArr, 1, HBound);
 
  // copy data to safearray
  ElemData := 99;
  for i := LBound to UBound do begin
    SafearrayPutElement(sfArr, i, ElemData);
  end;
  ...
end;

Example of converting from integer array to safearray:

//-----------------------------------------------------------------------------
// description: Convert from integer array to SafeArray.
// parameters : arr: TIntegerArray (array of integer)
// return     : PSafeArray
//-----------------------------------------------------------------------------
function IntArrToPSafeArray(arr: TIntegerArray): PSafeArray; 
var
  sfArrBounds: TSafeArrayBound;
  sfArrData: pointer;
  sfArr: PSafeArray;
  i: integer;
begin
  sfArrBounds.lLbound   := Low(arr);
  sfArrBounds.cElements := High(arr)+1;
  sfArr := SafeArrayCreate( varInteger, 1, sfArrBounds );
  if SafeArrayAccessData( sfArr, sfArrData ) = S_OK then begin
    for i:= Low(arr) to High(arr) do begin
       TIntegerArray(sfArrData)[i]:= arr[i];
    end;
    SafeArrayUnAccessData(sfArr);
  end;
  result:= sfArr;
end;

• Delphi and COM - Gekko Software
• Writing COM Automation Events - Embarcadero
• How to do SafeArray access - Delphi3000
• The Mysteries of PSafeArray - Virtech.org
• MSDN Safearray Manipulation Functions - Microsoft MSDN
• Automation Arrays (Safearray, Variant arrays) - Gekko Software