从TAutoObject返回TAutoIntfObject实例

时间:2014-08-13 23:18:39

标签: delphi com delphi-xe

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

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

鉴于以下类别:

编辑:我现在正在使用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对象的正确方法吗?

1 个答案:

答案 0 :(得分:2)

好吧,似乎答案在于RIDL代码:

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

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

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

我通过阅读这个令人难以置信的简洁文档得到了这个答案:Building COM Components by Binh Ly

  

请注意,接口指针是指向vtable的指针。因此,他们   在IDL中用至少1个间接级别表示   星号(*)符号。将接口指针定义为[out] params时,   我们还需要另外一个间接级别。从而:   

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中的所有文章。