用DELPHI建立多线程COM服务器

一、建立com服务端

1、建立服务端应用程序

首先在Delphi的集成环境中建立服务端应用程序。点击File|New菜单下的New Application选项建立Delphi应用程序。此时Delphi会产生一个空白的窗体以及初始化程序单元，点击File|Save All，在出现的保存对话框中设置好保存路径,即将文件存放在staserver目录中，并将程序单元文件以serverunit1为名保存，类似地将项目文件以staserverpro为名保存。

为更形象地看到客户程序访问服务器的情况，设计应用程序服务器主窗体如图2示，在主窗体上放置一个Tlable标签，将其Caption属性设为“Automation应用程序服务器”，而将主窗体Caption属性设为“Automation Server”。

图2 Automation服务器窗体

2、建立automation对象

点击File|New菜单下的other选项，弹出New Items窗口，选择Activex页，选中Automation Object选项，点击OK按钮。当Delphi显示Automation Object Wizard对话框时，请按图3所示设置信息，将CoClass Name设为staobject，线程模型设定为Apartment，而且允许有多个客户端应用程序同时使用它，点击OK按钮。

图3 Atuomation 对象设置对话框

此时Delph会自动产生Type Library编辑器，我们在其中加入一个方法FooStatus，请按如图4所示顺序进行设置。

图4 接口方法的声明

这个方法主要实现在接受客户的调用后，延迟若干秒后回传一个结果字符串。在这个回传的字符串中会叙述是那一个应用服务器的线程服务了客户端对于FooStatus的调用，它的起始时间及结束时间。FooStatus的程序代码如下：

procedure Tstaobject.FooStatus(delay: SYSINT; var sResult: WideString);

var

istarttime,iendtime:integer;  //开始时间，结束时间

begin

randomize;

istarttime:=gettickcount;   //取得目前系统时间，作为起始时间

while (gettickcount – istarttime< delay) do   //延时

begin

;

end;

iendtime:=gettickcount;   //取得目前系统时间，作为结束时间

sresult:=format(‘服务花了%s秒在服务器线程%d开始时间是%d结束时间是%d’,                     [floattostr(delay/1000.0),getcurrentthreadid,istarttime,iendtime]); //服务器执行状态

end;

单元文件uses部分的内容：

uses

ComObj, ActiveX, staserverpro_TLB, StdVcl,

Windows, Classes,Dialogs,Messages, SysUtils, Controls,StdCtrls;

保存文件，将此单元文件以STAObjectImpl为名保存。然后运行程序，注册该COM服务器。

至此，我们已经建立了COM服务端，但读者若读过李维的《Delphi 5.x分布式多层应用系统篇》一书想必都知道这个COM服务器目前还事实上是单线程的，原因就是对于Apartment线程模式而言，“一个应用程序服务器可以有许多不同的Apartment。而在每一个Apartment之中可以有许多的COM对象。但在任何时间，在每一个Apartment之中只能有一个线程在执行。这个意思是说，每一个Apartment在同一时间只能服务一个客户端的调用”。“所以如果一个应用程序服务器虽然是使用Apartment线程模式，但是如果应用程序服务器只建立一个Apartment线程的话，那么它仍然一次只能服务一个客户端”^[1]。叙述得非常精采。我们现在来建立客户端，看看到底是怎么回事。

二、建立客户端

1、建立客户端应用程序

为了便于调试，我们将应用程序服务器和客户端应用程序置于同一个项目组（Project Group）中。为此，在保持打开服务端编辑环境的情况下，点击View|Project Manager菜单，在弹出的Project Manager窗口中点击上方的New按钮，如图5所示,并且选择建立一个新的应用程序。

图5 在工程管理窗口中建立一个新的工程作为客户端应用程序

点击File|Save All菜单，在出现的保存对话框中设置好保存路径，即将文件保存在staclient目录中，将程序单元文件以clientunit1为名保存，将项目文件以staclientpro为名保存，将项目组以statestprogroup为名保存。

在客户端主窗体上放置一个Tmemo控件和一个Tbotton控件，效果如图6所示。

图6 客户端窗体

2、导入类型库

客户端应用程序需要用到前面的类型库，点击Project|Import Type Library打开导入类型库对话框，如图7所示。

图7 导入类型库对话框

在导入类型库对话框的上半部分显示的是已经在Windows系统中注册的所有类型库，图9中选中的就是本文所做的类型库，它的类名是Tstaobject。选中了这个列出的类型库后，单击Create Unit按钮，就可以将此类型库导入到工程中，而且自动生成相应的单元文件。

选中clientunit1单元，点击File|Use Unit菜单，选中staserverpro_TLB，引用此类型库文件。接下来在程序中加入调用服务器端FooStatus方法的代码，双击主窗体上的Botton按钮，编写代码如下：

procedure TForm2.Button1Click(Sender: TObject);

var

str:widestring;

Server: ISTAObject;     //引用接口

begin

memo1.Lines.Add(‘current client thread is ‘+inttostr(getcurrentthreadid));

Server := CoSTAObject.Create;   //创建接口对象实例

server. FooStatus (3000,str);   //调用方法

memo1.Lines.Add(str);

 

Server := CoSTAObject.Create;

server. FooStatus (3000,str);

memo1.Lines.Add(str);

 

Server := CoSTAObject.Create;

server. FooStatus (3000,str);

memo1.Lines.Add(str);

end;

现在运行程序，结果如图8所示:

图8 程序运行结果

从图10程序的执行情况可知，服务端确实只产生了一个线程。所有的任务是依次执行的，所化时间总共是18.045秒。

三、建立线程单元

现在来改变这种状况，通过加入一个线程类，来实现服务端的多线程，以使应用程序服务器针对许多的客户端请求，可以同时建立相应的apartment来服务这些客户端。在Project Manager窗口中,双击staserverpro.exe，切换至服务端。点击File|New菜单下的other选项，弹出New Items窗口，选择New页中选择Thread Object选项，点击OK按钮。当Delphi显示New Thread Object对话框时，在Class Name中输入TApartmentThread，点击OK按钮，此时Delph会自动产生一个单元文件，点击Save All,将此单元文件以STAThread为名保存。STAThread单元程序代码（节选）如下：

unit STAThread;

interface

uses

ComObj, ActiveX, Classes, Windows, Dialogs;

Type

//针对建立的不同COM服务器，创建相应的实例，本文建立的是Automation服务器，所以应使用

//TAutoObjectFactory

TAutoObjectFactory2 = class(TAutoObjectFactory, IClassFactory)

protected

//在一个独立的线程中创建Automation对象

function CreateInstance(const UnkOuter: IUnknown;

const IID: TGUID; out Obj): HResult; stdcall;

end;

//创建的TapartmentThread线程类

TApartmentThread = class(TThread)

private

FFactory: IClassFactory2;

FUnkOuter: IUnknown;

FIID: TGuid;

FSemaphore: THandle;

FStream: Pointer;

FCreateResult: HResult;

protected

procedure Execute; override;

public

constructor Create(Factory: IClassFactory2;

UnkOuter: IUnknown; IID: TGuid);

destructor Destroy; override;

property Semaphore: THandle read FSemaphore;

property CreateResult: HResult read FCreateResult;

property ObjStream: Pointer read FStream;

end;

 

implementation

uses

SysUtils;

 

{ TAutoObjectFactory2 }

function TAutoObjectFactory2.CreateInstance(const UnkOuter: IUnknown;

const IID: TGUID; out Obj): HResult;

begin

//确定不是一个进程内服务器并且这个服务器是STA模式的

if not IsLibrary and (ThreadingModel = tmApartment) then

begin

LockServer(True);

try

//创建线程

with TApartmentThread.Create(Self, UnkOuter, IID) do

begin

//等待线程创建COM对象

if WaitForSingleObject(Semaphore, INFINITE) = WAIT_OBJECT_0 then

begin

Result := CreateResult;

if Result <> S_OK then Exit;

//如果一切就绪，从流中unmarshal接口

Result := CoGetInterfaceAndReleaseStream(IStream(ObjStream), IID, Obj);

end

else

Result := E_FAIL

end

finally

LockServer(False)

end

end

else

//如果是进程内服务器并且不是STA，则按通常的方式建立

Result := inherited CreateInstance(UnkOuter, IID, Obj);

end;

 

{ TApartmentThread }

constructor TApartmentThread.Create(Factory: IClassFactory2;

UnkOuter: IUnknown; IID: TGuid);

begin

inherited Create(True);

FFactory := Factory;

FUnkOuter := UnkOuter;

FIID := IID;

//线程同步

FSemaphore := CreateSemaphore(nil, 0, 1, nil);

FreeOnTerminate := True;

//设置好所有线程属性后，开始线程

Resume

end;

 

destructor TApartmentThread.Destroy;

begin

CloseHandle(FSemaphore);

inherited Destroy;

end;

 

procedure TApartmentThread.Execute;

var

Msg: TMsg;

Unk: IUnknown;

function FinalRefCount: Integer;

begin

//Return 0 on Win95 (Windows version 4.0)

if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and

(Win32MajorVersion = 4) and (Win32MinorVersion = 0) then

Result := 0

else

Result := 1

end;

begin

try

CoInitialize(nil);    //进入STA

try

//创建对象

FCreateResult := FFactory.CreateInstanceLic(FUnkOuter, nil, FIID, ”, Unk);

FUnkOuter := nil;

FFactory := nil;

//Marshal接口以使能在不同的线程模型间传递这个接口

if FCreateResult = S_OK then

CoMarshalInterThreadInterfaceInStream(FIID, Unk, IStream(FStream));

//允许工厂读取接口

ReleaseSemaphore(FSemaphore, 1, nil);

if FCreateResult = S_OK then

while GetMessage(Msg, 0, 0, 0) do    //启动消息池

begin

DispatchMessage(Msg);

Unk._AddRef;

if Unk._Release = FinalRefCount then

Break;

end;

finally

Unk := nil;

CoUninitialize;     //离开STA

end;

except

// No exceptions should go unhandled

end;

end;

end.

在Project Manager窗口中,双击单元文件STAObjectImpl，然后点击File|Use Unit，对出现的对话框中选择STAThread单元，即在STAObjectImpl中加入对STAThread单元的引用。另外，相应地需要对STAObjectImpl单元中实现对象的代码进行改动，即：将

initialization

TAutoObjectFactory.Create(ComServer, Tstaobject, Class_staobject,

ciMultiInstance, tmApartment);

改为：

initialization

TautoObjectFactory2.Create(ComServer, Tstaobject, Class_staobject,

ciMultiInstance, tmApartment);

这一步很关键，这是为了和STAThread单元中定义的对象实例名保持一致。

运行服务端应用程序一遍，重新注册COM服务器。

在Project Manager窗口中,双击staclientpro，切换至客户端。再次运行程序，结果如图9所示。这回可以发现服务端产生了三个线程来响应了。

图9 程序运行结果

但同时我们也发现程序运行所使用的总时间是9.865秒，而不是我们在本文开头所提到的3至4秒，这个问题是由于到目前为止，客户端程序是以单线程的方式实现的。如果在客户端能以多线程的方式来调用服务端的FooStatus方法，那么本文开头的问题也就解决了。关于客户端多线程访问的实现，以及在分布式环境中的情况，限于篇幅，不在本文中展开，感兴趣的读者可以去尝试实现一下，笔者也将另外撰文予以介绍。

四、有关说明

1、本文所讨论的内容是个老问题，李维先生在《Delphi 5.x分布式多层应用系统篇》一书中对此有详细而精彩的论述，但该书是针对Delphi熟练使用者和较熟悉COM编程的读者而写的，重在讲解原理，而对具体实现部分，则一笔带过。所以，对初学delphi或对COM编程技术理解不是太深入的读者而言，其困难是不言而喻的。笔者就在此问题上困扰了很长一段时间。从各论坛讨论的情况，网友中对此不甚了了的也大有人在，所以本文就算作对李先生著作的一个补充说明吧！希望对COM编程有兴趣的读者能有所帮助。

2、对（Remote Data Model）的解释，笔者认为也是李先生所没有交代清楚的，对实现STA线程模型的两段关键代码的出处没有点明。所以，也给读者带来一些困惑，其实，当我们在Delphi中利用向导建立远程数据模块时，在实现代码的uses部分中，我们可以发现一个名为VCLCom的运行库，在…/Borland/Delphi 6/source/rtl/common目录下找到这个文件，在Delphi环境中打开后，我们发现了在本文中讨论过的所有代码，即“由Delphi 5建立的远程数据模块是真正使用STA线程模型建立的COM对象”。读者可以在远程数据模块中进行与本文类似的测试。