I'm creating a COM server to allow automation of my program by third party programs. Given that I need to pass around objects with lots of properties, I'm trying to create methods to create such objects for the clients to use.
(The intention for this is to allow client programs to create documents that can be passed back to other functions in the main COM object; these document objects contain a lot of properties with no real funcionality.)
Given the following classes:
Edit: I'm using TAutoObject
on the returning function now but just because I wanted to reduce the chances I'm doing something unexpected - the code was mainly generated by the Delphi wizard "New automation object."
Edit 2: Creating the Bar object directly from the consuming program works perfectly with this program, but that's not ideal because there are plenty of situations where I want to create an object as a response from a user-initiated action.
// ************************************************************************ //
// WARNING
// -------
// This file is generated by the Type Library importer or Type Libary Editor.
// Barring syntax errors, the Editor will parse modifications made to the file.
// However, when applying changes via the Editor this file will be regenerated
// and comments or formatting changes will be lost.
// ************************************************************************ //
// File generated on 14-08-2014 11:36:16 (- $Rev: 12980 $, 1111483734).
[
uuid(94A2B97E-553F-4A4A-9DAD-84D7C96DBEFD),
version(1.0)
]
library FooTest
{
importlib("stdole2.tlb");
interface IFoo;
coclass Foo;
interface IBar;
coclass Bar;
[
uuid(1C220E81-3794-4F09-ACA7-10D690AF4D92),
dual,
oleautomation
]
interface IFoo: IDispatch
{
[id(0x000000C9)]
HRESULT _stdcall NewBar([out, retval] IBar* Res);
};
[
uuid(B2FAD09E-58F9-43B8-95E1-5E962D1D6115),
helpstring("Dispatch interface for Bar Object"),
dual,
oleautomation
]
interface IBar: IDispatch
{
};
[
uuid(1FEB672A-3289-4CD8-BB27-8077BCE00FA8)
]
coclass Foo
{
[default] interface IFoo;
};
[
uuid(2C3B9E1F-12F4-4BD8-A047-B9DFCB60B4C9),
helpstring("Bar Object")
]
coclass Bar
{
[default] interface IBar;
};
};
unit FooTest_TLB;
// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //
// $Rev: 34747 $
// File generated on 14-08-2014 11:26:20 from Type Library described below.
// ************************************************************************ //
// Type Lib: D:\Projects\Delphi\Pruebas\OLE - StackOverflow\FooTest (1)
// LIBID: {94A2B97E-553F-4A4A-9DAD-84D7C96DBEFD}
// LCID: 0
// Helpfile:
// HelpString:
// DepndLst:
// (1) v2.0 stdole, (C:\Windows\SysWOW64\stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
{$ALIGN 4}
interface
uses Windows, ActiveX, Classes, Graphics, OleServer, StdVCL, Variants;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
FooTestMajorVersion = 1;
FooTestMinorVersion = 0;
LIBID_FooTest: TGUID = '{94A2B97E-553F-4A4A-9DAD-84D7C96DBEFD}';
IID_IFoo: TGUID = '{1C220E81-3794-4F09-ACA7-10D690AF4D92}';
CLASS_Foo: TGUID = '{1FEB672A-3289-4CD8-BB27-8077BCE00FA8}';
IID_IBar: TGUID = '{B2FAD09E-58F9-43B8-95E1-5E962D1D6115}';
CLASS_Bar: TGUID = '{2C3B9E1F-12F4-4BD8-A047-B9DFCB60B4C9}';
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IFoo = interface;
IFooDisp = dispinterface;
IBar = interface;
IBarDisp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
Foo = IFoo;
Bar = IBar;
// *********************************************************************//
// Interface: IFoo
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {1C220E81-3794-4F09-ACA7-10D690AF4D92}
// *********************************************************************//
IFoo = interface(IDispatch)
['{1C220E81-3794-4F09-ACA7-10D690AF4D92}']
function NewBar: IBar; safecall;
end;
// *********************************************************************//
// DispIntf: IFooDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {1C220E81-3794-4F09-ACA7-10D690AF4D92}
// *********************************************************************//
IFooDisp = dispinterface
['{1C220E81-3794-4F09-ACA7-10D690AF4D92}']
function NewBar: IBar; dispid 201;
end;
// *********************************************************************//
// Interface: IBar
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {B2FAD09E-58F9-43B8-95E1-5E962D1D6115}
// *********************************************************************//
IBar = interface(IDispatch)
['{B2FAD09E-58F9-43B8-95E1-5E962D1D6115}']
end;
// *********************************************************************//
// DispIntf: IBarDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {B2FAD09E-58F9-43B8-95E1-5E962D1D6115}
// *********************************************************************//
IBarDisp = dispinterface
['{B2FAD09E-58F9-43B8-95E1-5E962D1D6115}']
end;
// *********************************************************************//
// The Class CoFoo provides a Create and CreateRemote method to
// create instances of the default interface IFoo exposed by
// the CoClass Foo. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoFoo = class
class function Create: IFoo;
class function CreateRemote(const MachineName: string): IFoo;
end;
// *********************************************************************//
// The Class CoBar provides a Create and CreateRemote method to
// create instances of the default interface IBar exposed by
// the CoClass Bar. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoBar = class
class function Create: IBar;
class function CreateRemote(const MachineName: string): IBar;
end;
implementation
uses ComObj;
class function CoFoo.Create: IFoo;
begin
Result := CreateComObject(CLASS_Foo) as IFoo;
end;
class function CoFoo.CreateRemote(const MachineName: string): IFoo;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Foo) as IFoo;
end;
class function CoBar.Create: IBar;
begin
Result := CreateComObject(CLASS_Bar) as IBar;
end;
class function CoBar.CreateRemote(const MachineName: string): IBar;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Bar) as IBar;
end;
end.
unit Foos;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, FooTest_TLB, StdVcl, Bars;
type
TFoo = class(TAutoObject, IFoo)
protected
function NewBar: IBar; safecall;
end;
implementation
uses ComServ;
function TFoo.NewBar: IBar;
begin
Result := TBar.Create;
end;
initialization
TAutoObjectFactory.Create(ComServer, TFoo, Class_Foo, ciMultiInstance,
tmApartment);
end.
unit Bars;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, FooTest_TLB, StdVcl;
type
TBar = class(TAutoObject, IBar)
protected
end;
implementation
uses ComServ;
initialization
TAutoObjectFactory.Create(ComServer, TBar, Class_Bar,
ciMultiInstance, tmApartment);
end.
using FooTest;
using System;
using System.Windows.Forms;
namespace WindowsFormsApplication2
{
public partial class Form1 : Form
{
Foo foo;
public Form1()
{
InitializeComponent();
foo = new Foo();
}
private void button2_Click(object sender, EventArgs e)
{
var obj = foo.NewBar();
}
}
}
I can create from a client program the TFoo
object, but when I call NewBar
I get an access violation as soon as it returns from it.
Is this the proper way to return COM objects from COM functions?
Well, it appears that the answer lies in the RIDL code:
HRESULT _stdcall NewBar([out, retval] IBar* Res);
I just had to change it to use a double pointer:
HRESULT _stdcall NewBar([out, retval] IBar** Res);
I got to this answer by reading this incredible concise document: Building COM Components by Binh Ly:
Note that interface pointers are pointers to vtables. Therefore, they are represented in IDL with at least 1 level of indirection using the asterisk (*) symbol. When defining interface pointers as [out] params, we'll also need another extra level of indirection. Thus:
interface IEcho: IDispatch { HRESULT _stdcall YouGotMe( [out] IEcho** Param ); };
procedure TEcho.YouGotMe(out Param: IEcho); begin //return IEcho pointer to self Param := Self; end;
If you are thinking of doing some COM programming, be sure to start by reading all the articles in his site.
User contributions licensed under CC BY-SA 3.0