常见COM问题解答

如何初始化同COM交互的线程？

通常如果没有初始化线程会显示如下的错误信号："CoInitialize has not been called" (800401F0 ) 。

问题在于每个同COM交互的线程必须使自身初始化并进入一个Apartment。可以通过加入一个单线程的 Apartment (STA)获得，也可以进入一个多线程的Apartment (MTA)。

STA是基于Windows的消息队列实现系统同步的。当COM对象或线程是依赖于线程相关的对象时，比如界面元素，就应该使用STA，下面演示如何初始化一个线程进入STA：

procedure FooThreadFunc;

Begin

CoInitializeEx (NIL, COINIT_APARTMENTTHREADED);

... ...

CoUninitialize;

end;

处于MTA的对象则可以随时随地收到用户的调用，对象同界面元素无关时应该使用MTA模式，但一定要小心地控制同步，下面是演示如何初始化一个进入MTA的线程：

procedure FooThreadFunc;

begin

CoInitializeEx (NIL, COINIT_MULTITHREADED);

... ...

CoUninitialize;

end;

实现、跨越Apartment列集接口指针

在运行COM Server时经常会遇到"The application called an interface that was marshaled for a different thread" (8001010E)这类错误，它是如何产生的呢?

在Apartment之间传递接口指针的时候,如果没有执行Marshal(列集)，就会破坏COM的线程规则，引起这个错误。列集接口指针需要使用CoMarshalInterface 和CoUnmarshalInterface函数。但实际使用时，我们更多的是用更简单的CoMarshalInterThreadInterfaceInStream 和 CoGetInterfaceAndReleaseStream API。

下面的代码演示了如何在基于不同Aparment的Foo1和Foo2线程之间列集一个接口指针：

var MarshalStream : pointer;

//源线程

procedure Foo1ThreadFunc; //或者TFoo1.Execute

var Foo : IFoo;

begin

//假设Foo2Thread正处于暂停状态

CoInitializeEx (...);

Foo := CoFoo.Create;

//列集

CoMarshalInterThreadInterfaceInStream (IFoo, Foo, IStream (MarshalStream));

//告诉Foo2Thread 列集完毕

Foo2Thread.Resume;

CoUninitialize;

end;

//用户线程

procedure Foo2ThreadFunc; //或TFoo2.Execute

var Foo : IFoo;

begin

CoInitializeEx (...);

//逆列集

CoGetInterfaceAndReleaseStream (IStream (MarshalStream), IFoo, Foo);

MarshalStream := NIL;

//使用Foo

Foo.Bar;

CoUninitialize;

end;

上面的列集技术是列集一次然后逆列集一次。如果我们想列集一次然后多次逆列集的话，可以使用(NT 4 SP3) COM提供的全局接口表（Global Interface Table，GIT）。GIT允许列集一个接口指针到一个cookie，然后使用这个Cookie来多次逆列集。使用GIT的话，上面的例子要修改为：

const

CLSID_StdGlobalInterfaceTable : TGUID =

'{00000323-0000-0000-C000-000000000046}';

type

IGlobalInterfaceTable = interface(IUnknown)

['{00000146-0000-0000-C000-000000000046}']

function RegisterInterfaceInGlobal (pUnk : IUnknown; const riid: TIID;

out dwCookie : DWORD): HResult; stdcall;

function RevokeInterfaceFromGlobal (dwCookie: DWORD): HResult; stdcall;

function GetInterfaceFromGlobal (dwCookie: DWORD; const riid: TIID; out ppv): HResult; stdcall;

end;

function GIT : IGlobalInterfaceTable;

const

cGIT : IGlobalInterfaceTable = NIL;

begin

if (cGIT = NIL) then

OleCheck (CoCreateInstance (CLSID_StdGlobalInterfaceTable, NIL, CLSCTX_ALL,

IGlobalInterfaceTable, cGIT));

Result := cGIT;

end;

var MarshalCookie : dword;

//源线程

procedure Foo1ThreadFunc;

var Foo : IFoo;

begin

CoInitializeEx (...);

Foo := CoFoo.Create;

//列集

GIT.RegisterInterfaceInGlobal (Foo, IFoo, MarshalCookie)

//告诉Foo2Thread MarshalCookie已经准备好了

Foo2Thread.Resume;

CoUninitialize;

end;

//用户线程

procedure Foo2ThreadFunc;

var Foo : IFoo;

begin

CoInitializeEx (...);

//逆列集

GIT.GetInterfaceFromGlobal (MarshalCookie, IFoo, Foo)

//调用Foo

Foo.Bar;

CoUninitialize;

end;

另外当不需要列集的时候，不要忘了从GIT中删除指针：

GIT.RevokeInterfaceFromGlobal (MarshalCookie);

MarshalCookie := 0;

下面实现了一个TGIP类可以简化调用：

{ TGlobalInterfacePointer

用法：假定有一个接口指针pObject1,想使接口Iobject1全局化可以使用下面的代码

var

GIP1: TGIP;

begin

GIP1 := TGIP.Create (pObject1, IObject1);

end;

如果想使pObject1本地化，需要直接存取GIP1 对象变量：

var

pObject1: IObject1;

begin

GIP1.GetIntf (pObject1);

pObject1.DoSomething;

end;

}

下面是TGIP类的实现：

TGIP = class

protected

FCookie: DWORD;

FIID: TIID;

function IsValid: boolean;

public

constructor Create (const pUnk: IUnknown; const riid: TIID);

destructor Destroy; override;

procedure GetIntf (out pIntf);

procedure RevokeIntf;

procedure SetIntf (const pUnk: IUnknown; const riid: TIID);

property Cookie: dword read FCookie;

property IID: TGUID read FIID;

end;

{ TGIP }

function TGIP.IsValid: boolean;

begin

Result := (FCookie <> 0);

end;

constructor TGIP.Create (const pUnk: IUnknown; const riid: TIID);

begin

inherited Create;

SetIntf (pUnk, riid);

end;

destructor TGIP.Destroy;

begin

RevokeIntf;

inherited;

end;

procedure TGIP.GetIntf (out pIntf);

begin

Assert (IsValid);

OleCheck (GIT.GetInterfaceFromGlobal (FCookie, FIID, pIntf));

end;

procedure TGIP.RevokeIntf;

begin

if not (IsValid) then Exit;

OleCheck (GIT.RevokeInterfaceFromGlobal (FCookie));

FCookie := 0;

FIID := GUID_NULL;

end;

procedure TGIP.SetIntf (const pUnk: IUnknown; const riid: TIID);

begin

Assert ((pUnk <> NIL) and not (IsEqualGuid (riid, GUID_NULL)));

RevokeIntf;

OleCheck (GIT.RegisterInterfaceInGlobal (pUnk, riid, FCookie));

FIID := riid;

end;

实现正确的错误处理

在COM中,每个接口方法必须返回一个错误代码给客户端，错误代码是标准的32位数值，也就是我们所熟悉的HRESULT。HRESULT数值可以分为几部分：一位用于表示成功或失败，几位用于表示错误分类，剩下几位用于表示错误代号（COM推荐错误代码应该在0200到FFFF 范围内。

虽然HRESULT可以用来指示错误，但是它也有很大的局限性，因为除了错误代码，我们可能还想让COM服务器告诉客户端错误的详细描述、发生位置以及客户在哪儿可以得到更多的相关帮助（通过指定帮助上下文来调用帮助文件）。因此，COM引入了IErrorInfo接口，客户端可以通过这个接口来获得额外的错误信息。同时如果COM服务器支持IErrorInfo，COM同时建议服务器实现ISupportErrorInfo接口，虽然这个接口不是必须实现的，但一些客户端，比如Visual Basic将会向服务器请求这个接口。

Delphi本身已经为我们提供了安全调用处理。当在对象内部产生一个异常时，Delphi会自动俘获异常并把它转化为一个COM HRESULT，同时提供一个IErrorInfo 接口用于传递给客户端。这些是通过ComObj单元中的HandleSafeCallException函数实现的。此外，VCL 类也为我们实现了ISupportErrorInfo 接口。

下面举例来说，当在服务器内部产生一个Ewhatever的异常时，它总会被客户端认为是EOleException异常，EOleException异常包括HRESULT 和IErrorInfo 所包含的所有信息，比如错误代号、描述、发生位置以及上下文相关帮助。而为了提供客户端所需要信息，服务器必须把EWhatever转化为EoleSysError异常，同时要确保错误代码为格式化好的HRESULT。比如，假设有一个TFoo对象，它有一个Bar方法。在Bar方法中我们想产生一个异常，异常的错误代号为5，描述="错误消息"，帮助文件="HelpFile.hlp"，帮助上下文= 1，代码示意如下：

uses ComServ;

const

CODE_BASE = $200; //推荐代码在0200 – FFFF之间

procedure TFoo.Bar;

begin

//帮助文件

ComServer.HelpFileName := 'HelpFile.hlp';

//引发异常

raise EOleSysError.Create (

'错误消息', ErrorNumberToHResult (5 + CODE_BASE), //格式化HRESULT

1 //帮助上下文

);

end;

//格式化Hresult

function ErrorNumberToHResult (ErrorNumber : integer) : HResult;

const

SEVERITY_ERROR = 1;

FACILITY_ITF = 4;

Begin

Result := (SEVERITY_ERROR shl 31) or (FACILITY_ITF shl 16) or word (ErrorNumber);

end;

上面的ErrorNumberToHResult函数就是简单的把错误代号转化为标准的HRESULT。同时给错误代号加上了CODE_BASE (0x200)，以便遵循COM的建议，就是使错误代码位于0200到 FFFF之间。

下面是客户端利用EOleException俘获错误的代码：

const

CODE_BASE = $200;

procedure CallFooBar;

var

Foo : IFoo;

Begin

Foo := CoFoo.Create;

Try

Foo.Bar;

Except

on E : EOleException do

ShowMessage ('错误信息: ' + E.Message + #13 +

'错误代号: ' + IntToStr (HResultToErrorNumber (E.ErrorCode) - CODE_BASE) + #13 +

'发生位置: ' + E.Source + #13 +

'帮助文件: ' + E.HelpFile + #13 +

'帮助上下文: ' + IntToStr (E.HelpContext)

);

end;

function HResultToErrorNumber (hr : HResult) : integer;

begin

Result := (hr and $FFFF);

end;

上述过程其实就是服务器的逆过程，就是从HRESULT中提取错误代码，并显示额外错误信息的过程。

如何实现多重接口

其实非常非常简单，比如想建立一个COM对象，它已经支持IFooBar接口了，我们还想实现两个外部接口IFoo和IBar。IFoo和IBar 接口定义如下：

IFoo = interface

procedure Foo; //隐含返回HRESULT

end;

IBar = interface

procedure Bar;

end;

实现部分：

type

TFooBar = class (TAutoObject, IFooBar, IFoo, IBar)

Protected

//IfooBar

... IFooBar methods here ...

//IFoo methods

procedure Foo;

//IBar methods

procedure Bar;

...

end;

procedure TFooBar.Foo;

begin

end;

procedure TFooBar.Bar;

begin

end;

是不是很简单啊，要注意的是如果IfooBar、IFoo和IBar都是基于IDispatch接口的，TAutoObject 将只会为IFooBar实现IDispatch，基于脚本的客户端只能看到IFooBar接口方法。

Delphi中定义的COM基类的用途

Delphi提供了很多基类用于COM开发：TInterfacedObject、TComObject、TTypedComObject、TAutoObject、TAutoIntfObject、TComObjectFactory、TTypedComObjectFactory、TAutoObjectFactory等。那么这些类适用于哪些条件下呢？

（1）TInterfacedObject

TInterfacedObject 只提供对IUnknown接口的实现，如果想创建一个内部对象来实现内部接口的话，TInterfacedObject 就是一个最好的基类。

（2）TComObject

TComObject实现了IUnknown、ISupportErrorInfo、标准的COM聚集支持和一个对应的类工厂支持。如果我们想创建一个轻量级的可连接客户端的基于IUnknown接口的COM对象的话，COM对象就应该从TComObject 类继承。

（3）TComObjectFactory

TComObjectFactory 是同TComObject对象配合工作的。它把对应的TComObject 公开为coclass。TComObjectFactory 提供了coclass 的注册功能(根据CLSIDs、ThreadingModel、ProgID等)。还实现了IClassFactory 和 IClassFactory2 接口以及标准的COM 对象许可证支持。简单地说如果要想创建TComObject对象，就会同时需要TComObjectFactory对象。

（4）TTypedComObject

TTypedComObject等于TComObject + 对IProvideClassInfo接口的支持。IProvideClassInfo 是自动化的标准接口用来公开一个对象的类型信息的（比如可获得的名字、方法、支持的接口等，类型信息储存在相关的类型库中）。TTypedComObject 可以用来支持那些在运行时能够浏览类型信息的客户端，比如Visual Basic的TypeName 函数期望一个对象能够实现IProvideClassInfo 接口，以便通过类型信息确定对象的文档名称（documented name）。

（5）TTypedComObjectFactory

TTypedComObjectFactory 是和TTypedComObject配合工作的。就等于TComObjectFactory + 提供缓存了的TTypedComObject类型信息（ITypeInfo）引用。一句话，创建TTypedComObject必然会同时创建TypedComObjectFactory 类工厂。

（6）TAutoObject

TAutoObject 等于TTypedComObject + 实现IDispatch接口。TAutoObject适用于实现支持自动化控制的COM对象。

（7）TAutoObjectFactory

TAutoObjectFactory显然是同TAutoObject密不可分的。它等于TTypedComObjectFactory + 提供了TAutoObject的接口和连接点事件接口的缓存类型信息 (ITypeInfo)。

（8）TAutoIntfObject

TAutoIntfObject等于TInterfacedObject +实现了IDispatch接口。同TAutoObject相比， TAutoIntfObject 没有对应的类工厂支持，这意味着外部客户端无法直接实例化一个TAutoIntfObject的衍生类。然而，TAutoIntfObject 非常适合作为基于IDispatch接口的下层对象或属性对象，客户端可以通过最上层的自动化对象得到对它们的引用。

理解列集的概念

在进行COM调用的时候，最经常碰到的错误恐怕就是"Interface not supported/registered" (80004002)错误了。这通常是由于没有在客户端机器上注册类型库导致的。

图1.115

COM的位置透明性是通过代理和存根对象来实现的。当一个客户端调用一个远程机器上的COM对象（或是另一个Apartment中的COM对象）时，客户端的请求首先通过代理，然后代理再通过COM，然后再通过存根才到达真正的对象，其关系如图1.115所示。

每当客户端调用COM对象的方法时，代理都会把方法参数整理为一个平直数组然后再传递给COM，而COM再把数组传递给存根，由存根负责解包数组还原参数，最后服务器对象才会按参数调用方法，整个过程就成为列集。

注意代理和存根同样是COM对象，系统提供了一个缺省的存根和代理，它们实现在 oleaut32.dll 中，对于大多数的列集处理来说，缺省的存根和代理已经足够用了，但它只能列集那些自动化兼容的数据类型的参数。

在类型库中，必须注释接口定义的[oleautomation]标识，表明我们希望使用类型库列集器来列集我们的接口。[oleautomation]标识适用于任意接口（只要方法参数全是自动化兼容的），认为它只使用于IDispatch类型接口的想法是不正确的。

由于不能像Visual C++那样简单地创建用户定制的代理-存根DLL，所以Delphi严重依赖于类型库列集器实现列集。同时由于类型库列集器的列集依赖于类型库中的信息，所以必须在服务器和客户端的机器上同时注册类型库，否则调用时就会碰到"Interface not supported/registered" 错误。

另外，要注意只有当我们使用前期绑定时才需要注册类型库。如果使用后期绑定（比如variant或双接口绑定），COM会调用IDispatch 接口早已注册在系统中的代理-存根DLL，因此后期绑定时不需要注册类型库文件。

如何实现一个支持Visual Basic的For Each调用的COM对象

熟悉Visual Basic和ASP开发的人一定会很熟悉用Visual Basic的For Each语法调用COM集合对象。

For Each允许一个VB的客户端很方便地遍历一个集合中的元素：

Dim Items as Server.IItems //声明集合变量

Dim Item as Server.IItem //声明集合元素变量

Set Items = ServerObject.GetItems //获得服务器的集合对象

//用 For Each循环遍历集合元素

For Each Item in Items

Call DoSomething (Item)

那么什么样的COM对象支持For Each语法呢？答案就是实现IEnumVARIANT COM接口，它的定义如下：

IEnumVARIANT = interface (IUnknown)

function Next (celt; var rgvar; pceltFetched): HResult;

function Skip (celt): HResult;

function Reset: HResult;

function Clone(out Enum): HResult;

end;

For Each语法知道如何调用IEnumVARIANT 接口的方法（特别是Next方法）来遍历集合中的全部元素。那么如何才能向客户端公开IEnumVARIANT 接口呢，下面是一个集合接口：

//集合元素

IFooItem = interface (IDispatch);

//元素集合

IFooItems = interface (IDispatch)

property Count : integer;

property Item [Index : integer] : IFoo;

end;

要想使用IEnumVARIANT接口，我们的集合接口首先必须支持自动化（也就是基于IDispatch接口），同时集合元素也必须是自动化兼容的（比如byte、BSTR、long、IUnknown、IDispatch等）。

然后，我们利用类型库编辑器添加一个名为_NewEnum的只读属性到集合接口中，_NewEnum 属性必须返回IUnknown 接口，同时dispid = -4 (DISPID_NEWENUM)。修改的IFooItems定义如下：

IFooItems = interface (IDispatch)

property Count : integer;

property Item [Index : integer] : IFoo;

property _NewEnum : IUnknown; dispid -4;

end;

接下来我们要实现_NewEnum属性来返回IEnumVARIANT 接口指针：

下面是一个完整的例子，它创建了一个ASP组件，有一个集合对象用来维护一个email地址列表：

unit uenumdem;

interface

uses

Windows, Classes, ComObj, ActiveX, AspTlb, enumdem_TLB, StdVcl;

type

IEnumVariant = interface(IUnknown)

['{00020404-0000-0000-C000-000000000046}']

function Next(celt: LongWord; var rgvar : OleVariant;

pceltFetched: PLongWord): HResult; stdcall;

function Skip(celt: LongWord): HResult; stdcall;

function Reset: HResult; stdcall;

function Clone(out Enum: IEnumVariant): HResult; stdcall;

end;

TRecipients = class (TAutoIntfObject, IRecipients, IEnumVariant)

protected

PRecipients : TStringList;

Findex : Integer;

Function Get_Count: Integer; safecall;

Function Get_Items(Index: Integer): OleVariant; safecall;

procedure Set_Items(Index: Integer; Value: OleVariant); safecall;

function Get__NewEnum: IUnknown; safecall;

procedure AddRecipient(Recipient: OleVariant); safecall;

function Next(celt: LongWord; var rgvar : OleVariant;

pceltFetched: PLongWord): HResult; stdcall;

function Skip(celt: LongWord): HResult; stdcall;

function Reset : HResult; stdcall;

function Clone (out Enum: IEnumVariant): HResult; stdcall;

public

constructor Create;

constructor Copy(slRecipients : TStringList);

destructor Destroy; override;

end;

TEnumDemo = class(TASPObject, IEnumDemo)

protected

FRecipients : IRecipients;

procedure OnEndPage; safecall;

procedure OnStartPage(const AScriptingContext: IUnknown); safecall;

function Get_Recipients: IRecipients; safecall;

end;

implementation

uses ComServ,

SysUtils;

constructor TRecipients.Create;

begin

inherited Create (ComServer.TypeLib, IRecipients);

PRecipients := TStringList.Create;

FIndex := 0;

end;

constructor TRecipients.Copy(slRecipients : TStringList);

begin

inherited Create (ComServer.TypeLib, IRecipients);

PRecipients := TStringList.Create;

FIndex := 0;

PRecipients.Assign(slRecipients);

end;

destructor TRecipients.Destroy;

begin

PRecipients.Free;

inherited;

end;

function TRecipients.Get_Count: Integer;

begin

Result := PRecipients.Count;

end;

function TRecipients.Get_Items(Index: Integer): OleVariant;

begin

if (Index >= 0) and (Index < PRecipients.Count) then

Result := PRecipients[Index]

else

Result := '';

end;

procedure TRecipients.Set_Items(Index: Integer; Value: OleVariant);

begin

if (Index >= 0) and (Index < PRecipients.Count) then

PRecipients[Index] := Value;

end;

function TRecipients.Get__NewEnum: IUnknown;

begin

Result := Self;

end;

procedure TRecipients.AddRecipient(Recipient: OleVariant);

var

sTemp : String;

begin

PRecipients.Add(Recipient);

sTemp := Recipient;

end;

function TRecipients.Next(celt: LongWord; var rgvar : OleVariant;

pceltFetched: PLongWord): HResult;

type

TVariantList = array [0..0] of olevariant;

var

i : longword;

begin

i := 0;

while (i < celt) and (FIndex < PRecipients.Count) do

begin

TVariantList (rgvar) [i] := PRecipients[FIndex];

inc (i);

inc (FIndex);

end; { while }

if (pceltFetched <> nil) then

pceltFetched^ := i;

if (i = celt) then

Result := S_OK

else

Result := S_FALSE;

end;

function TRecipients.Skip(celt: LongWord): HResult;

begin

if ((FIndex + integer (celt)) <= PRecipients.Count) then

begin

inc (FIndex, celt);

Result := S_OK;

end

else

begin

FIndex := PRecipients.Count;

Result := S_FALSE;

end; { else }

end;

function TRecipients.Reset : HResult;

begin

FIndex := 0;

Result := S_OK;

end;

function TRecipients.Clone (out Enum: IEnumVariant): HResult;

begin

Enum := TRecipients.Copy(PRecipients);

Result := S_OK;

end;

procedure TEnumDemo.OnEndPage;

begin

inherited OnEndPage;

end;

procedure TEnumDemo.OnStartPage(const AScriptingContext: IUnknown);

begin

inherited OnStartPage(AScriptingContext);

end;

function TEnumDemo.Get_Recipients: IRecipients;

begin

if FRecipients = nil then

FRecipients := TRecipients.Create;

Result := FRecipients;

end;

initialization

TAutoObjectFactory.Create(ComServer, TEnumDemo, Class_EnumDemo,

ciMultiInstance, tmApartment);

end.

下面是用来测试ASP组件的ASP脚本：

Set DelphiASPObj = Server.CreateObject("enumdem.EnumDemo")

DelphiASPObj.Recipients.AddRecipient "windows@ms.ccom"

DelphiASPObj.Recipients.AddRecipient "borland@hotmail.com"

DelphiASPObj.Recipients.AddRecipient "delphi@hotmail.com"

Response.Write "使用For Next 结构"

for i = 0 to DelphiASPObj.Recipients.Count-1

Response.Write "DelphiASPObj.Recipients.Items[" & i & "] = " & _

DelphiASPObj.Recipients.Items(i) & ""

Response.Write "使用 For Each 结构"

for each sRecipient in DelphiASPObj.Recipients

Response.Write "收信人 : " & sRecipient & ""

Set DelphiASPObj = Nothing

上面这个例子中，集合对象储存的是字符串数据，其实它可以储存任意的COM对象，对于COM对象可以用Delphi定义的TInterfaceList 类来管理集合中的COM对象元素。

下面是一个可重用的类TEnumVariantCollection，它隐藏了IEnumVARIANT接口的实现细节。为了插入TEnumVariantCollection 类到集合对象中去，我们需要实现一个有下列三个方法的接口：

IVariantCollection = interface

//使用枚举器来锁定列表拥有者

function GetController : IUnknown; stdcall;

//使用枚举器来确定元素数

function GetCount : integer; stdcall;

//使用枚举器来返回集合元素

function GetItems (Index : olevariant) : olevariant; stdcall;

end;

修改后的TFooItem的定义如下：

type

//Foo items collection

TFooItems = class (TSomeBaseClass, IFooItems, IVariantCollection)

Protected

{ IVariantCollection }

function GetController : IUnknown; stdcall;

function GetCount : integer; stdcall;

function GetItems (Index : olevariant) : olevariant; stdcall;

protected

FItems : TInterfaceList; //内部集合元素列表;

...

end;

function TFooItems.GetController: IUnknown;

begin

//always return Self/collection owner here

Result := Self;

end;

function TFooItems.GetCount: integer;

begin

//always return collection count here

Result := FItems.Count;

end;

function TFooItems.GetItems(Index: olevariant): olevariant;

begin

//获取IDispatch 接口

Result := FItems.Items [Index] as IDispatch;

end;

最后，我们来实现_NewEnum 属性：

function TFooItems.Get__NewEnum: IUnknown;

begin

Result := TEnumVariantCollection.Create (Self);

end;

这就是全部要做的工作。

客户端如何实现对基于IEnumVARIANT-接口的集合对象的枚举？

前面提到了在Visual Basic中，我们可以用For Each结构很简单地实现对基于IEnumVARIANT-接口的集合对象的枚举。那么在Delphi中有没有办法实现类似的操作呢？

答案是有两种方法可以做到，第一种比较困难，它需要我们非常熟悉IEnumVARIANT接口方法的调用，特别是reset和next方法。第二种简单的则是使用TEnumVariant类，它使用起来非常简单，代码示意如下：

uses ComLib;

var

Foo : IFoo;

Item : olevariant;

Enum : TEnumVariant;

Begin

Foo := CreateOleObject ('FooServer.Foo') as IFoo; //or CoFoo.Create

Enum := TEnumVariant.Create (Foo.Items);

while (Enum.ForEach (Item)) do

DoSomething (Item);

Enum.Free;

end;

看起来确实和For Each区别不大了。

如何使用聚集和包含

COM聚集和包含是两种重用COM对象的技术。为了弄清为什么需要使用聚集或包含技术，考虑一下下面的情况：假设现在有两个COM对象Foo (IFoo)和Bar (IBar)。我们想创建一个新的对象FooBar，它提供Foo和Bar两者的功能。那么我们可以这样定义新类：

IFoo = interface

procedure Foo;

end;

IBar = interface

procedure Bar;

end;

type

FooBar = class (BaseClass, IFoo, IBar)

end;

然后就是当实现IFoo接口的方法时重用Foo，当实现Ibar接口的时候重用Ibar。这时就需要聚集和包含了。

1. 包含

包含实际上就是初始化一个内部对象，然后把对接口方法的调用请求都传递给内部对象，如下为实现对IFoo的包含：

type

TFooBar = class (TComObject, IFoo)

Protected

//IFoo methods

procedure Foo;

protected

FInnerFoo : IFoo;

function GetInnerFoo : IFoo;

end;

procedure TFooBar.Foo;

var

Foo : IFoo;

Begin

//获得内部Foo对象

Foo := GetInnerFoo;

//传递方法请求给内部的Foo对象

Foo.Foo;

end;

function TFooBar.GetInnerFoo : IFoo;

begin

//创建内部的Foo对象

if (FInnerFoo = NIL) then

FInnerFoo := CreateComObject (Class_Foo) as IFoo;

Result := FInnerFoo;

end;

如果我们按下面定义实现类的话，由于没有代理接口请求，所以不能认为是包含：

type

TFooBar = class (TComObject, IFoo)

Protected

function GetInnerFoo : IFoo;

property InnerFoo : IFoo read GetInnerFoo implements IFoo;

end;

先前的实现和现在的不同在于代理的问题，前者必须公开了IFoo接口，然后通过Foo方法代理对接口的请求给内部对象，而后者是客户端直接请求InnerFoo提供的IFoo接口方法，没有代理请求的发生，所以不是包含。

2. 聚集

实现包含有时会变得非常烦琐，因为如果内部对象的接口支持大量的方法时，我们必须重复大量的编码工作来实现代理请求。还有很多其他原因使得我们需要聚集，简单地说聚集就是一种直接公开内部对象的机制。

聚集的首要规则是只能聚集那些支持聚集的内部对象，也就是说内部对象知道如何实现代理和非代理的接口请求。

要想了解更多关于代理和非代理的接口请求，参见Dale Rogerson写的《COM奥秘》一书。

第二条规则是当外部对象构建内部对象时，我们需要：

（1）把外部对象的IUnknown 接口作为CoCreateInstance调用的参数传递给内部对象。

（2）请求内部对象的IUnknown接口，而且是要IUnknown接口。

假设Foo对象是支持聚集的，下面让我们把Foo集成到TFooBar对象中。对IFoo的接口请求是通过Delphi的 implements 关键字实现的。代码示意如下：

Type

TFooBar = class (TComObject, IFoo)

Protected

function GetControllingUnknown : IUnknown;

function GetInnerFoo : IFoo;

property InnerFoo : IFoo read GetInnerFoo implements IFoo; //exposes IFoo directly from InnerFoo

protected

FInnerFoo : IUnknown;

end;

function TFoo.GetControllingUnknown : IUnknown;

begin

//返回正确的IUnknown接口

Result := Controller

Else

Result := Self as IUnknown;

end;

function TFooBar.GetInnerFoo : IFoo;

begin

//创建内部Foo对象 object if not yet initialized

if (FInnerFoo = NIL) then

CoCreateInstance (

CLASS_Foo, //Foo的CLSID

GetControllingUnknown, //传递Iunknown接口给内部对象

CLSCTX_INPROC, //假设Foo是进程内的

IUnknown, //请求Foo的Iunknown接口

FInnerFoo //输出内部Foo对象

);

//返回内部Foo对象

Result := FInnerFoo as IFoo;

end;

Delphi的TComObject 已经实现了内建的聚集特性，同时任何从TComObject继承的COM对象也支持聚集。同时不要忘记如果内部对象不支持聚集，那么这时我们只能使用包含。

理解类工厂的实例属性(SingleInstance, MultiInstance)

（1）类工厂的实例属性只对EXE类型的Server有作用。

（2）实例属性并不是EXE Server的属性也不是COM对象的属性而是类工厂的属性。它决定的是类工厂如何响应客户端的请求来创建对象的方式。所以所谓“一个Server生成一个对象和一个Server创建多个对象”的说法是完全错误的。

实例属性的真正意义其实是：

每一个COM服务器中的对象都会有一个相应的类工厂，每当客户端请求创建服务器中的对象时，COM将会要求对象的类工厂来创建这个对象。当EXE型的Server运行时会注册类工厂（当Server结束时又会被注销），类工厂的注册有三种实例模式：SingleUse、MultiUse和MultiSeparateUse。这里我们只讨论SingleUse和MultiUse这两种最常用的模式。

SingleUse意味着类工厂只创建最多一个相应对象的实例。在一个SingleUse的类工厂创建完它的一个实例后，COM将会注销它。因此，当下一个客户端请求创立一个对象时，COM 无法找到已注册的类工厂，它就会启动另一个EXE Server来获得新的类工厂，这就意味着如果前一个EXE Server运行没有结束，这时系统中会有两个EXE Server在同时运行。

MultiUse则意味着可以创建任意多个类工厂的实例。这意味着只要EXE Server不终止运行，则COM就不会注销类工厂，也就是说同时只可能有一个EXE Server运行并响应客户端创建相应对象的请求。

对于Delphi来说，实例模式相当于：

ciSingleInstance = SingleUse

ciMultiInstance = MultiUse

如何实现支持GetActiveObject函数的COM服务器

对于Microsoft Office来说，可以通过GetActiveObject函数获得系统中激活的Office程序：

var

Word : variant;

Begin

//连接到正在运行的Word实例，

//如果没有运行的实例，会产生异常

Word := GetActiveOleObject ('Word.Application');

end;

那么GetActiveOleObject函数是如何知道word是否正在运行的呢？又该如何实现支持GetActiveOleObject函数的COM Server呢？

需要把我们的COM Server注册到COM的运行对象表中去（Running Object Table，ROT），这可以通过调用RegisterActiveObject API实现：

function RegisterActiveObject (

unk: IUnknown; //要注册的对象

const clsid: TCLSID; //对象的CLSID

dwFlags: Longint; //注册标志通常使用ACTIVEOBJECT_STRONG

out dwRegister: Longint //成功注册后返回的句柄

): HResult; stdcall;

有注册自然就应该有撤消注册，撤消注册可以使用RevokeActiveObject API：

function RevokeActiveObject (

dwRegister: Longint; //先前调用RegisterActiveObject时返回的句柄

pvReserved: Pointer //保留参数，须设为nil

): HResult; stdcall;

要注意的是把一个COM对象注册到ROT中去，意味着只有当服务器从ROT撤消注册后，服务器才能终止运行，显然当不需要Server时，应该从ROT中把COM对象撤消，那么谁以及什么时候应该从ROT中撤消COM对象呢？

比较合适的办法是当客户端发出Quit或Exit命令时由服务器自己进行撤销。

详细的解决方案可参见Microsoft的自动化程序员参考。

另外下面要谈到的ROT的内容主要针对EXE类型的Server，对于进程内的DLL型Server来说，决定何时注册/撤消ROT比较复杂，因为DLL Server的生命期是依赖于客户端的。

假设我们想让一个全局的Foo对象注册到ROT中，代码如下：（在DPR文件中）

begin

Application.Initialize;

RegisterGlobalFoo;

Application.CreateForm(TForm1, Form1);

Application.Run;

end.

Var

GlobalFooHandle : longint = 0;

procedure RegisterGlobalFoo;

var

GlobalFoo : IFoo;

Begin

//创建Foo的实例

GlobalFoo := CoFoo.Create;

//注册到ROT

OleCheck (RegisterActiveObject (

GlobalFoo, //Foo的实例

Class_Foo, //Foo的CLSID

ACTIVEOBJECT_STRONG,

GlobalFooHandle //注册后返回句柄

));

end;

然后我们为Foo (IFoo) 添加一个Quit方法:

procedure TFoo.Quit;

begin

RevokeGlobalFoo;

end;

procedure RevokeGlobalFoo;

begin

if (GlobalFooHandle <> 0) then

begin

//撤销

OleCheck (RevokeActiveObject (

GlobalFooHandle, NIL

));

GlobalFooHandle := 0;

end;

下面是一个客户端使用GetActiveOleObject API调用服务器的例子：

var

FooUnk : IUnknown;

Foo : IFoo;

Begin

if (Succeeded (GetActiveObject (

Class_Foo, //Foo的CLSID

NIL, //保留参数，这里用NIL

FooUnk //从ROT返回Foo )))

then begin

//请求IFoo接口

Foo := FooUnk as IFoo;

//......

//终止全局的Foo,从ROT撤销

Foo.Quit;

end;

Delphi本身还有一个GetActiveOleObject函数使用对象的PROGID作为参数而不是对象的CLSID。GetActiveOleObject内部叫GetActiveObject，只工作于自动化对象。

如何实现支持自动化缺省属性语法的属性

假设我们要创建下面这样一个自动化接口：

ICollection = interface (IDispatch)

property Item [Index : variant] : variant;

end;

那么客户端则可以通过ICollection 接口指针像下面这样获得集合中的项目：

Collection.Item [Index]

但我们有时会很懒，希望能按下面的方式调用：

Collection [Index]

允许客户端使用这种简化的语法会带来很大的方便，特别是要调用很深层次的子对象的方法时，比较一下下面两种调用方法的方便程度：

Collection.Item [Index].SubCollection.Item [Index].SubsubCollection.Item [Index]

Collection [Index].SubCollection [Index].SubsubCollection [Index]

显然是后者要方便得多，实现缺省的属性语法支持同样非常方便，在类型库编辑器中，只要简单地标记Item [] 属性的dispid值为0 (DISPID_VALUE)就可以了。

因为缺省属性支持是基于dispids的，它只能在自动化接口中有作用。对于纯的虚方法表接口，不提供这方面的支持。

COM 组件分类

很多时候我们需要枚举一些功能类似的COM对象,例如假设想利用COM来提供插件的功能,那么宿主程序如何才能知道哪个COM对象可以作为插件呢?有没有什么标准的方法来实现COM识别呢?

在Windows 98/2000下可以通过组件分类来解决这个问题。简单地说，组件分类就是把实现一些通用功能的COM对象分为一组。客户端程序可以方便地确定要使用的COM对象。同其他COM对象类似，每个分类也要用一个唯一的标识符GUID来表示,这就是CATID (类别ID)。

Windows定义了ICatRegister和ICatInformation这两个接口来提供组件分类服务。实现了ICatRegister和ICatInformation接口组件的类GUID是CLSID_StdComponentCategoryMgr。我们可以使用ICatRegister接口的RegisterCategories方法来注册一个或多个类别。RegisterCategories方法需要两个参数，第一个参数确定有多少个类别将被注册，第二个参数是一个TCategoryInfo 类型的指针数组。TCategoryInfo声明如下：

TCATEGORYINFO = record

catid: TGUID; //类别 ID

lcid: UINT; //本地化 ID, 用于多语言支持

szDescription: array[0..127] of WideChar; //类别描述

end;

要想注册一个COM对象的类别，可以使用ICatRegister接口的RegisterClassImplCategories方法。RegisterClassImplCategories方法使用两个参数，一个是要注册的COM对象的CLSID，一个是要注册的类别数及类别记录(TcategoryInfo)的数组。对于客户端来说，为了扫描所有某一类别的COM对象，可以使用ICatInformation 接口的EnumClassesOfCategories方法。EnumClassesOfCategories方法需要五个参数，但通常只需要提供其中的三个参数就可以了，一个参数用来表明我们感兴趣的类别数，第二个参数是类别数组，最后一个参数是用来匹配COM对象的CLSID/GUID的枚举器。示意代码如下：

unit uhdshake;

interface

uses

Windows,

ActiveX,

ComObj;

type

TImplementedClasses = array [0..255] of TCLSID;

function GetImplementedClasses (var ImplementedClasses : TImplementedClasses) : integer;

procedure RegisterClassImplementation (const CATID, CLSID : TCLSID; const sDescription : String; bRegister : boolean);

implementation

function GetImplementedClasses (CategoryInfo : TCategoryInfo; var ImplementedClasses : TImplementedClasses) : integer;

var

CatInfo : ICatInformation;

Enum : IEnumGuid;

Fetched : UINT;

begin

Result := 0;

CatInfo := CreateComObject (CLSID_StdComponentCategoryMgr) as ICatInformation;

OleCheck (CatInfo.EnumClassesOfCategories (1, @CategoryInfo,0,nil,Enum));

if (Enum <> nil) then

begin

OleCheck (Enum.Reset);

OleCheck (Enum.Next (High (ImplementedClasses), ImplementedClasses [1], Fetched));

Result := Fetched;

end;

procedure RegisterClassImplementation (const CATID, CLSID : TCLSID; const sDescription : String; bRegister : boolean);

var

CatReg : ICatRegister;

CategoryInfo : TCategoryInfo;

begin

CoInitialize (nil);

CategoryInfo.CATID := CATID;

CategoryInfo.LCID := LOCALE_SYSTEM_DEFAULT; //dummy

StringToWideChar(sDescription, CategoryInfo.szDescription, Length(sDescription) + 1);

CatReg := CreateComObject (CLSID_StdComponentCategoryMgr) as ICatRegister;

if (bRegister) then

begin

OleCheck (CatReg.RegisterCategories (1, @CategoryInfo));

OleCheck (CatReg.RegisterClassImplCategories (CLSID, 1, @CategoryInfo));

end

else

begin

OleCheck(CatReg.UnregisterClassImplCategories(CLSID,1,@CategoryInfo));

DeleteRegKey ('CLSID\' + GuidToString (CLSID) + '\' + 'Implemented Categories');

end;

CatReg := nil;

CoUninitialize;

end;

end.

客户端可以使用GetImplementedClasses方法来获得所有符合某一类别的COM对象的CLSID。注意这里使用TImplementedClasses 类型作为所有获得的CLSID的容器。TImplementedClasses 类型简单的定义为256个CLSID的数组，对于大多数情况来说已经足够了。封装的RegisterClassImplementation方法是用来按类别注册或撤消COM对象的。

Delphi下的COM编程

岑 03/9（转载需征得作者同意）

 

Delphi通过向导可以非常迅速和方便的直接建立实现COM对象的代码，但是整个COM实现的过程被完全的封装，甚至没有VCL那么结构清晰可见。一个没有C++下COM开发经验甚至没有接触过COM开发的Delphi程序员，也能够很容易的按照教程设计一个接口，但是，恐怕深入一想，连生成的代码代表何种意义，哪些能够定制都不清楚。前几期 “DELPHI下的COM编程技术”一文已经初步介绍了COM的一些基本概念，我则想谈一些个人的理解，希望能给对Delphi下COM编程有疑惑的朋友带来帮助。

COM (组件对象模型 Component Object Model)是一个很庞大的体系。简单来说，COM定义了一组API与一个二进制的标准，让来自不同平台、不同开发语言的独立对象之间进行通信。COM对象只有方法和属性，并包含一个或多个接口。这些接口实现了COM对象的功能，通过调用注册的COM对象的接口，能够在不同平台间传递数据。

COM光标准和细节就可以出几本大书。这里避重就轻，仅仅初步的解释Delphi如何进行COM的封装及实现。对于上述COM技术经验不足的Delphi程序开发者来说，Delphi通过模版生成的代码就像是给你一幅抽象画照着画一样，画出来了却不一定知道画的究竟是什么，也不知该如何下手画自己的东西。本文能够帮助你解决这类疑惑。

再次讲解一些概念

“DELPHI下的COM编程技术”一文已经介绍了不少COM的概念，比如GUID、CLSID、IID，引用计数，IUnKnown接口等，下面再补充一些相关内容：

COM与DCOM、COM+、OLE、ActiveX的关系

DCOM（分布式COM）提供一种网络上访问其他机器的手段，是COM的网络化扩展，可以远程创建及调用。COM+是Microsoft对COM进行了重要的更新后推出的技术，但它不简单等于COM的升级，COM+是向后兼容的，但在某些程度上具有和COM不同的特性，比如无状态的、事务控制、安全控制等等。

以前的OLE是用来描述建立在COM体系结构基础上的一整套技术，现在OLE仅仅是指与对象连接及嵌入有关的技术；ActiveX则用来描述建立在COM基础上的非COM技术，它的重要内容是自动化（Automation），自动化允许一个应用程序（称为自动化控制器）操纵另一个应用程序或库（称为自动化服务器）的对象，或者把应用程序元素暴露出来。

由此可见COM与以上的几种技术的关系，并且它们都是为了让对象能够跨开发工具跨平台甚至跨网络的被使用。

Delphi下的接口

Delphi中的接口概念类似C++中的纯虚类，又由于Delphi的类是单继承模式（C++是多继承的），即一个类只能有一个父类。接口在某种程度上可以实现多继承。接口类的声明与一般类声明的不同是，它可以象多重继承那样，类名 = class (接口类1，接口类2… )，然后被声明的接口类则重载继承类的虚方法，来实现接口的功能。

以下是IInterface、IUnknown、IDispatch的声明，大家看出这几个重要接口之间是什么样的联系了吗？任何一个COM对象的接口，最终都是从IUnknown继承的，而Automation对象，则还要包含IDispatch，后面DCOM部分我们会看到它的作用。

IInterface = interface

['{00000000-0000-0000-C000-000000000046}']

function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;

function _AddRef: Integer; stdcall;

function _Release: Integer; stdcall;

end;

IUnknown = IInterface;

IDispatch = interface(IUnknown)

['{00020400-0000-0000-C000-000000000046}']

function GetTypeInfoCount(out Count: Integer): HResult; stdcall;

function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;

function GetIDsOfNames(const IID: TGUID; Names: Pointer;

NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;

function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;

Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;

end;

对照“DELPHI下的COM编程技术”一文，可以明白IInterface中的定义，即接口查询及引用记数，这也是访问和调用一个接口所必须的。QueryInterface可以得到接口句柄，而AddRef与Release则负责登记调用次数。

COM和接口的关系又是什么呢？COM通过接口进行组件、应用程序、客户和服务器之间的通信。COM对象需要注册，而一个GUID则是作为识别接口的唯一名字。

假如你创建了一个COM对象，它的声明类似 Txxxx= class(TComObject, Ixxxx)，前面是COM对象的基类，后面这个接口的声明则是：Ixxxx = interface(IUnknown)。所以说IUnknown是Delphi中COM对象接口类的祖先。到这一步，我想大家对接口类的来历已经有初步了解了。

聚合

接口是COM实现的基础，接口也是可继承的，但是接口并没有实现自己，仅仅只有声明。那么怎么使COM对象对接口的实现得到重用呢？答案就是聚合。聚合就是一个包含对象（外部对象）创建一个被包含对象（内部对象），这样内部对象的接口就暴露给外部对象。

简单来说，COM对象被注册后，可以找到并调用接口。但接口不是仅仅有个定义吗，它必然通过某种方式找到这个定义的实现，即接口的“实现类”的方法，这样才最终通过外部的接口转入进行具体的操作，并通过接口返回执行结果。

进程内与进程外（In-Process, Out-Process）

进程内的接口的实现基础是一个DLL，进程外的接口则是建立在应用程序（EXE）上的。通常我们建立进程外接口的目的主要是为了方便调试（跟踪DLL是件很麻烦的事），然后在将代码改为进程内发布。因为进程内比进程外的执行效率会高一些。

COM对象创建在服务器的进程空间。如果是EXE型服务器，那么服务器和客户端不在同一进程；如果是DLL型服务器，则服务器和客户端就是一个进程。所以进程内还能节省内存空间，并且减少创建实例的时间。

StdCall与SafeCall

Delphi生成的COM接口默认的方法函数调用方式是stdcall而不是缺省的Register。这是为了保证不同语言编译器的接口兼容。

双重接口（在后面讲解自动化时会提到双重接口）中则默认的是SafeCall。它的意义除了按SafeCall约定方式调用外，还将封装方法以便向调用者返回HResult值。SafeCall的好处是能够捕获所有异常，即使是方法中未被代码处理的异常，也可以被外套处理并通过HResult返回给调用者。

WideString等一些有差异的类型

接口定义中缺省的字符参数或返回值将不再是String而是WideString。WideString 是Delphi中符合OLE 32-bit版本的Unicode类型，当是字符时，WideString与String几乎等同，当处理Unicode字符时，则会有很大差别。联想到COM本身是为了跨平台使用，可以很容易的理解为什么数据通信时需要使用WideString类型。

同样的道理，integer类型将变成SYSINT或者Int64、SmallInt或者Shortint，这些细微的变化都是为了符合规范。

通过向导生成基础代码

 

打开创建新工程向导（菜单“File-New-Other”或“New Items按钮”），选择ActiveX页。先建立一个ActiveX Library。编译后即是个DLL文件（进程内）。然后在同样的页面再建立一个COM Object。

实例模式与线程模式

接着你将看到如下向导，除了填写类名外（接口名会自动根据类名填充），还有实例创建方式（Instancing）和线程模式（Threading Model）的选项。

实例模式决定客户端请求后，COM对象如何创建实例：

（1） Internal：供COM对象内部使用，不会响应客户端请求，只能通过COM对象内部的其他方法来建立；

（2） Single Instance：不论当前系统内部是否存在相同COM对象，都会建立一个新的程序及独立的对象实例；

（3） Mulitple Instance：如果有多个相同的COM对象，只会建立一个程序，多个COM对象的实例共享公共代码，并拥有自己的数据空间。

Single/ Mulitple Instance有各自的优点，Mulitple虽然节省了内存但更加费时。即Single模式需要更多的内存资源，而Mulitple模式需要更多的CPU资源，且Single的实例响应请求的负荷较为平均。该参数应根据服务器的实际需求来考虑。

线程模式有五种：

（1） Single：仅单线程，处理简单，吞吐量最低；

（2） Apartment：COM程序多线程，COM对象处理请求单线程；

（3） Free：一个COM对象的多个实例可以同时运行。吞吐量提高的同时，也要求对COM对象进行必要的保护，以避免多个实例冲突；

（4） Both：同时支持Aartment和Free两种线程模式。

（5） Neutral：只能在COM+下使用。

虽然Free和Both的效率得到提高，但是要求较高的技巧以避免冲突（这是很不容易调试的），所以一般建议使用Delphi的缺省方式。

类型库编辑器（Type Library）

假设我们建立一个叫做TSample的类和ISample的接口（如图），然后使用类型库编辑器创建一个方法GetCOMInfo（在右边树部分点击右键弹出菜单选择New-Method或者点击上方按钮），并于左边Parameters页面建立两个参数（ValInt : Integer , ValStr : String），返回值为BSTR。如图：

可以看到，除了常用类型外，参数和返回值还可以支持很多指针、OLE对象、接口类型。建立普通的COM对象，其Returen Type是可以任意的，这是和DCOM的一个区别。

双击Modifier列弹出窗口，可以选择参数的方式：in、out分别对应const、out定义，选择Has Default Value可设置参数缺省值。

Delphi生成代码详解

点击刷新按钮刷新后，上面类型库编辑器对应的Delphi自动生成的代码如下：

unit uCOM;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses

Windows, ActiveX, Classes, ComObj, pCOM_TLB, StdVcl;

type

TSample = class(TTypedComObject, ISample)

protected

function GetCOMInfo(ValInt: SYSINT; const ValStr: WideString): WideString;

stdcall;

end;

implementation

uses ComServ;

function TSample.GetCOMInfo(ValInt: SYSINT;const ValStr: WideString): WideString;

begin

end;

initialization

TTypedComObjectFactory.Create(ComServer, TSample, Class_Sample,

ciMultiInstance, tmApartment);

end.

引用单元

有三个特殊的单元被引用：ComObj，ComServ和pCOM_TLB。ComObj里定义了COM接口类的父类TTypedComObject和类工厂类TTypedComObjectFactory（分别从TComObject和TComObjectFactory继承，早期版本如Delphi4建立的COM，就直接从TcomObject继承和使用TComObjectFactory了）； ComServ单元里面定义了全局变量ComServer: TComServer，它是从TComServerObject继承的，关于这个变量的作用，后面将会提到。

这几个类都是delphi实现COM对象的比较基础的类，TComObject（COM对象类）和TComObjectFactory（COM对象类工厂类）本身就是IUnknown的两个实现类，包含了一个COM对象的建立、查询、登记、注册等方面的代码。TComServerObject则用来注册一个COM对象的服务信息。

接口定义说明

再看接口类定义TSample = class(TTypedComObject, ISample)。到这里，已经可以通过涉及的父类的作用大致猜测到TSample是如何创建并注册为一个标准的COM对象的了。那么接口ISample又是怎么来的呢？pCOM_TLB单元是系统自动建立的，其名称加上了_TLB，它里面包含了ISample = interface(IUnknown)的接口定义。前面提到过，所有COM接口都是从IUnknown继承的。

在这个单元里我们还可以看到三种ID（类型库ID、IID及COM注册所必须的CLSID）的定义：LIBID_pCOM，IID_ISample和CLASS_Sample。关键是这时接口本身仅仅只有定义代码而没有任何的实现代码，那接口创建又是在何处执行的？_TLB单元里还有这样的代码：

CoSample = class

class function Create: ISample;

class function CreateRemote(const MachineName: string): ISample;

end;

class function CoSample.Create: ISample;

begin

Result := CreateComObject(CLASS_Sample) as ISample;

end;

class function CoSample.CreateRemote(const MachineName: string): ISample;

begin

Result := CreateRemoteComObject(MachineName, CLASS_Sample) as ISample;

end;

由Delphi的向导和类型编辑器帮助生成的接口定义代码，都会绑定一个“Co+类名”的类，它实现了创建接口实例的代码。CreateComObject和CreateRemoteComObject函数在ComObj单元定义，它们就是使用CLSID创建COM/DCOM对象的函数！

初始化：注册COM对象的类工厂

类工厂负责接口类的统一管理——实际上是由支持IClassFactory接口的对象来管理的。类工厂类的继承关系如下：

IClassFactory = interface(IUnknown)

TComObjectFactory=class(TObject,IUnknown,IClassFactory,IClassFactory2) TTypedComObjectFactory = class(TComObjectFactory)

我们知道了接口ISample是怎样被创建的，接口实现类TSample又是如何被定义为COM对象的实现类。现在解释它是怎么被注册，以及何时创建的。这一切的小把戏都在最后initialization的部分，这里有一条类工厂建立的语句。

Initialization是Delphi用于初始化的特殊部分，此部分的代码将在整个程序启动的时候首先执行。回顾前面的内容并观察一下TTypedComObjectFactory的参数：ComServer是用于注册/撤消注册COM服务的对象，TSample是接口实现类，Class_Sample是接口唯一对应的GUID，ciMultiInstance是实例模式，tmApartment是线程模式。一个COM对象应该具备的特征和要素都包含在了里面！

那么COM对象的管理又是怎么实现的呢？在ComObj单元里面可以见到一条定义function ComClassManager: TComClassManager;

这里TComClassManager顾名思义就是COM对象的管理类。任何一个祖先类为TComObjectFactory的对象被建立时，其Create里面会执行这样一句：

ComClassManager.AddObjectFactory(Self);

AddObjectFactory方法的原形为procedure TComClassManager.AddObjectFactory(Factory: TComObjectFactory);相对应的还有RemoveObjectFactory方法。具体的代码我就不贴出来了，相信大家已经猜测到了它的作用——将当前对象（self）加入到ComClassManager管理的对象链（FFactoryList）中。

封装的秘密

读者应该还有最后一个疑问：假如服务器通过类工厂的注册以及GUID确定一个COM对象，那当客户端调用的时候，服务器是如何启动包含COM对象的程序的呢？

当你建立ActiveX Library的工程的时候，将发现一个和普通DLL模版不同的地方——它定义了四个输出例程：

exports

DllGetClassObject,

DllCanUnloadNow,

DllRegisterServer,

DllUnregisterServer;

这四个例程并不是我们编写的，它们都在ComServ单元例实现。单元还定义了类TComServer，并且在初始化部分创建了类的实例，即前面提到过的全局变量ComServer。

例程DllGetClassObject通过CLSID得到支持IClassFactory接口的对象；例程DllCanUnloadNow判断DLL是否可从内存卸载；DllRegisterServer和DllUnregisterServer负责DLL的注册和解除注册，其具体的功能由ComServer实现。

接口类的具体实现

好了，现在自动生成代码的来龙去脉已经解释清楚了，下一步就是由我们来添加接口方法的实现代码。在function TSample.GetCOMInfo的部分添加如下代码。我写的例子很简单，仅仅是根据传递的参数组织一条字符串并返回。以此证明接口正确调用并执行了该代码：

function TSample.GetCOMInfo(ValInt: SYSINT;const ValStr: WideString): WideString;

const

Server1 = 1; Server2 = 2; Server3 = 3;

var

s : string;

begin

s := 'This is COM server : ';

case ValInt of

Server1: s := s + 'Server1';

Server2: s := s + 'Server2';

Server3: s := s + 'Server3';

end;

s := s + #13 + #10 + 'Execute client is ' + ValStr;

Result := s;

end;

注册、创建COM对象及调用接口

随便建立一个Application用于测试上面的COM。必要的代码很少，创建一个接口的实例然后执行它的方法。当然我们得先行注册COM，否则调用根据CLSID找不接口的话，将报告“无法向注册表写入项”。如果接口定义不一致，则会报告“Interface not supported”。

编译上面的这个COM工程，然后选择菜单“Run – Register ActiveX Server”，或者通过Windows下system/system32目录中的regsvr32.exe程序注册编译好的DLL文件。regsvr32的具体参数可以通过regsvr32/？来获得。对于进程外（EXE型）的COM对象，执行一次应用程序就注册了。

提示DLL注册成功后，就应该可以正确执行下列客户端程序了：

uses ComObj, pCOM_TLB;

procedure Ttest.Button1Click(Sender: TObject);

var

COMSvr : ISample;

retStr : string;

begin

COMSvr := CreateComObject(CLASS_Sample) as ISample;

if COMSvr <> nil then begin

retStr := COMSvr.GetCOMInfo(2,'client 2');

showmessage(retStr);

COMSvr := nil;

end

else showmessage('接口创建不成功');

end;

最终值是从当前程序外的一个“接口”返回的，我们甚至可以不知道这个接口的实现！第一次接触COM的人，成功执行此程序并弹出对话框后，也许会体会到一种技术如斯奇妙的感觉，因为你仅仅调用了“接口”，就可以完成你猜测中的东西。

创建一个分布式DCOM（自动化接口）

IDispatch

在delphi6之前的版本中，所有接口的祖先都是IUnknown，后来为了避免跨平台操作中接口概念的模糊，又引入了IInterface接口。

使用向导生成DCOM的步骤和COM几乎一致。而生成的代码仅将接口类的父类换为TAutoObject，类工厂类换为TAutoObjectFactory。这其实没有太大的不同，因为TAutoObject等于是一个标准COM外加IDispatch接口，而TAutoObjectFactory是从TTypedComObjectFactory直接继承的：

TAutoObject = class(TTypedComObject, IDispatch)

TAutoObjectFactory = class(TTypedComObjectFactory)

自动化服务器支持双重接口，而且必须实现IDispatch。因讨论范畴限制，本文只能简单提出，IDispatch是DCOM和COM技术实现上的一个重要区别。打开_TLB.pas单元，可以找到Ixxx = interface(IDispatch)和Ixxx = dispinterface的定义，这在前面COM的例子里面是没有的。

 

创建过程中的差异

使用类型库编辑器的时候，有两处和COM不同的地方。首先Return Type必须选择HRESULT，否则会提示错误，这是为了满足双重接口的需要。当Return Type选择HRESULT后，你会发现方法定义将变成procedure（过程）而不是预想中的function（函数）。

怎么才能让方法有返回值呢？还需要在Parameters最后多添加一个参数，然后将该参数改名与方法名一致，设置参数类型为指针（如果找不到某种类型的指针类型，可以直接在类型后面加*，如图，BSTR*是BSTR的指针类型）。最后在Modifier列设置Parameter Flags为RetVal，同时Out将被自动选中，而In将被取消。

刷新后，得到下列代码。添加方法的具体实现，大功告成：

TSampleAuto = class(TAutoObject, ISampleAuto)

protected

function GetAutoSerInfo(ValInt: SYSINT;const ValStr: WideString): WideString; safecall;

end;

远程接口调用

远程接口的调用需要使用CreateRemoteComObject函数，其它如接口的声明等等与COM接口调用相同。CreateRemoteComObject函数比CreateComObject 多了一个参数，即服务器的计算机名称，这样就比COM多出了远程调用的查询能力。前面“接口定义说明”一节的代码可以对照CreateComObject、CreateRemoteComObject的区别。

自定义COM的对象

 

接口一个重要的好处是：发布一个接口，可以不断更新其功能而不用升级客户端。因为不论应用升级还是业务改变，客户端的调用方式都是一致的。

既然我们已经弄清楚Delphi是怎样实现一个接口的，那能否不使用向导，自己定义接口呢？这样做可以用一个接口继承出不同的接口实现类，来完成不同的功能。同时也方便了小组开发、客户端开发、进程内/外同步编译以及调试。

接口单元：xxx_TLB.pas

前面略讲了接口的定义需要注意的方面。接口除了没有实例化外，它与普通类还有以下区别：接口中不能定义字段，所有属性的读写必须由方法实现；接口没有构造和析构函数，所有成员都是public；接口内的方法不能定义为virtual，dynamic，abstract，override。

首先我们要建立一个接口。前面讲过接口的定义只存在于一个地方，即xxx_TLB.pas单元里面。使用类型库编辑器可以产生这样一个单元。还是在新建项目的ActiveX页，选择最后一个图标（Type Library）打开类型库编辑器，按F12键就可以看到TLB文件（保存为.tlb）了。没有定义任何接口的时候，TLB文件里除了一大段注释外只定义了LIBID（类型库的GUID）。假如关闭了类型库编辑器也没有关系，可以随时通过菜单View – Type Library打开它。

先建立一个新接口（使用向导的话这步已经自动完成了），然后如前面操作一样建立方法、属性…生成的TLB文件内容与向导生成_TLB单元大致相同，但仅有定义，缺乏“co+类名”之类的接口创建代码。

再观察代码，将发现接口是从IDispatch继承的，必须将这里的IDispatch改为IUnknown。保存将会得到.tlb文件，而我们想要的是一个单元（.pas）文件，仅仅为了声明接口，所以把代码拷贝复制并保存到一个新的Unit。

自定义CLSID

从注册和调用部分可以看出CLSID的重要作用。CLSID是一个GUID（全局唯一接口表示符），用来标识对象。GUID是一个16个字节长的128位二进制数据。Delphi声明一个GUID常量的语法是：

Class_XXXXX : TGUID = '{xxxxxxxx-xxxxx-xxxxx-xxxxx-xxxxxxxx}';

在Delphi的编辑界面按Ctrl+Shift+G键可以自动生成等号后的数据串。GUID的声明并不一定在_TLB单元里面，任何地方都可以声明并引用它。

接口类声明与实现

新建一个ActiveX Library工程，加入刚才定义的TLB单元，再新建一个Unit。我的TLB单元取名为MyDef_TLB.pas，定义了一个接口IMyInterface = interface(IUnknown)，以及一个方法function SampleMethod(val: Smallint): SYSINT; safecall;现在让我们看看全部接口类声明及实现的代码：

unit uMyDefCOM;

interface

uses

ComObj, Comserv, ActiveX, MyDef_TLB;

const

Class_MySvr : TGUID = '{1C0E5D5A-B824-44A4-AF6C-478363581D43}';

type

TMyIClass = class(TComObject, IMyInterface)

procedure Initialize; override;

destructor Destroy; override;

private

FInitVal : word;

public

function SampleMethod(val: Smallint): SYSINT; safecall;

end;

TMySvrFactory = class(TComObjectFactory)

procedure UpdateRegistry(Register:Boolean);override;

end;

implementation

{ TMyIClass }

procedure TMyIClass.Initialize;

begin

inherited;

FInitVal := 100;

end;

destructor TMyIClass.Destroy;

begin

inherited;

end;

function TMyIClass.SampleMethod(val: Smallint): SYSINT;

begin

Result := val + FInitVal;

end;

{ TMySvrFactory }

procedure TMySvrFactory.UpdateRegistry(Register: Boolean);

begin

inherited;

if Register then begin

CreateRegKey('MyApp\'+ClassName, 'GUID', GUIDToString(Class_MySvr));

end else begin

DeleteRegKey('MyApp\'+ClassName);

end;

initialization

TMySvrFactory.Create(ComServer, TMyIClass, Class_MySvr,

'MySvr', '', ciMultiInstance, tmApartment);

end.

Class_MySvr是自定义的CLSID，TMyIClass是接口实现类，TMySvrFactory是类工厂类。

COM对象的初始化

procedure Initialize是接口的初始化过程，而不是常见的Create方法。当客户端创建接口后，将首先执行里面的代码，与Create的作用一样。一个COM对象的生存周期内，难免需要初始化类成员或者设置变量的初值，所以经常需要重载这个过程。

相对应的，destructor Destroy则和类的标准析构过程一样，作用也相同。

类工厂注册

在代码的最后部分，假如使用TComObjectFactory来注册，就和前面所讲的完全一样了。我在这里刻意用类TMySvrFactory继承了一次，并且重载了UpdateRegistry 方法，以便向注册表中写入额外的内容。这是种小技巧，希望大家根据本文的思路，摸清COM/DCOM对象的Delphi实现结构后，可以举一反三。毕竟随心所欲的控制COM对象，能提供的功能远不如此。

 

（本文所有代码在Delphi6、Delphi7下编译执行通过

posted on 2005-11-03 14:05 Peter.zhou 阅读(3300) 评论(0) 收藏举报

刷新页面返回顶部

常见COM问题解答

常见COM问题解答

导航

公告