delphi - 从 TAutoObject 返回 TAutoIntfObject 实例

Question

我正在创建一个 COM 服务器，以允许第三方程序自动化我的程序。鉴于我需要传递具有大量属性的对象，我正在尝试创建方法来创建此类对象以供客户端使用。

(这样做的目的是允许客户端程序创建可以传递回主 COM 对象中其他函数的文档；这些文档对象包含许多没有实际功能的属性。)

给定以下类(class):

编辑:我现在在返回函数上使用TAutoObject，但只是因为我想减少做意外事情的机会 - 代码主要是生成的通过 Delphi 向导“新自动化对象”。

编辑 2:直接从消费程序创建 Bar 对象与该程序完美配合，但这并不理想，因为在很多情况下我想创建一个对象作为来自用户发起的操作。

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(消费应用程序)

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();
        }
    }
}

我可以从客户端程序创建 TFoo 对象，但是当我调用 NewBar 时，一旦它返回，我就会遇到访问冲突。

这是从 COM 函数返回 COM 对象的正确方法吗？

Answer 1

嗯，答案似乎就在 RIDL 代码中:

HRESULT _stdcall NewBar([out, retval] IBar* Res);

我只需将其更改为使用双指针:

HRESULT _stdcall NewBar([out, retval] IBar** Res);

我通过阅读这份令人难以置信的简洁文档得到了这个答案: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;

如果您正在考虑进行一些 COM 编程，请务必首先阅读 his site 中的所有文章。 .