== Develop COM Components and Automation ==

== Automation Server ==

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. <code delphi>
procedure TMySvr.Initialize;
begin
  inherited;

  AnObj := TMyCustomClass.Create;
end;
</code>

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:<code delphi>
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
  if not Assigned(svr) then begin
    svr := CoMySvr.Create();
  end;
  if Assigned(svr) then begin
    btnGetSvrVersion.Enabled := True;
  end else begin
    btnGetSvrVersion.Enabled := False;
  end;
end;

end.

</code>

== Wrapping an Existing Application Functionality in an Automation Object ==
Especially use this method for Out-of-process automation servers:
 * 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:
    * In-process (DLL) automation server:
      * 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.
      * Register from command line: <code>C:\> regsvr32 myServer.dll </code> or <code>C:\> tregsvr myServer.dll</code>
    * Out-of-process (EXE) automation server:
      * To register, run this from command line: <code>C:\> myapp.exe /regserver </code>
      * To unregister, run this from command line: <code>C:\> myapp.exe /unregserver </code>

== Linking Multiple Clients to a Single Instance of a COM Object ==
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):
<code delphi>
//-----------------------------------------------------------------------------
// 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;
</code>

Client code to call the same object instance as the first client that created it:
<code delphi>
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;
</code>

== Working with SafeArray ==
=== Create a SafeArray ===
<code delphi>
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;
</code>
=== Read a SafeArray ===
<code delphi>
//-----------------------------------------------------------------------------
// 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;
  sfArrData: pointer;
  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
  if SafeArrayAccessData( sfArr, sfArrData ) = S_OK then begin
    for i := LBound to UBound do begin
        ElemData := TIntegerArray(sfArrData)[i];              // get data from safearray
        str := str + format('sfArr[%d] = %d'+#13#10, [i, ElemData]); // save it for later
    end;
  end;
  SafeArrayUnAccessData(sfArr);
  ShowMessage(str);
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'+#13#10, [i, ElemData]); // get data from safearray and print it
  end;
  ShowMessage(str);
end;
</code>

Example of how to convert a safearray to an integer array:
<code delphi>
//-----------------------------------------------------------------------------
// description: Convert from SafeArray to integer array.
// parameters : sfArr: PSafeArray
// return     : TIntegerArray (array of Integer)
//-----------------------------------------------------------------------------
function SafeArrayToIntArr(sfArr: PSafeArray): TIntegerArray;
var
  LBound, UBound: integer;
  sfArrData: pointer;
  i: 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, sfArrData ) = S_OK then begin
    for i:= LBound to UBound do begin
       arr[i] := TIntegerArray(sfArrData)[i];
    end;
    SafeArrayUnAccessData(sfArr);
  end;

  result := Arr;
end;
</code>

=== Write to a SafeArray ===
<code delphi>
//-----------------------------------------------------------------------------
// 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, UBound: integer;
  sfArrData: pointer;
begin
  // get PSafeArray boundaries
  SafeArrayGetLBound(sfArr, 1, LBound);
  SafeArrayGetUBound(sfArr, 1, UBound);

  // 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;
</code>

Example of converting from integer array to safearray:
<code delphi>
//-----------------------------------------------------------------------------
// 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;
</code>

== References ==
 * [[http://www.gekko-software.nl/Delphi/|Delphi and COM]] - Gekko Software
 * [[http://edn.embarcadero.com/article/27126|Writing COM Automation Events]] - Embarcadero
 * [[http://www.delphi3000.com/articles/article_2479.asp?SK=|How to do SafeArray access]] - Delphi3000
 * [[http://blog.virtec.org/category/delphi/|The Mysteries of PSafeArray]] - Virtech.org
 * [[http://msdn2.microsoft.com/en-us/library/ms221145.aspx|MSDN Safearray Manipulation Functions]] - Microsoft MSDN
 * [[http://www.gekko-software.nl/Delphi/art08.htm|Automation Arrays (Safearray, Variant arrays)]] - Gekko Software
 * [[http://www.gekko-software.nl/Delphi/art10.htm|Server Events for Two-way Communication]] - Gekko Software
 * [[http://www.techvanguards.com/com/|COM Tutorials and Concepts]] - TechVanguards
 * [[http://podgeretsky.com/ftp/docs/Delphi/D5/dg/autosrvr.html#3201|Delphi 5 Dev Guide: Creating an Automation Server]]