Delphi 中 COM 实现研究手记(一)

前言

前些日子用Delphi写了一个Windows外壳扩展程序，大家知道Windows外壳扩展实际上就是COM的一种应用--ShellCOM，虽然整个程序写得还算比较顺利，但写完后还是感觉对Delphi中COM的实现有点雾里看花的感觉，因此我认为有必要花一点时间对COM在Delphi中的实现做一些研究。另外我也买了李维的新书--《深入核心--VCL架构剖析》，里面有两章涉及了与COM相关内容，看完后我知道了COM在Delphi中的实现是基于接口(Interface)，而Delphi中的接口概念又起源于对COM的支持，总之他们之间互相影响，发展成接口在Delphi中已经是First-Class的地位，并且完全摆脱COM而独立存在。
本系列文章侧重于描述COM在Delphi中的实现手法，主要配合VCL源码片断进行分析，不会涉及过多的基本概念，因此要求读者有一定的COM和接口概念，可以参考我在文章末尾列出的文献。本篇主要讲COM对象在Delphi中的创建过程。

正文

为了让读者能跟着我的分析轻松读完本篇文章，我引用文献[2]中的范例做解释，但为了更清楚地阐述问题，我改写了部分代码。所有分析请在Delphi7上测试。
在Delphi中首先通过选择菜单File-->New-->Other...新建一个ActiveXLibrary并保存名称为SimpleComServer，再新建一个COMObject，在COMObjectWizard中将对象命名为SimpleCOMObject，Options中的两个复选框都可以不必选中其他的保持默认，现在COM服务器端的框架已经建立起来了。剩下的就是需要我们把声明的接口ISimpleCOMObject的代码实现。

[delphi]viewplaincopy

服务器端代码

librarySimpleComServer;

uses

ComServ,

SimpleCOMObjectin'SimpleCOMObject.pas',

SimpleComInterfacein'SimpleComInterface.pas',

exports

DllGetClassObject,

DllCanUnloadNow,

DllRegisterServer,

DllUnregisterServer;

{$R*.RES}

begin

end.

--------------------------------------------------------------------------------

unitSimpleComInterface;

interface

usesWindows;

const

Class_SimpleComObject:TGUID='{3714CF21-D272-11D3-947F-0050DA73BE5D}';

type

ISimpleComObject=interface

['{2E2A6DD0-D282-11D3-947F-0050DA73BE5D}']

functionMultiply(X,Y:Integer):Integer;stdcall;

functionGetClassName:Widestring;stdcall;

end;

implementation

end

--------------------------------------------------------------------------------

unitSimpleCOMObject;

interface

//SimpleCOMObject的实现部分

uses

Windows,ActiveX,Classes,ComObj,SimpleComInterface;

type

TSimpleComObject=class(TComObject,ISimpleComObject)

protected

functionMultiply(X,Y:Integer):Integer;stdcall;

functionGetClassName:Widestring;stdcall;

end;

const

Class_SimpleComObject:TGUID='{3714CF21-D272-11D3-947F-0050DA73BE5D}';

implementation

usesComServ;

{TSimpleComObject}

functionTSimpleComObject.GetClassName:Widestring;

begin

Result:=TSimpleComObject.ClassName;

end;

functionTSimpleComObject.Multiply(X,Y:Integer):Integer;

begin

Result:=X*Y;

end;

initialization

TComObjectFactory.Create(ComServer,TSimpleComObject,Class_SimpleComObject,

'SimpleComObject','AsimpleimplementationofaCOMObject',

ciMultiInstance,tmApartment);

end.

[delphi]viewplaincopy

//客户端关键代码

procedureTForm1.Button1Click(Sender:TObject);

var

aFactory:IClassFactory;

begin

OleCheck(CoGetClassObject(Class_SimpleComObject,CLSCTX_INPROC_SERVERor

CLSCTX_LOCAL_SERVER,nil,IClassFactory,aFactory));

aFactory.CreateInstance(nil,ISimpleComObject,ComInterface);

ShowMessage('Theresultis:'+

IntToStr(ComInterface.Multiply(StrToInt(Edit1.Text),StrToInt(Edit2.Text))));

ComInterface:=nil;

end;

procedureTForm1.Button2Click(Sender:TObject);

begin

ComInterface:=CreateComObject(Class_SimpleComObject)asISimpleComObject;

ShowMessage(ComInterface.GetClassName);

ComInterface:=nil;

end;

完成服务器端的代码后，我们需要写一个客户端小程序来执行服务器端内的接口代码，我仅列出由我改写的关键代码部分

现在开始进入主题，跟随我一起走进Delphi的COMFramework世界吧。我主要从客户端程序创建COM对象来剖析VCL源码。
客户端代码中我用两种获得创建SimpleCOMObject对象并获得ISimpleCOMObject接口，一旦获得接口，你就可以自由地使用接口指定的方法了。
让我们先看看Button1Click里如何创建COM对象的。代码调用了CoGetClassObject获得创建SimpleCOMObject对象的类工厂--IClassFactory接口，紧接着又通过调用该接口的CreateInstance方法创建了真正的SimpleCOMObject对象实例，返回ISimpleComObject接口指针。那么上面整个过程在VCL中是如何实现的呢？让我们先从CoGetClassObject这个API说起。
CoGetClassObject是Windows的一个标准COMAPI，该函数存在于OLE32.DLL中，它是WindowsCOMDLL之一。函数先根据系统注册表中的信息，找到类标识符CLSID对应的组件程序(即服务器端程序，我们这里讨论的是一个DLL文件)的全路径，然后调用LoadLibrary(实际上是CoLoadLibrary)函数初始化服务器（Dll被加载到客户程序进程中）并调用组件程序的DllGetClassObject输出函数。DllGetClassObject函数负责创建相应的类厂对象，并返回类厂对象的IClassFactory接口。至此CoGetClassObject函数的任务完成，然后客户程序继续调用类厂对象的CreateInstance成员函数，由它负责COM对象的创建工作。
注意：WindowsCOM规范中指定你必须在服务器中完成并输出DllGetClassObject，如果这个没有被发现，Windows将不能传递对象到客户端，DllGetClassObject将是进入我们的dll(COM服务器)的入口点。
从上面的一番简要陈述不难看出获得IClassFactory接口是通过调用服务器端的DllGetClassObject函数获得的，传奇实际也就是从这个输出函数开始的。让我们看看它是如何实现的（如果源码中我附加了注释，请一定仔细看看，下面不再提示）：

[delphi]viewplaincopy

functionDllGetClassObject(constCLSID,IID:TGUID;varObj):HResult;

var

Factory:TComObjectFactory;

begin

Factory:=ComClassManager.GetFactoryFromClassID(CLSID);

ifFactory<>nilthen

ifFactory.GetInterface(IID,Obj)then

Result:=S_OK

else

Result:=E_NOINTERFACE

else

begin

Pointer(Obj):=nil;

Result:=CLASS_E_CLASSNOTAVAILABLE;

end;

end;

ComClassManager是什么？它是我们需要介绍的DelphiCOMFramework中的第一个类。

[delphi]viewplaincopy

functionComClassManager:TComClassManager;

begin

ifComClassManagerVar=nilthen

ComClassManagerVar:=TComClassManager.Create;

Result:=TComClassManager(ComClassManagerVar);

end;

每个服务器端内存在一个TComClassManager实例，即ComClassManagerVar全局对象变量，它负责管理COM服务器中的所有类工厂(classfactory)对象（本例中只有一个类工厂）。而类工厂又是什么时候创建的？其实我前面已经列出了，COMObjectWizard生成的SimpleCOMObject的骨架代码的Initialization部分已经自动为我们创建一个TComObjectFactory对象：

[delphi]viewplaincopy

initialization

TComObjectFactory.Create(ComServer,TSimpleComObject,Class_SimpleComObject,'SimpleComObject','AsimpleimplementationofaCOMObject',ciMultiInstance,

tmApartment);

Delphi关键字Initialization提示我们dll在被载入客户端程序进程空间时，负责创建impleCOMObject对象的类工厂TComObjectFactory就已经被创建了。我们知道，一个服务器端里可以包含多个COM对象，并且每一个独立的COM对象都必须相应有创建该类的类工厂，假如你设计的服务器端里有十个COM对象，那么肯定会有十个负责创建不同类的类工厂，这十个类工厂在程序初始化时都会被一一创建出来。这个概念一定在你的头脑中建立起来，否则后面就不好理解了。再提示一下，VCL中定义了数种ClassFactory类，分别负责某一种类型的COM对象创建，TComObjectFactory是其中最简单的一种[1]。那么ComClassManager和TComObjectFactory又是如何联系到一起呢？看看TComObjectFactory的Constructor：

[delphi]viewplaincopy

constructorTComObjectFactory.Create(ComServer:TComServerObject;

ComClass:TComClass;constClassID:TGUID;constClassName,

Description:string;Instancing:TClassInstancing;

ThreadingModel:TThreadingModel);

begin

//.....

//将自己插入到ComClassManager的FactoryList中去

ComClassManager.AddObjectFactory(Self);

FComServer:=ComServer;

FComClass:=ComClass;

FClassID:=ClassID;

FClassName:=ClassName;

FDescription:=Description;

FInstancing:=Instancing;

FErrorIID:=IUnknown;

FShowErrors:=True;

FThreadingModel:=ThreadingModel;

FRegister:=-1;

end;

再看看ComClassManager相关实现代码：

[delphi]viewplaincopy

TComClassManager=class(TObject)

private

FFactoryList:TComObjectFactory;//维护着一个TComObjectFactory链表

//添加Com类工厂

procedureAddObjectFactory(Factory:TComObjectFactory);

procedureRemoveObjectFactory(Factory:TComObjectFactory);

public

//....

functionGetFactoryFromClassID(constClassID:TGUID):TComObjectFactory;

end;

////

procedureTComClassManager.AddObjectFactory(Factory:TComObjectFactory);

begin

FLock.BeginWrite;

try

Factory.FNext:=FFactoryList;

FFactoryList:=Factory;

finally

FLock.EndWrite;

end;

end;

ComClassManagerVar维护着服务器中的所有的类工厂的一个链表，每个单一类工厂的实例都是自动初始化，在我们的服务器Initialization节你可以看到，并自动将自己添加到ComClassManager的链表(FactoryList)中。现在想想，这样的设计是不是非常棒。
请跟随我继续往下走。当客户端要求DllGetClassObject返回指定创建的类工厂，在函数内部调用了TComClassManager的GetFactoryFromClassID方法。该方法遍历FactoryList链表，根据ClassID找到对应的类工厂，并返回类工厂对象实例。

[delphi]viewplaincopy

functionTComClassManager.GetFactoryFromClassID(constClassID:TGUID):TComObjectFactory;

begin

FLock.BeginRead;

try

Result:=FFactoryList;

whileResult<>nildo

begin

ifIsEqualGUID(Result.ClassID,ClassID)thenExit;

Result:=Result.FNext;

end;

finally

FLock.EndRead;

end;

end;

对上面的代码分析我再多说一下，链表FFactoryList变量实际就是TComObjectFactory类型，TComObjectFactory创建时就获得了丰富的关于它要创建的相关COM对象信息，例如在我们这个范例里，ClassFactory知道了它要创建的COM对象类型是TSimpleComObject,ClassID是Class_SimpleComObject..等等，这些都为类工厂在创建相关类以及一些辅助方法（函数）都提供了极为重要的信息

DllGetClassObject获得正确的类工厂对象之后调用它的GetInterface方法，这个方法实际上是继承自TObject.GetInterface，Delphi为每一个带有GUID的接口设计了一个记录结构--TInterfaceEntry记录，实现IClassFactory接口的TComObjectFactory对象VMT中的vmtIntfTable指向一个TInterfaceTable记录，该记录包含有它实现的接口数量(IUnknown、IClassFactory)、相应接口的TInterfaceEntry记录等信息，通过查询IClassFactory接口相应TInterfaceEntry记录中的IOffset域获得该接口在TComObjectFactory对象实例中的正确位置，并返回指向该位置的IClassFactory接口指针[1][3]。

[delphi]viewplaincopy

functionTObject.GetInterface(constIID:TGUID;outObj):Boolean;

var

InterfaceEntry:PInterfaceEntry;

begin

Pointer(Obj):=nil;

InterfaceEntry:=GetInterfaceEntry(IID);

ifInterfaceEntry<>nilthen

begin

ifInterfaceEntry^.IOffset<>0then

begin

Pointer(Obj):=Pointer(Integer(Self)+InterfaceEntry^.IOffset);

ifPointer(Obj)<>nilthenIInterface(Obj)._AddRef;

end

else

IInterface(Obj):=InvokeImplGetter(Self,InterfaceEntry^.ImplGetter);

end;

Result:=Pointer(Obj)<>nil;

end;

至此，CoGetClassObject内部调用服务器端的DllGetClassObject已经正确获得了负责创建SimpleCOMObject对象的IClassFactory接口。在获得这个接口后，就可以调用它的方法CreateInstance

创建

SimpleCOMObject对象并返回ISimpleCOMObject接口，现在你可以对ISimpleCOMObject接口任意进行操作了

让我们再看看ButtonClick2中是如何创建

SimpleCOMObject对象的。
ButtonClick2是调用CreateComObject函数创建

SimpleCOMObject对象的。CreateComObject函数只是对COMAPI--CoCreateInstance的一个简单包装。为什么要包装它，你可以看一下CoCreateInstance的参数就知道为什么了，参数多且复杂，这是WindowsAPI的通病，而VCL实现却很体贴我们，它传递CLSID作为唯一的参数，其实平时应用中我们创建的大部分COM对象都是CLSID已知，并且对象是驻留在本地或进程内服务器的指定对象。

[delphi]viewplaincopy

functionCreateComObject(constClassID:TGUID):IUnknown;

begin

try

OleCheck(CoCreateInstance(ClassID,nil,CLSCTX_INPROC_SERVERor

CLSCTX_LOCAL_SERVER,IUnknown,Result));

except

onE:EOleSysErrordo

raiseEOleSysError.Create(Format('%s,ClassID:%s',[E.Message,GuidToString(ClassID)]),E.ErrorCode,0){Donotlocalize}

end;

end;

CoCreateInstance也存在于OLE32.DLL中，其内部也是先调用CoGetClassObject函数，返回负责创建SimpleCOMObject的IClassFactory接口，然后也还是调用该接口的CreateInstance创建SimpleCOMObject并返回该对象的IUnknown接口，到这一步，与Button1Click中创建SimpleCOMObject的实现方法区别在于Button1Click通过ClassFactory的CreateInstance直接返回ISimpleCOMObject接口而不是它的IUnknown接口，其他的并没有什么区别，相对Button1Click的方法更直观。在获得了SimpleCOMObject的IUnknown接口之后，我们并不能立即用此接口去调用ISimpleCOMObject的方法，为了和对象通信，必须先将它转换成ISimpleComObject接口。那么有读者会问为什么CreateComObject不设计成能直接返回需要的接口呢，我想还是为了简化这个函数的使用吧。获得ISimpleComObject接口可以通过调用IUnknown接口的QueryInterface方法查询SimpleCOMObject对象是否支持该接口，Delphi为我们提供了更简单的方法--“AS”关键字。先让我们看看As在幕后到底为我们做了什么（Debug状态下的反汇编源码）：

[delphi]viewplaincopy

Unit1.pas.49:ComInterface:=CreateComObject(Class_SimpleComObject)asISimpleComObject;

0045B2C68D55FCleaedx,[ebp-$04]

0045B2C9A16CD24500moveax,[$0045d26c]

0045B2CEE8C9F0FFFFcallCreateComObject

0045B2D38B55FCmovedx,[ebp-$04]

0045B2D68D8314030000leaeax,[ebx+$00000314]

0045B2DCB93CB34500movecx,$0045b33c

0045B2E1E87AA9FAFFcall@IntfCast

可以看到，AS被转换成调用@IntfCast，即system单元的_IntfCast函数。呵呵，其实就是调用IUnknown接口的QueryInterface方法。

[delphi]viewplaincopy

procedure_IntfCast(varDest:IInterface;constSource:IInterface;constIID:TGUID);

var

Temp:IInterface;

begin

ifSource=nilthen

Dest:=nil

else

begin

Temp:=nil;

ifSource.QueryInterface(IID,Temp)<>0then

Error(reIntfCastError)

else

Dest:=Temp;

end;

end;

由此可见，第二种方法也可以按照下面的方法调用：

[c-sharp]viewplaincopy

procedureTForm1.Button2Click(Sender:TObject);

const

Class_SimpleComObject:TGUID='{3714CF21-D272-11D3-947F-0050DA73BE5D}';

var

Unknown:IUnknown;

begin

Unknown:=CreateComObject(Class_SimpleComObject)asISimpleComObject;

ComInterface.QueryInterface(Class_SimpleComObject,ComInterface);

ShowMessage(ComInterface.GetClassName);

ComInterface:=nil;

end;

至此两种创建SimpleCOMObject对象的方法全部分析完毕。那么在平时的应用中我们到底使用哪种方法创建COM对象比较好呢？其实在Delphi的官方帮助中已经给了我们答案：当你只创建单一COM对象时，你可以调用CreateComObject；当你需要成批创建同一类COM对象时，那么还是直接选择类工厂吧，还是它来得快。
在我分析后，你是否认为复杂的COM结构被VCL包装得很完美？至少我认为是这样的，使我不得不佩服BorlandDelphiR&D小组的高超技术水准。如果你还没尽兴，那么等我的下篇吧...

参考文献

1.李维.《深入核心--VCL架构剖析》第六、七章

2.FernandoVicaria."DelphiCOMIn-ProcessServersUndertheMicroscope,Part1".HardcoreDelphiMagazine,Mar2000

3.savetime."Delphi的接口机制浅探",Feb2004

4.savetime."《COM原理与应用》学习笔记",Feb2004
http://blog.csdn.net/procedure1984/article/details/3906945