前些日子用 Delphi 写了一个 Windows 外壳扩展程序，大家知道 Windows 外壳扩展实际上就是 COM 的一种应用 -- Shell COM，虽然整个程序写得还算比较顺利，但写完后还是感觉对 Delphi 中 COM 的实现有点雾里看花的感觉，因此我认为有必要花一点时间对 COM 在 Delphi 中的实现做一些研究。另外我也买了李维的新书 --《深入核心 -- VCL架构剖析》，里面有两章涉及了与 COM 相关内容，看完后我知道了COM 在 Delphi 中的实现是基于接口(Interface)，而 Delphi 中的接口概念又起源于对 COM 的支持，总之他们之间互相影响，发展成接口在 Delphi 中已经是 First-Class 的地位，并且完全摆脱 COM 而独立存在。
本系列文章侧重于描述 COM 在 Delphi 中的实现手法，主要配合 VCL 源码片断进行分析，不会涉及过多的基本概念，因此要求读者有一定的 COM 和 接口概念，可以参考我在文章末尾列出的文献。本篇主要讲 COM 对象在 Delphi 中的创建过程。
正文
为了让读者能跟着我的分析轻松读完本篇文章，我引用文献[2]中的范例做解释，但为了更清楚地阐述问题，我改写了部分代码。所有分析请在 Delphi 7 上测试。Demo 源码这里下载。
在 Delphi 中首先通过选择菜单 File-->New-->Other...新建一个 ActiveX Library 并保存名称为 SimpleComServer，再新建一个 COM Object，在COM Object Wizard 中将对象命名为 SimpleCOMObject，Options 中的两个复选框都可以不必选中其他的保持默认， 现在 COM服务器端的框架已经建立起来了。剩下的就是需要我们把声明的接口 ISimpleCOMObject 的代码实现，其他的读者自己看源码吧，很简单。
服务器端代码
library SimpleComServer;
uses
ComServ,
SimpleCOMObject in 'SimpleCOMObject.pas',
SimpleComInterface in 'SimpleComInterface.pas',
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
{$R *.RES}
begin
end.
unit SimpleComInterface;
interface
uses Windows;
const
Class_SimpleComObject: TGUID = '{3714CF21-D272-11D3-947F-0050DA73BE5D}';
type
ISimpleComObject = interface
['{2E2A6DD0-D282-11D3-947F-0050DA73BE5D}']
function Multiply(X, Y: Integer): Integer; stdcall;
function GetClassName: Widestring; stdcall;
end;
implementation
end
unit SimpleCOMObject;
interface
// SimpleCOMObject 的实现部分
uses
Windows, ActiveX, Classes, ComObj, SimpleComInterface;
type
TSimpleComObject = class(TComObject, ISimpleComObject)
protected
function Multiply(X, Y: Integer): Integer; stdcall;
function GetClassName: Widestring; stdcall;
end;
const
Class_SimpleComObject: TGUID = '{3714CF21-D272-11D3-947F-0050DA73BE5D}';
implementation
uses ComServ;
{ TSimpleComObject }
function TSimpleComObject.GetClassName: Widestring;
begin
Result := TSimpleComObject.ClassName;
end;
function TSimpleComObject.Multiply(X, Y: Integer): Integer;
begin
Result := X * Y;
end;
initialization
TComObjectFactory.Create(ComServer, TSimpleComObject, Class_SimpleComObject,
'SimpleComObject', 'A simple implementation of a COM Object',
ciMultiInstance, tmApartment);
end.
完成服务器端的代码后，我们需要写一个客户端小程序来执行服务器端内的接口代码，我仅列出由我改写的关键代码部分，其他的见源码。
客户端关键代码
procedure TForm1.Button1Click(Sender: TObject);
var
aFactory: IClassFactory;
begin
OleCheck(CoGetClassObject(Class_SimpleComObject, CLSCTX_INPROC_SERVER or
CLSCTX_LOCAL_SERVER, nil, IClassFactory, aFactory));
aFactory.CreateInstance(nil, ISimpleComObject, ComInterface);
ShowMessage('The result is: ' +
IntToStr(ComInterface.Multiply(StrToInt(Edit1.Text), StrToInt(Edit2.Text))));
ComInterface := nil;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ComInterface := CreateComObject(Class_SimpleComObject) as ISimpleComObject;
ShowMessage(ComInterface.GetClassName);
ComInterface := nil;
end;
现在开始进入主题，跟随我一起走进 Delphi 的 COM Framework 世界吧。我主要从客户端程序创建 COM 对象来剖析 VCL 源码。
客户端代码中我用两种获得创建 SimpleCOMObject 对象并获得 ISimpleCOMObject 接口，一旦获得接口，你就可以自由地使用接口指定的方法了。
让我们先看看 Button1Click 里如何创建 COM 对象的。代码调用了 CoGetClassObject 获得创建 SimpleCOMObject 对象的类工厂 -- IClassFactory 接口，紧接着又通过调用该接口的 CreateInstance 方法创建了真正的 SimpleCOMObject 对象实例，返回 ISimpleComObject 接口指针。 那么上面整个过程在 VCL 中是如何实现的呢？让我们先从 CoGetClassObject 这个API 说起。
CoGetClassObject 是 Windows 的一个标准 COM API，该函数存在于 OLE32.DLL中，它是 Windows COM DLL 之一。函数先根据系统注册表中的信息，找到类标识符 CLSID 对应的组件程序(即服务器端程序，我们这里讨论的是一个 DLL 文件)的全路径，然后调用 LoadLibrary(实际上是 CoLoadLibrary)函数初始化服务器（Dll 被加载到客户程序进程中）并调用组件程序的 DllGetClassObject 输出函数。DllGetClassObject 函数负责创建相应的类厂对象，并返回类厂对象的 IClassFactory 接口。至此 CoGetClassObject 函数的任务完成，然后客户程序继续调用类厂对象的 CreateInstance 成员函数，由它负责 COM 对象的创建工作。
注意：Windows COM 规范中指定你必须在服务器中完成并输出 DllGetClassObject，如果这个没有被发现，Windows 将不能传递对象到客户端，DllGetClassObject 将是进入我们的 dll(COM 服务器)的入口点。
从上面的一番简要陈述不难看出获得 IClassFactory 接口是通过调用服务器端的 DllGetClassObject 函数获得的，传奇实际也就是从这个输出函数开始的。让我们看看它是如何实现的（如果源码中我附加了注释，请一定仔细看看，下面不再提示）：
// 摘自 ComServ 单元
function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult;
var
Factory: TComObjectFactory;
begin
Factory := ComClassManager.GetFactoryFromClassID(CLSID);
if Factory <> nil then
if Factory.GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE
else
begin
Pointer(Obj) := nil;
Result := CLASS_E_CLASSNOTAVAILABLE;
end;
end;
ComClassManager 是什么？它是我们需要介绍的 Delphi COM Framework 中的第一个类。
// 摘自 ComObj 单元
var
ComClassManagerVar: TObject;
function ComClassManager: TComClassManager;
begin
if ComClassManagerVar = nil then
ComClassManagerVar := TComClassManager.Create;
Result := TComClassManager(ComClassManagerVar);
end;
每个服务器端内存在一个 TComClassManager 实例，即ComClassManagerVar 全局对象变量，它负责管理 COM 服务器中的所有类工厂(class factory)对象（本例中只有一个类工厂）。而类工厂又是什么时候创建的？其实我前面已经列出了，COM Object Wizard 生成的 SimpleCOMObject 的骨架代码的 Initialization 部分已经自动为我们创建一个 TComObjectFactory 对象：
initialization
TComObjectFactory.Create(ComServer, TSimpleComObject, Class_SimpleComObject,
'SimpleComObject', 'A simple implementation of a COM Object', ciMultiInstance,
tmApartment);
Delphi 关键字 Initialization 提示我们 dll 在被载入客户端程序进程空间时，负责创建 SimpleCOMObject 对象的类工厂 TComObjectFactory 就已经被创建了。我们知道，一个服务器端里可以包含多个 COM 对象，并且每一个独立的 COM 对象都必须相应有创建该类的类工厂，假如你设计的服务器端里有十个 COM 对象，那么肯定会有十个负责创建不同类的类工厂，这十个类工厂在程序初始化时都会被一一创建出来。这个概念一定在你的头脑中建立起来，否则后面就不好理解了。再提示一下，VCL 中定义了数种 ClassFactory 类，分别负责某一种类型的 COM 对象创建，TComObjectFactory 是其中最简单的一种[1]。那么 ComClassManager 和 TComObjectFactory 又是如何联系到一起呢？看看 TComObjectFactory 的 Constructor：
// 摘自 ComObj 单元
constructor TComObjectFactory.Create(ComServer: TComServerObject;
ComClass: TComClass; const ClassID: TGUID; const ClassName,
Description: string; Instancing: TClassInstancing;
ThreadingModel: TThreadingModel);
begin
// ...
// 将自己插入到 ComClassManager 的 Factory List 中去
ComClassManager.AddObjectFactory(Self);
// ...
end;
再看看 ComClassManager 相关实现代码：
// 摘自 ComObj 单元
TComClassManager = class(TObject)
private
// TComClassManager 维护着一个 TComObjectFactory 链表
FFactoryList: TComObjectFactory;
FLock: TMultiReadExclusiveWriteSynchronizer;
procedure AddObjectFactory(Factory: TComObjectFactory);
// ...
end;
procedure TComClassManager.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 找到对应的类工厂，并返回类工厂对象实例。
// 摘自 ComObj 单元
function TComClassManager.GetFactoryFromClassID(const ClassID: TGUID): TComObjectFactory;
begin
FLock.BeginRead;
try
Result := FFactoryList;
while Result <> nil do
begin
if IsEqualGUID(Result.ClassID, ClassID) then
Exit;
Result := Result.FNext;
end;
finally
FLock.EndRead;
end;
end;
对上面的代码分析我再多说一下，链表 FFactoryList 变量实际就是 TComObjectFactory 类型，TComObjectFactory 创建时就获得了丰富的关于它要创建的相关 COM 对象信息，例如在我们这个范例里，ClassFactory 知道了它要创建的 COM 对象类型是 TSimpleComObject, ClassID 是 Class_SimpleComObject..等等，这些都为类工厂在创建相关类以及一些辅助方法（函数）都提供了极为重要的信息。
// 摘自 ComObj 单元
constructor TComObjectFactory.Create(ComServer: TComServerObject;
ComClass: TComClass; const ClassID: TGUID; const ClassName,
Description: string; Instancing: TClassInstancing;
ThreadingModel: TThreadingModel);
begin
// ...
FComServer := ComServer;
FComClass := ComClass;
FClassID := ClassID;
FClassName := ClassName;
FDescription := Description;
FInstancing := Instancing;
FErrorIID := IUnknown;
FShowErrors := True;
FThreadingModel := ThreadingModel;
FRegister := -1;
end;
DllGetClassObject 获得正确的类工厂对象之后调用它的 GetInterface 方法，这个方法实际上是继承自 TObject.GetInterface，Delphi 为每一个带有 GUID 的接口设计了一个记录结构 -- TInterfaceEntry 记录，实现 IClassFactory 接口的 TComObjectFactory 对象 VMT 中的 vmtIntfTable 指向一个 TInterfaceTable 记录， 该记录包含有它实现的接口数量(IUnknown、IClassFactory)、相应接口的 TInterfaceEntry 记录等信息，通过查询 IClassFactory 接口相应 TInterfaceEntry 记录中的 IOffset 域获得该接口在 TComObjectFactory 对象实例中的正确位置，并返回指向该位置的 IClassFactory 接口指针[1][3]。
// 摘自 System 单元
function TObject.GetInterface(const IID: TGUID; out Obj): Boolean;
var
InterfaceEntry: PInterfaceEntry;
begin
Pointer(Obj) := nil;
InterfaceEntry := GetInterfaceEntry(IID);
if InterfaceEntry <> nil then
begin
if InterfaceEntry^.IOffset <> 0 then
begin
Pointer(Obj) := Pointer(Integer(Self) + InterfaceEntry^.IOffset);
if Pointer(Obj) <> nil then
IInterface(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 函数只是对 COM API -- CoCreateInstance 的一个简单包装。为什么要包装它，你可以看一下 CoCreateInstance 的参数就知道为什么了，参数多且复杂，这是 Windows API 的通病，而 VCL 实现却很体贴我们，它传递 CLSID 作为唯一的参数，其实平时应用中我们创建的大部分 COM 对象都是 CLSID 已知，并且对象是驻留在本地或进程内服务器的指定对象。
// 摘自 ComObj 单元
function CreateComObject(const ClassID: TGUID): IUnknown;
begin
OleCheck(CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or
CLSCTX_LOCAL_SERVER, IUnknown, Result));
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 状态下的反汇编源码）：
Unit1.pas.49: ComInterface := CreateComObject(Class_SimpleComObject) as ISimpleComObject;
0045B2C6 8D55FC lea edx,[ebp-$04]
0045B2C9 A16CD24500 mov eax,[$0045d26c]
0045B2CE E8C9F0FFFF call CreateComObject
0045B2D3 8B55FC mov edx,[ebp-$04]
0045B2D6 8D8314030000 lea eax,[ebx+$00000314]
0045B2DC B93CB34500 mov ecx,$0045b33c
0045B2E1 E87AA9FAFF call @IntfCast
可以看到， AS 被转换成调用 @IntfCast，即 system 单元的 _IntfCast 函数。呵呵，其实就是调用 IUnknown 接口的 QueryInterface 方法。
// 摘自 System 单元
procedure _IntfCast(var Dest: IInterface; const Source: IInterface; const IID:
TGUID);
{$IFDEF PUREPASCAL}
// PIC: EBX must be correct before calling QueryInterface
var
Temp: IInterface;
begin
if Source = nil then
Dest := nil
else
begin
Temp := nil;
if Source.QueryInterface(IID, Temp) <> 0 then
Error(reIntfCastError)
else
Dest := Temp;
end;
end;
至此两种创建 SimpleCOMObject 对象的方法全部分析完毕。那么在平时的应用中我们到底使用哪种方法创建 COM 对象比较好呢？其实在 Delphi 的官方帮助中已经给了我们答案：当你只创建单一 COM 对象时，你可以调用 CreateComObject；当你需要成批创建同一类 COM 对象时，那么还是直接选择类工厂吧，还是它来得快。
在我分析后，你是否认为复杂的 COM 结构被 VCL 包装得很完美？至少我认为是这样的，使我不得不佩服 Borland Delphi R&D 小组的高超技术水准。如果你还没尽兴，那么等我的下篇吧...
参考文献
1. 李维.《深入核心 -- VCL架构剖析》第六、七章
2. Fernando Vicaria."Delphi COM In-Process Servers Under the Microscope, Part 1". Hardcore Delphi Magazine, Mar 2000
