unit uDataComSrv;

interface

uses
 Launcher_TLB, Windows, ActiveX, StdVcl;

type
 TDataConnection = class(TObject, IDataConnection, IClassFactory, IUnknown)
 private
   class var FDataConnection: TDataConnection;
   class var FRegId: Integer;
   class var FTypeLib: ITypeLib;

   class procedure Initialize;
   class procedure Finalize;
 public
   function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
   function _AddRef: Integer; stdcall;
   function _Release: Integer; stdcall;

   // ClassFactory
   function CreateInstance(const unkOuter: IUnknown; const iid: TIID;
     out obj): HResult; stdcall;
   function LockServer(fLock: BOOL): HResult; stdcall;

   // DataConnection
   procedure Test(const Str: WideString); safecall;

 end;
implementation

uses ComObj, SysUtils;

{ TDataConnection }

function TDataConnection.CreateInstance(const unkOuter: IInterface;
 const iid: TIID; out obj): HResult;
begin
 Result := QueryInterface(iid, obj);
end;

class procedure TDataConnection.Finalize;
begin
 OleCheck(CoRevokeClassObject(FRegID));
 FDataConnection.Free;
end;

class procedure TDataConnection.Initialize;
begin
 FDataConnection := TDataConnection.Create;

 OleCheck(LoadTypeLibEx(PWideChar(WideString(ParamStr(0))), REGKIND_DEFAULT, FTypeLib));
 OleCheck(RegisterTypeLib(FTypeLib, PWideChar(WideString(ParamStr(0))), nil));

 OleCheck(CoRegisterClassObject(
   CLASS_DataConnection,
   FDataConnection,
   CLSCTX_LOCAL_SERVER,
   REGCLS_MULTIPLEUSE,
   FRegID
 ));
end;

function TDataConnection.LockServer(fLock: BOOL): HResult;
begin
 Result := E_NOTIMPL;
end;

function TDataConnection.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
 if GetInterface(IID, Obj) then
   Result := S_OK
 else
   Result := E_NOINTERFACE;
end;

procedure TDataConnection.Test;
begin
 MessageBoxW(GetActiveWindow, PWideChar(Str), nil, 0);
end;

function TDataConnection._AddRef: Integer;
begin
 Result := 1;
end;

function TDataConnection._Release: Integer;
begin
 Result := 1;
end;

initialization
 CoInitialize(nil);
 TDataConnection.Initialize;
finalization
 TDataConnection.Finalize;
 CoUninitialize;
end.

var
 DC: IDataConnection;
...
 OleCheck(CoCreateInstance(
   CLASS_DataConnection,
   nil,
   CLSCTX_LOCAL_SERVER,
   IID_IDataConnection,
   DC
 ));

 Dc.Test('Test text');