What is the best way to have an automation object behave in the way
described by the Singleton pattern?
In other words, what is the best way to make sure that there is only one
globaly accessible instance of a given automation object?

Thanks in advance

_________________________________
Angelos Arampatzis
Medis S.A., Thessaloniki, Greece
agge...@cteam.the.forthnet.gr

The minimum could be defined as the perfection that an artifact achieves
when it is no longer possible to improve it by subtraction.
This is the quality that an object has when every component, every detail,
and every junction has been reduced or condensed to the essentials.
It is the result of the omission of the inessentials.

Make your own factory (you need to subclass TAutoObjectFactory and reimplement
IClassFactoy2.CreateInstanceLic).

Dr. Delphi

It can be done this way, Binh Ly's excellent site
(http://www.techvanguards.com/) has some sample code for doing so.  However,
from experience (it can become unreliable) I'd recommend a different
approach....

Don't attempt to make the actual automation object a singleton.  Instead,
delegate all properties and method calls in your automation object to a
conventional Delphi object which has been implemented as a singleton - there
are a number of Delphi inplementations of this pattern around.

unit MyAutoObject;

TMyAutoObject = class(TAutoObject, IMyAutoInterface)
public
   function Method1 : HResult;
end;

function TMyAutoObject .Method1 : HResult
begin
    Result := MyDelphiObject.Method1;
end;

initialization
TAutoObjectFactory.Create(ComServer, TMyAutoObject, Class_MyAutoObject,
    ciMultiInstance, tmFree);

unit MyDelphiObject;

TMyDelphiObject = class(TObject); {implement this class as singleton}
public
   function Method1 : HResult;
end;

function TMyAutoObject .Method1 : HResult
begin
    Result := {do stuff};
end;

With this approach each client will create a new instance of TMyAutoObject
but since there will be just one instance of TMyDelphiObject which they all
delegate their methods to, all clients will share the same data.

Andrew

news:38610611.9D180C09@netfever.com...

You may also need to implement CreateInstance in your subclass.

Here is a sample:
uses
  ComObj, ActiveX, AxCtrls, Classes, SysUtils;

type
  TMicrosEMStorageFactory = class(TAutoObjectFactory, IClassFactory,
IClassFactory2)
  private
    FSingleton: TComObject;
  protected
   function CreateInstanceLic(const unkOuter: IUnknown; const unkReserved:
IUnknown;
    const iid: TIID; const bstrKey: WideString; out vObject): HResult;
stdcall;
   function CreateInstance(const UnkOuter: IUnknown;
    const IID: TGUID; out Obj): HResult; stdcall;
  public
   destructor Destroy; override;
   constructor Create(ComServer: TComServerObject; AutoClass: TAutoClass;
     const ClassID: TGUID; Instancing: TClassInstancing;
     ThreadingModel: TThreadingModel = tmSingle);

  end;

implementation

uses Windows, ComServ, ComConst, uEMCommonUtility, SubscriptionEngine_TLB,
EMMessage_TLB;

{---------------------------------------------------------------------------
--}
constructor TMicrosEMStorageFactory.Create(ComServer: TComServerObject;
  AutoClass: TAutoClass; const ClassID: TGUID;
  Instancing: TClassInstancing; ThreadingModel: TThreadingModel);
begin
  inherited Create(ComServer, AutoClass, ClassID, Instancing,
ThreadingModel);
  FSingleton := nil;
end;

{---------------------------------------------------------------------------
--}
destructor TMicrosEMStorageFactory.Destroy;
begin
  FSingleton := nil;
  inherited;
end;

function TMicrosEMStorageFactory.CreateInstance(const UnkOuter: IUnknown;
  const IID: TGUID; out Obj): HResult;
begin
  Result := CreateInstanceLic(UnkOuter, nil, IID, '', Obj);
end;

{---------------------------------------------------------------------------
--}
function TEMStorageFactory.CreateInstanceLic(const unkOuter: IUnknown;
  const unkReserved: IUnknown; const iid: TIID; const bstrKey: WideString;
  out vObject): HResult; stdcall;
begin
  // We can't write to a nil pointer.  Duh.
  if @vObject = nil then
  begin
    Result := E_POINTER;
    Exit;
  end;
  // In case of failure, make sure we return at least a nil interface.
  Pointer(vObject) := nil;
  // Check for licensing.
  if SupportsLicensing and
    ((bstrKey <> '') and (not ValidateUserLicense(bstrKey))) or
    ((bstrKey = '') and (not HasMachineLicense)) then
  begin
    Result := CLASS_E_NOTLICENSED;
    Exit;
  end;
  // We can only aggregate if they are requesting our IUnknown.
  if (unkOuter <> nil) and not (IsEqualIID(iid, IUnknown)) then
  begin
    Result := CLASS_E_NOAGGREGATION;
    Exit;
  end;

  try
    if (FSingleton = nil) then begin
      FSingleton := CreateComObject(UnkOuter);
  {need to increment reference or it will be destroyed in
TComObject.ObjRelease}
      FSingleton.ObjAddRef;
      end;

  except
    if ShowErrors and (ExceptObject is Exception) then
      with Exception(ExceptObject) do
      begin
        if (Message <> '') and (AnsiLastChar(Message) > '.') then
          Message := Message + '.';
        MessageBox(0, PChar(Message), PChar(SDAXError), MB_OK or MB_ICONSTOP
or
          MB_SETFOREGROUND);
      end;
    Result := E_UNEXPECTED;
    Exit;
  end;

  Result := FSingleton.ObjQueryInterface(IID, vObject);
  if FSingleton.RefCount = 0 then FSingleton.Free;
end;

Angelos,

Following is the text I posted a while ago, you might find it useful:

---------------

...................The two techniques you mentioned should work. However,
the monikers approach
would be hard to implement (unless you are using NT SP4 which added a rather
cool OBJREF moniker), and the class factory approach suffers from two
problems: (1) it violates the semantics of CreateInstance (2) it cannot be
used by script languages, which usually cannot access the class factories.

The approach that works for me is the following:

- Implement the COM server as a out-of-process (EXE) server. Let's call the
CoClass MyServer, and the interface IMyServer.
- In the SAME EXE, implement an additional object, similar to what I
described in my post. Let's call it MyServerAccess + IMyServerAccess.
- The implementation of IMyServerAccess.GetMyServer is as follows
(pseudu-code):

var
  global-my-server: IMyServer = nil;

function IMyServerAccess.GetMyServer: IMyServer;
begin
  enter critical section;
  try
    if global-my-server = nil then
    begin
        global-my-server := TMyServer.Create;
    end;
    Result := global-my-server;
  leave
     leave critical section;
  end;
end;

The clients would use it in the following manner:

MyServerAccess := CoMyServerAccess.CreateRemote(my-server-name)
MyServer := MyServerAccess.GetMyServer;

The lifespan of the access object is very short - once the server interface
is retrieved, the access interfaced is released and the object is destroyed.

Because the Access object and the server object are in the same server, the
reference to the server interface can be kept in a global variable, which is
why there is no need for Running Objects Table or other machine-wide
mechanisms.

Note that the actual implementation is a bit more complicated, because of
COM apartment rules. You cannot just store the MyServer interface in
global-my-server and access it freely, since each of the MyServerAccess
might be created and activated in a different thread. Instead, you should
marshal the interface on creation,  and unmarshall it with each call to
GetMyServer. If your server is running on NT SP3, you can use the Global
Interface Table (a process-wide list of interfaces) to do that, otherwise,
you should use the CoMarshalInterThreadInterfaceInStream API. So here's a
better version of the above GetMyServer:

enter critical section;
try
  if (global-my-server-cookie = 0) then
  begin
    temp := TMyServer.Create;
    global-my-server-cookie := marhsal-interface(temp);
  end;
  result := unmarhshal-interface(global-my-server-cookie);
finally
  leave critical section
end;

Etc.

If you need it, I can post the code that handles the switching between the
GlobalInterfaceTable and the CoMarshalInterThreadInterfaceInStream API
automatically.

------------------------

I hope this helps,

Yaniv Golan
ygo...@netvision.net.il

news:83qn92$8d710@forums.borland.com...