Returning TAutoIntfObject instance from TAutoObjec

2019-07-18 05:52发布

问题:

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.

FooTest.ridl

// ************************************************************************ //
// 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;
  };

};

FooTest_TLB

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.

Foos.pas

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.

Bars.pas

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.

Form1.cs (consuming application)

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?

回答1:

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.