COM实现过程2
l 类工厂的实现
正如我前面所说的，一个类工厂必须去建立我们自定义的接口。在上面，我们定义了自定义的接口，并由类TMyCOMServer 去实现。那么，现在我们还要做的是，实现类工厂，然后由类工厂建立一个TMyCOMServer 的接口实例。类工厂接口定义如下：
IClassFactory = interface(IUnknown)
['{00000001-0000-0000-C000-000000000046}']
function CreateInstance(const UnkOuter: IUnknown; const IID: TGUID;
out Obj): HResult; stdcall;
function LockServer(fLock: Boolean): HResult; stdcall;
end;
注意，IclassFactory是系统预先定义了的，在ACTIVEX单元有，所以不需要自己再去定义一次。我们只要去实现它就是：
TClassFactory = class(TObject, IClassFactory)
protected
FLock: integer;
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
public
Constructor Create;
function CreateInstance(const UnkOuter: IUnknown; const IID: TGUID;
out Obj): HResult; stdcall;
function LockServer(fLock: Boolean): HResult; stdcall;
end;
我们只关注CreateInstance 方法。LockServer 用于在多客户调用COM时，锁定COM，以免一个客户退出时销毁了COM，那么其他客户的调用将发生错误。但是我们在这里只实现单客户，所以不考虑这个函数，把他置空就是。
function TClassFactory.CreateInstance(const UnkOuter: IInterface;
const IID: TGUID; out Obj): HResult;
begin
//我们的自定义接口，就是在这里被创建的。
MC := TMyCOMServer.Create;
Pointer(Obj) := Pointer(MC);
end;
function TClassFactory.LockServer(fLock: Boolean): HResult;
begin
end;
同样的，TclassFactory也必须实现引用计数，因为它也实现了Iunknown接口。
function TClassFactory._AddRef: Integer;
begin
Inc(FLock);
end;
function TClassFactory._Release: Integer;
begin
Dec(FLock);
if FLock = 0 then
Free;
end;
function TClassFactory.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
end;
其中，QueryInterface 我把它置空，因为在这个例子中，不需要向它查询什么接口。如果以后读者需要向它查询接口时，自己实现相关代码。
同样，在它的构造器中，也预先对计数加1
constructor TClassFactory.Create;
begin
Inc(FLock);
end;
到目前为止，我们已经基本实现了一个COM需要的大部分功能。现在，我们需要把它注册到系统中，以便被其他程序调用。
l COM的注册和反注册
我们回过头来，看看如何去实现那四个DLL的输出函数。这四个函数的原形如下：
function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult;stdcall;
function DllCanUnloadNow: HResult;stdcall;
function DllRegisterServer: HResult;stdcall;
function DllUnregisterServer: HResult;stdcall;
我们上面所说的类工厂的实例，就是在DllGetClassObject 中创建的。代码如下：
function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult;
begin
CF := TClassFactory.Create;
Pointer(obj) := Pointer(CF);
Result := S_OK;
end;
同样的，我们只有一个类工厂，所以可以不理会前面那两个参数。否则，就要根据不同GUID，来创建不同的类工厂对象。在这里，我们直接把类工厂对象给返回了。
函数DllCanUnloadNow 用来注销一个COM。在正常使用中，要根据引用计数，来判断是否允许用户注销。在这里我们直接返回S_OK，让用户直接注销。
function DllCanUnloadNow: HResult;
begin
Result := S_OK;
end;
函数DllRegisterServer 用来向注册表注册一个COM组件信息。要注册一个COM，用户必须知道COM在注册表中的信息是如何组织的。结构如下：
HKEY_CLASSES_ROOT
---- CLSID
---- GUID
----- InprocServer32 标明 COM所在磁盘的路径以及线程模型
----- ProgID 标明COM所实现的接口
----- TypeLib 标明 COM 的类型库的GUID
----- Version 标明 COM的版本号。
当发生CreateCOMObject()调用时，输入参数为COM的CLASS类型的GUID，系统将在注册表中搜索到相关信息，然后就可以找到该COM的位置，就可以开始调用了。
注意，如果您希望COM组件支持客户端的CreateOLEObject()函数的调用，您必须还要注册一个信息：
HKEY_CLASSES_ROOT
----- 接口声明
----- CLSID 标明 COM 接口和CLASS类型的GUID的对应关系。
那么，当发生 CreateOLEObject 调用时，系统将会根据输入参数（一个COM接口声明，如a.b），去查找和接口对应的CLASS GUID，然后就可以读到COM的相关信息了。
全部代码如下：
function DllRegisterServer: HResult;
var
lp: pchar;
ns: Dword;
begin
Result := S_FALSE;
Reg := TRegistry.Create;
GetMem(lp, 255);
try
Reg.RootKey := HKEY_CLASSES_ROOT;
if Reg.OpenKey('\MyCOM.MyCOMTest',true) then
begin
Reg.CreateKey('CLSID');
if Reg.OpenKey('CLSID',true) then
Reg.WriteString('',GUIDToString(Class_MyCOM));
end;
if Reg.OpenKey('\CLSID\' + GUIDToString(Class_MyCOM), true) then
begin
if Reg.CreateKey('InprocServer32') = false or
Reg.CreateKey('ProgID') = false or
Reg.CreateKey('TypeLib') = false or
Reg.CreateKey('Version') = false then
Exit;
Reg.WriteString('','MyCOM');
if Reg.OpenKey('\CLSID\' + GUIDToString(Class_MyCOM) +
'\InprocServer32', false) then
begin
Windows.GetModuleFileName(HInstance,lp, 255);
Reg.WriteString('', lp);
Reg.WriteString('ThreadingModel', 'Single');
end;
if Reg.OpenKey('\CLSID\' + GUIDToString(Class_MyCOM) + '\ProgID', false) then
Reg.WriteString('','MyCOM.MyCOMTest');
if Reg.OpenKey('\CLSID\' + GUIDToString(Class_MyCOM) + '\Version', false) then
Reg.WriteString('','1.0');
if Reg.OpenKey('\CLSID\' + GUIDToString(Class_MyCOM) + '\TypeLib', false) then
Reg.WriteString('',GUIDToString(LIBID_MyCOM));
Reg.CloseKey;
Result := S_OK;
end;
finally
begin
FreeMem(lp);
Reg.Free;
end;
end;
end;
函数DllUnregisterServer 则向系统注销一个COM的注册信息。它比较简单，直接把COM的相关注册键给删除就是：
function DllUnRegisterServer: Hresult;
begin
Result := S_False;
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CLASSES_ROOT;
Reg.DeleteKey('\CLSID\' + GUIDToString(Class_MyCOM));
Reg.CloseKey;
Finally
Reg.Free;
end;
end;
正如我前面所说的，一个类工厂必须去建立我们自定义的接口。在上面，我们定义了自定义的接口，并由类TMyCOMServer 去实现。那么，现在我们还要做的是，实现类工厂，然后由类工厂建立一个TMyCOMServer 的接口实例。类工厂接口定义如下：
IClassFactory = interface(IUnknown)
['{00000001-0000-0000-C000-000000000046}']
function CreateInstance(const UnkOuter: IUnknown; const IID: TGUID;
out Obj): HResult; stdcall;
function LockServer(fLock: Boolean): HResult; stdcall;
end;
注意，IclassFactory是系统预先定义了的，在ACTIVEX单元有，所以不需要自己再去定义一次。我们只要去实现它就是：
TClassFactory = class(TObject, IClassFactory)
protected
FLock: integer;
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
public
Constructor Create;
function CreateInstance(const UnkOuter: IUnknown; const IID: TGUID;
out Obj): HResult; stdcall;
function LockServer(fLock: Boolean): HResult; stdcall;
end;
我们只关注CreateInstance 方法。LockServer 用于在多客户调用COM时，锁定COM，以免一个客户退出时销毁了COM，那么其他客户的调用将发生错误。但是我们在这里只实现单客户，所以不考虑这个函数，把他置空就是。
function TClassFactory.CreateInstance(const UnkOuter: IInterface;
const IID: TGUID; out Obj): HResult;
begin
//我们的自定义接口，就是在这里被创建的。
MC := TMyCOMServer.Create;
Pointer(Obj) := Pointer(MC);
end;
function TClassFactory.LockServer(fLock: Boolean): HResult;
begin
end;
同样的，TclassFactory也必须实现引用计数，因为它也实现了Iunknown接口。
function TClassFactory._AddRef: Integer;
begin
Inc(FLock);
end;
function TClassFactory._Release: Integer;
begin
Dec(FLock);
if FLock = 0 then
Free;
end;
function TClassFactory.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
end;
其中，QueryInterface 我把它置空，因为在这个例子中，不需要向它查询什么接口。如果以后读者需要向它查询接口时，自己实现相关代码。
同样，在它的构造器中，也预先对计数加1
constructor TClassFactory.Create;
begin
Inc(FLock);
end;
到目前为止，我们已经基本实现了一个COM需要的大部分功能。现在，我们需要把它注册到系统中，以便被其他程序调用。
l COM的注册和反注册
我们回过头来，看看如何去实现那四个DLL的输出函数。这四个函数的原形如下：
function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult;stdcall;
function DllCanUnloadNow: HResult;stdcall;
function DllRegisterServer: HResult;stdcall;
function DllUnregisterServer: HResult;stdcall;
我们上面所说的类工厂的实例，就是在DllGetClassObject 中创建的。代码如下：
function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult;
begin
CF := TClassFactory.Create;
Pointer(obj) := Pointer(CF);
Result := S_OK;
end;
同样的，我们只有一个类工厂，所以可以不理会前面那两个参数。否则，就要根据不同GUID，来创建不同的类工厂对象。在这里，我们直接把类工厂对象给返回了。
函数DllCanUnloadNow 用来注销一个COM。在正常使用中，要根据引用计数，来判断是否允许用户注销。在这里我们直接返回S_OK，让用户直接注销。
function DllCanUnloadNow: HResult;
begin
Result := S_OK;
end;
函数DllRegisterServer 用来向注册表注册一个COM组件信息。要注册一个COM，用户必须知道COM在注册表中的信息是如何组织的。结构如下：
HKEY_CLASSES_ROOT
---- CLSID
---- GUID
----- InprocServer32 标明 COM所在磁盘的路径以及线程模型
----- ProgID 标明COM所实现的接口
----- TypeLib 标明 COM 的类型库的GUID
----- Version 标明 COM的版本号。
当发生CreateCOMObject()调用时，输入参数为COM的CLASS类型的GUID，系统将在注册表中搜索到相关信息，然后就可以找到该COM的位置，就可以开始调用了。
注意，如果您希望COM组件支持客户端的CreateOLEObject()函数的调用，您必须还要注册一个信息：
HKEY_CLASSES_ROOT
----- 接口声明
----- CLSID 标明 COM 接口和CLASS类型的GUID的对应关系。
那么，当发生 CreateOLEObject 调用时，系统将会根据输入参数（一个COM接口声明，如a.b），去查找和接口对应的CLASS GUID，然后就可以读到COM的相关信息了。
全部代码如下：
function DllRegisterServer: HResult;
var
lp: pchar;
ns: Dword;
begin
Result := S_FALSE;
Reg := TRegistry.Create;
GetMem(lp, 255);
try
Reg.RootKey := HKEY_CLASSES_ROOT;
if Reg.OpenKey('\MyCOM.MyCOMTest',true) then
begin
Reg.CreateKey('CLSID');
if Reg.OpenKey('CLSID',true) then
Reg.WriteString('',GUIDToString(Class_MyCOM));
end;
if Reg.OpenKey('\CLSID\' + GUIDToString(Class_MyCOM), true) then
begin
if Reg.CreateKey('InprocServer32') = false or
Reg.CreateKey('ProgID') = false or
Reg.CreateKey('TypeLib') = false or
Reg.CreateKey('Version') = false then
Exit;
Reg.WriteString('','MyCOM');
if Reg.OpenKey('\CLSID\' + GUIDToString(Class_MyCOM) +
'\InprocServer32', false) then
begin
Windows.GetModuleFileName(HInstance,lp, 255);
Reg.WriteString('', lp);
Reg.WriteString('ThreadingModel', 'Single');
end;
if Reg.OpenKey('\CLSID\' + GUIDToString(Class_MyCOM) + '\ProgID', false) then
Reg.WriteString('','MyCOM.MyCOMTest');
if Reg.OpenKey('\CLSID\' + GUIDToString(Class_MyCOM) + '\Version', false) then
Reg.WriteString('','1.0');
if Reg.OpenKey('\CLSID\' + GUIDToString(Class_MyCOM) + '\TypeLib', false) then
Reg.WriteString('',GUIDToString(LIBID_MyCOM));
Reg.CloseKey;
Result := S_OK;
end;
finally
begin
FreeMem(lp);
Reg.Free;
end;
end;
end;
函数DllUnregisterServer 则向系统注销一个COM的注册信息。它比较简单，直接把COM的相关注册键给删除就是：
function DllUnRegisterServer: Hresult;
begin
Result := S_False;
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CLASSES_ROOT;
Reg.DeleteKey('\CLSID\' + GUIDToString(Class_MyCOM));
Reg.CloseKey;
Finally
Reg.Free;
end;
end;
