Пример использования объектного интерфейса из Delphi

// вызовы объектных интерфейсов из предыдущего раздела
// описания интерфейсов получаются из tlb

program TestCOM;

uses activeX, sysutils, windows;

type

  IAtlantisAppSrv = interface(IDispatch)
	['{13AAEF50-CE08-11D5-A27B-00204CE40998}']
	function  Connect(const uName: WideString; const uPass: WideString): HResult; stdcall;
	function  ExecVip(const Name: WideString; argc: Integer; var argv: OleVariant; 
					out aRetVal: Integer): HResult; stdcall;
	function  LoadVip(const Name: WideString; out ifc: IDispatch): HResult; stdcall;
  end;

  IAtlantisAppSrvDisp = dispinterface
	['{13AAEF50-CE08-11D5-A27B-00204CE40998}']
	procedure Connect(const uName: WideString; const uPass: WideString); dispid 100;
	function  ExecVip(const Name: WideString; argc: Integer; var argv: OleVariant): Integer; dispid 101;
	function  LoadVip(const Name: WideString): IDispatch; dispid 102;
  end;

  MainObj = interface(IUnknown)
	['{9637AC80-F2EC-11D5-A2C6-00204CE40998}']
	function  TestFunc(p1: Integer; p2: Integer; out aRetVal: Integer): HResult; stdcall;
	function  TestProc(var p1: WideString; out aRetVal: WideString): HResult; stdcall;
	function  TestProc2(p1: Double; var p2: Double): HResult; stdcall;
	function  getComp(out aRetVal: Int64): HResult; stdcall;
	function  CompHandl(c1: Int64; var c2: Int64): HResult; stdcall;
	function  Get_TestProp(out aRetVal: WideString): HResult; stdcall;
	function  Set_TestProp(const aRetVal: WideString): HResult; stdcall;
	function  Get_TestProp2(out aRetVal: Integer): HResult; stdcall;
  end;

  MAINREC = packed record
	f1: Integer;
	f2: WideString;
	f3: Smallint;
  end;

  MainObj2 = interface(IUnknown)
	['{B1A1C670-F3BF-11D5-A2C7-00204CE40998}']
	function  TestRec(var r: MAINREC): HResult; stdcall;
	function  TestRec2(r: MAINREC): HResult; stdcall;
  end;

  MainObj4 = interface;
  MainObj3 = interface(IUnknown)
	['{B1A1C671-F3BF-11D5-A2C7-00204CE40998}']
	function  TestObjRef(out aRetVal: MainObj2): HResult; stdcall;
	function  TestVipRef(out aRetVal: IDispatch): HResult; stdcall;
	function  TestRef(out aRetVal: MainObj4): HResult; stdcall;
	function  TestCallRef(const ref: MainObj4; out aRetVal: Integer): HResult; stdcall;
  end;

  MainObj4 = interface(IUnknown)
	['{B1A1C672-F3BF-11D5-A2C7-00204CE40998}']
	function  Test4(p1: Integer; p2: Integer; out aRetVal: Integer): HResult; stdcall;
  end;

  IAtlantisApp = IAtlantisAppSrv;
  IAtlantisIfc = IDispatch;

const IID_IAtlantisAppSrv  : TIID = '{13AAEF50-CE08-11d5-A27B-00204CE40998}';
const CLSID_AtlantisAppSrv : TIID = '{2C4CF260-DAA2-11d5-A29D-00204CE40998}';
const LIBID_DebugLib : TGUID = '{9637AC81-F2EC-11D5-A2C6-00204CE40998}';
const IID_MainObj	: TGUID = '{9637AC80-F2EC-11D5-A2C6-00204CE40998}';
const IID_MainObj2   : TGUID = '{B1A1C670-F3BF-11D5-A2C7-00204CE40998}';
const IID_MainObj3   : TGUID = '{B1A1C671-F3BF-11D5-A2C7-00204CE40998}';
const IID_MainObj4   : TGUID = '{B1A1C672-F3BF-11D5-A2C7-00204CE40998}';

var
  hr : HRESULT;
  pIAtlantisApp : IAtlantisApp;
  pIAtlantisIfc : IAtlantisIfc;
  vPar : WideString;
  p : OleVariant;
  ret : longint;
  pMainObj : MainObj;
  pMainObj2 : MainObj2;
  pMainObj3 : MainObj3;
  pMainObj4 : MainObj4;
  d : double;
  s : WideString;
  c1,c2 : int64;
  rec : MAINREC;

label quit;

begin
 pIAtlantisApp := nil;
 pIAtlantisIfc := nil;
 hr := CoInitialize (nil);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;

 hr := CoCreateInstance (CLSID_AtlantisAppSrv,
						 nil, CLSCTX_LOCAL_SERVER,
						 IID_IAtlantisAppSrv,
						 pIAtlantisApp);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;

 hr := pIAtlantisApp.Connect ('aa','aa');
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;

 p := 5;
 hr := pIAtlantisApp.ExecVip ('aTestVip',1,p,ret);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;
 WriteLn ('Result = ',ret);

 hr := pIAtlantisApp.LoadVip ('aTestVip',pIAtlantisIfc);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;

 hr := pIAtlantisIfc.QueryInterface (IID_MainObj,pMainObj);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;

 hr := pMainObj.TestFunc (2,5,ret);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;
 writeln ('result = ', ret);

 s := 'QQ';
 hr := pMainObj.TestProc (s,vPar);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;
 writeln ('result = ', vPar, '; ', s);

 hr := pMainObj.TestProc2 (2.5,d);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;
 writeln ('result = ', d);

 hr := pMainObj.get_TestProp (vPar);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;
 writeln ('result = ', vPar);

 hr := pMainObj.set_TestProp (vPar);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;

 hr := pMainObj.get_TestProp2 (ret);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;
 writeln ('result = ', ret);

 hr := pMainObj.getComp (c1);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;
 writeln ('result = ', c1);

 c1 := 12;
 c2 := 17;
 hr := pMainObj.CompHandl (c1,c2);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;
 writeln ('result = ', c2);

 hr := pIAtlantisIfc.QueryInterface (IID_MainObj3,pMainObj3);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;

 hr := pMainObj3.TestObjRef (pMainObj2);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;

 rec.f1 := 5;
 rec.f2 := 'record';
 rec.f3 := 7;
 hr := pMainObj2.TestRec (rec);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;

 hr := pMainObj2.TestRec2 (rec);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;

 hr := pMainObj3.TestRef (pMainObj4);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;

 hr := pMainObj4.Test4 (1,2,ret);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;
 writeln ('result = ', ret);

 hr := pMainObj3.TestCallRef (pMainObj4,ret);
 WriteLn (intToHex (hr,8));
 if hr <> 0 then goto quit;
 writeln ('result = ', ret);

quit : 
 pMainObj	:= nil;
 pMainObj2	 := nil;
 pMainObj3	 := nil;
 pMainObj4	 := nil;
 pIAtlantisIfc := nil;
 pIAtlantisApp := nil;
 CoUninitialize;
end.