COM基础（二）

最新推荐文章于 2024-09-20 21:10:07 发布

hstod

最新推荐文章于 2024-09-20 21:10:07 发布

阅读量933

点赞数

分类专栏： Delphi 文章标签： delphi 服务器 integer interface function server

Delphi 专栏收录该内容

4 篇文章 0 订阅

订阅专栏

1.4自动化（Automation）
在前面我们介绍的程序中，调用COM对象的客户端程序必须引用接口定义才能建立和访问COM组件，但是一些脚本语言（例如VBScript、JavaScript）中无法引用，那么如何让它们可以调用COM对象的接口呢？方法是使用自动化，自动化(以前叫OLE自动化)是应用程序或动态链接库(DLL)输出对象给其他应用程序的手段。输出对象的应用程序或DLL称为自动化服务器(Automation Server)。访问和控制自动化服务器的应用程序称为自动化控制器(Automation Controller)。自动化控制器采用类似于宏命令的方式来对自动化服务器进行操作。自动化的最大优势是它的语言无关性。一个自动化控制器可以控制任何一种语言开发的自动化服务器。而自动化服务器中输出的对象可以通过编程语言或者脚本来访问。另外，自动化是操作系统支持的功能，随着操作系统的改进，自动化技术也会不断进步。下面就来介绍在Delphi中如何创建自动化服务器和自动化控制器。

1.4.1 IDipatch接口
自动化对象在本质上是一种实现IDispatch接口的COM对象。在System单元中，IDispatch 是这样定义的：

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;

IDispatch的核心函数是Invoke()。当客户获取了一个自动化服务器的IDispatch指针后，它就可以调用Invoke()方法来执行自动化服务器上的一个方法。DispID参数指定了要执行的方法的调度号(dispatch ID)。IID参数目前未用。LocaleID参数包含了语言信息。Flags 参数描述了要执行的方法的类型(一般的方法、属性的读访问方法/写访问方法)。Params属性包含了一个指针，指向一个TDispParams数组，指定了要传递给方法的参数。VarResult参数是一个指向OleVariant的指针，用于返回所调用方法的返回值。ExcepInfo是一个指向TExcepInfo记录的指针，如果Invoke()返回DISP_E_EXCEPTION，则这个记录包含了错误信息。如果Invoke()返回DISP_E_TYPEMISPATCH或DISP_E_PARAMNOTFOUND，ArgError参数是指向一个整数的指针，该整数表示Params 数组中哪个参数导致了错误。
IDispatch接口的GetIDsOfNames()方法用于根据给出的名称来得到一个或多个方法的调度号。IID参数目前未用。Names参数是一个PWideChar类型的数组，用于给出一个或多个方法名。NameCount参数用于指定Names数组中实际的方法名称数。LocaleID包含了语言信息。最后一个参数DispIDs是一个整型数组，返回每个方法的调度号。GetTypeInfo()方法用于获取自动化对象的类型信息(关于类型信息后面再讲)。Index参数代表了要获取的信息的类型，通常设为0 。LCID参数包含了语言信息。如果这个方法调用成功，TypeInfo参数就是一个ITypeInfo指针，指向自动化对象的类型信息。
GetTypeInfoCount()方法返回自动化对象所支持的类型信息接口的数量。参数Count只能取两个值：0 表示自动化对象不支持的类型信息；1 表示自动化对象支持类型信息。

1.4.2 先期绑定与后期绑定
我们首先来创建一个简单的自动化客户端程序：

procedure TForm1.Button1Click(Sender: TObject); //代码片断1
var
V:Variant;
begin
V:=CreateOLEObject('Word.Application');
V.Quit;
end;

要运行上面的代码，首先需要在Uses中加入对comobj的引用。运行程序，上面的代码十分简单，就是调用CreateOLEObject函数启动自动化服务器Word，然后关闭Word。
再看下面的代码：

procedure TForm1.Button1Click(Sender: TObject); //代码片断2
var
V:TWordApplication;
begin
V:= TWordApplication.Create(Self);
V.Quit;
end;

运行上面的代码之前需要在Uses中加入对Word97，OLEServer的引用。代码片断2的作用同前面的代码是一样。但是代码片断2的方法称为先期绑定(Early Binding)，先期绑定方式就是指对接口方法的所有调用在编译时检查参数是否正确，例如我们在语句代码片断中添加： V.NotInWord 。显然，NotInWord方法不会是TWordApplication类的方法，那么在程序执行前就会出错。
现在来看代码片断1，我们在定义中将V定义为Variant类型变量，也就是说，Delphi并不把V当作一个对象，那么如何在这个"对象"中调用方法呢？答案是使用后期绑定(Late Bindind)，使用后期绑定时，Delphi并不会对对象以及对象方法在编译时进行检查。例如，如果在代码片断1中添加语句：

V.NotInWord

程序在编译时并不会出错，但是在执行时会产生"method NotInWord not supported by automation object"错误。
那么在自动化服务器中是如何实现后期绑定的呢？所谓后期绑定指的是通过IDispatch的Invoke()调用的自动化方法。之所以称之为后期绑定，是因为方法调用是在运行期确定的。在编译期，只是把方法的有关参数传递给IDispatch. Invoke()，只有到了运行期才执行具体的方法。当通过一个Delphi变量或OLE变量调用一个自动化方法的时候，其实就是在使用后期绑定，因为Delphi必须要调用IDispatch.GetIDsOfNames()把方法名转换为一个DispID，然后再根据这个DispID，用IDispatch.Invoke()调用这个方法。
前期绑定发生在自动化对象通过一个继承于IDispatch的接口显露其方法的时候。这时客户就不需要通过IDispatch.Invoke()而可以直接调用自动化对象，这就比通过后期绑定来调用更快一些。当使用Delphi的接口调用一个方法的时候就使用了前期捆绑。
如果一个自动化对象既支持通过Invoke()来调用方法，也支持通过IDispatch的派生接口调用方法，我们就称这个自动化对象支持双重接口(dual interface)。Delphi生成的对象都支持双重接口，既可以用Invoke()来调用方法，也可以直接通过接口调用方法。在下面的程序中我们将会看到如何双接口的实现。

1.4.3 建立自动化服务器
  我们首先来建立一个自动化服务器程序，然后通过程序对自动化做更进一步的了解。
  在Delphi中选择菜单项 File | New，然后在New Items窗口中转到ActiveX页面，点击ActiveXLibrary图标后按 OK 按钮建立一个COM组件工程。
  然后再选择菜单项 File | New，打开New Items窗口，在ActiveX页面中点击 Automation Object 图标后点击 OK 按钮，Delphi会弹出Automation Object Wizard窗口，在 CoClass Name 文本框内我们输入SimpAuto，然后点击 OK 按钮，Delphi就会自动添加一个支持双接口的COM组件框架到工程中。然后保存工程，将Unit1保存为OLEUnit.pas，将工程保存为prjOLEServer.dpr。然后编译工程，并点击菜单项 Run | Register ActiveX Server 注册自动化服务器对象，注册成功后会弹出如下的对话框提示注册成功：

打开工程中的文件 prjOLEServer_TLB，在其中会有一行定义一行定义COM对象GUID的语句：
CLASS_SimpOLE: TGUID = '{713ADEDE-C8DE-4E99-8A40-E4F283FBE0C7}';
具体的GUID值会有区别，运行RegEdit，打开注册项HKEY_CLASSES_ROOT/CLSID/ {713ADEDE-C8DE-4E99-8A40-E4F283FBE0C7}。在其下的ProgID项的默认值为prjOLEServer.SimpAuto，该值就是自动化服务器对象的调用名称。
现在我们可以在其它的支持自动化的编程环境中调用自动化服务器对象了。在这里我们使用VB。打开VB，在Form1中添加一个CommandButton控件，然后在控件的Click事件中输入以下代码：

Dim x As Object

Set x = CreateObject("prjOLEServer.SimpAuto")
Debug.Print TypeName(x)
Set x = Nothing

运行程序，点击Command1，你就会在Debug窗口看到建立的对象的类名称：SimpAuto。这说明我们建立的自动化服务器对象已经在VB中被成功的调用。
现在我们给这个自动化服务器添加一些方法。我们还是使用上面的工程。在通过Delphi自动生成COM组件或者自动化服务器组件后，Delphi会自动生成一个类型库文件，其中包含了COM对象中所有的接口定义，包括接口以及其中定义的方法等。当编译工程后，会生成一个以tlb为后缀的二进制的类型库定义文件。类型库有以下的好处：
l  编写自动化组件时的先期绑定
l  许多编程工具可以从一种类型库中自动生成针对该编程语言的代码，例如Delphi。
l  一些实用程序，例如MS Visual Studio 中的 OLE View 可以读取包含类型库的COM服务器的信息。
l  在COM服务器和客户端之间的自动参数调用。

选择Delphi菜单的 View | Type Library 项打开类型库浏览器，通过类型库浏览器来向接口定义中添加方法。类型库浏览器是编写COM组件中一个很重要的工具，通过它可以浏览、修改几乎COM组件中的一切，例如添加、删除接口定义，添加、删除方法等。对于它的使用在本书中不做介绍，大家可以参考Delphi的帮助文件。在类型库浏览器中左边的列表中我们可以看到接口ISimpAuto以及CoClass 类SimpAuto。选择ISimpAuto，然后点击工具栏中的 Add Method 按钮为ISimpAuto接口添加一个新的方法，然后将该方法的名称设定为 Wait。然后转到Paramaters页面为Wait方法参数。
对于传递到服务器的参数。一些参数只被服务器使用，服务器并不会改变它们的值，所以该值就不必再回传到客户端。这种类型的参数称为输入参数，在Modifer中应该被定义为[in]。
此外，有一些数值是从服务器端传递到客户端。不需要把这些值从客户端发送到服务器中，这种参数称为输出参数，在Modifer中应该被定义为[Out]。
还有就是参数需要客户端和服务器端访问和修改，这种参数称为可变参数。它们类似于Delphi中函数参数中的var类型的参数，在Modifer中应该被定义为[RetVal]。
另外还有可选参数，客户端的调用中可以设定该参数，也可以不设定，这种参数在Modifer中应该被定义为[Optional]。
有的参数有缺省值，它们在这种参数在Modifer中应该被定义为[Has Default Value]

对于Wait方法，我们需要添加一个实现延迟的参数SleepTime，参数定义为long类型，Modifer定义为[in]。另外添加返回参数Result，参数类型定义为Variant*，参数的Modifer定义为[out , retval]。在定义接口方法时，如果该方法有返回值，只需要按照上面的方法定义一个名称为Result的参数就可以了。设定完毕的类型库浏览窗口界面如下图所示：

点击刷新按钮刷新更改，然后关闭类型库浏览器并保存文件。打开OLEUnit，在uses中加入对Windows的引用。在TSimpAuto的Wait方法中添加以下的代码：

Sleep(SleepTime*1000);

OLEUnit代码如下：

unit OLEUnit;

interface

uses
ComObj, ActiveX, prjOLEServer_TLB, StdVcl;

type
TSimpAuto = class(TAutoObject, ISimpAuto)
protected
function Wait(Sleep: Integer): OleVariant; safecall;
{ Protected declarations }
end;

implementation

uses ComServ;

function TSimpAuto.Wait(SleepTime: Integer): OleVariant;
begin
Sleep(SleepTime*1000);
end;

initialization
TAutoObjectFactory.Create(ComServer, TSimpAuto, Class_SimpAuto,
ciMultiInstance, tmApartment);
end.

从代码中可以看到，TSimpAuto类是从TAutoObject类中继承而来的，TAutoObject是实现了IDispatch接口的类，它是Delphi中自动化服务器的基础类。而TAutoObject类的类工厂是TAutoObjectFactory类。
现在打开prjOLEServer_TLB，其中我们可以看到两个接口的定义，ISimpAutoy以及ISimpAuto：

ISimpAuto = interface(IDispatch)
['{62D08846-4575-4361-90CC-410854545B20}']
function Wait(Sleep: Integer): OleVariant; safecall;
end;

ISimpAutoDisp = dispinterface
['{62D08846-4575-4361-90CC-410854545B20}']
function Wait(Sleep: Integer): OleVariant; dispid 1;
end;

这两个接口一个定义为IDispatch继承接口，一个定义为dispinterface。这两个接口的GUID相同，接口中函数的定义也类似，只是ISimpAuto中的函数定义为safecall。Safecall是对类型库编辑器中输入的方法的默认调用约定方式，事实上Safecall不仅是一种调用约定方式，它还隐含了两件事情：第一，方法将按Safecall调用约定方式被调用；第二，方法将被封装以便向调用者返回一个HResult 值。例如，在前面的代码中定义的Wait方法：

function Wait(SleepTime: Integer): OleVariant; safecall;

该方法被编译后，成为如下代码：

function Wait(SleepTime: Integer, out Retval OleVariant): HResult; stdcall;

safecall的好处在于它能捕捉所有的异常情况。如果这个方法中未被处理的异常被触发，则这个异常将被服务器处理并转换为HResult 值返回给调用者。自动化所有的方法都必须返回一个HResult，指示该方法是成功了还是失败了。所有其他的返回值都必须将其作为方法的参数，Modify定义为out类型。
而ISimpAutoDisp中的函数定义为dispid 1。ISimpAutoDisp被称为派遣接口。这种接口的方法可以通过Invoke()来调用。派遣接口只是为方便用户而设定的，实际上并没有在自动化服务器中实现派遣接口的代码。是服务器本身实现了该接口。假设服务器支持IDispatch接口，客户端应用程序就可以选择以便使用variants或者派遣接口连接到自动化服务器。如果要使自己的代码与VB兼容的话，就必须使用派遣接口。

1．4．4 建立客户端程序
建立一个新的Application，将工程保存为Clientprj.dpr，将Unit1保存为ClientUnit.pas。在Form1中添加两个TButton控件。然后选择菜单 Project | Import type library。在Import type library窗口中点击 Add 按钮，然后在打开文件窗口中选择服务器工程建立的类型库文件 projOLEServer.tlb 后点击打开按钮。类型库就会添加到列表中：

点击 Create Unit 按钮，Delphi就会新建立一个名称为prjOLEServer_TLB的文件，如果仔细察看文件的话，可以发现这个文件同服务器工程中的prjOLEServer_TLB是完全一样的。同样，如果利用VB或者VC生成了类型库的话，Delphi也可以根据类型库生成代码。
在客户端，我们可以使用不同的方式连接到服务器：

  var
   Intf:ISimpAuto;
   IntfDisp:ISimpAutoDisp;
Var:OLEVariant;
  Begin
   FIntf:=CoSimpAuto.Create;
FIntfDisp:=CreateComObject(CLASS_SimpAuto)as ISimpAutoDisp;
   FVar:=CreateOLEObject('prjOLEServer.SimpAuto');

代码显示了接口、调度接口、OleVariant变量分别以不同的方式创建了自动化服务器的实例。
添加一个TButton按钮到Form1，然后添加在Button1的OnClick事件中添加如下代码：

procedure TForm1.Button1Click(Sender: TObject);
var
FIntf:ISimpAuto;
begin
FIntf:=CoSimpAuto.Create;
Button1.Caption := 'OnLine';
FIntf.Wait(5);
Button1.Caption := 'OffLine';
end;

运行程序，点击Button1，你就可以看到程序被延迟了5秒钟。
通过Delphi建立的服务器程序同样可以在VB或者诸如VBScript这样的脚本语言中调用，例如下面的HTML页面代码。

<HTML>
<HEAD>
<script language="VBScript">
Function GetInto()
Set xDoc=window.document
xDoc.write "Load...请等待3秒钟"
set objSamp=CreateObject("prjOLEServer.SimpAuto")
objSamp.Wait(3)
window.navigate "http://www.applevb.com"
End Function
</script>

</HEAD>

<BODY>
<p><a href="VBScript:GetInto" ><br>
进入新页面</a></b></span></p>
</BODY>
</HTML>

当点击超链接"进入新页面"后，页面中会显示 Load...请等待3秒钟。等待3秒钟后会进入新页面 http://www.applevb.com。

1.5建立支持事件的自动化服务器对象
在之前所介绍的COM服务器与客户端之间的通信都是单向的：客户端调用服务器端的方法。在这一节我们将学习如何实现在自动化服务器中实现事件。
自动化中的事件是通过接口来实现的，这里的接口常被称为事件接口或输出接口(outgoing interface)。之所以称之为输出接口，是因为它不像别的接口那样是由服务器实现的，而是由服务器的客户端来实现；接口的方法从服务器端被外调到了客户端。像所有的接口一样，每个事件接口都有其相应的IID(接口标识符)以唯一地标识它们。另外在自动化对象的类型库中能够找到事件接口的描述。
现在让我们建立一个支持事件的自动化服务器框架。首先建立一个新的Application，然后选择菜单 File | New ，在 New Items 窗口的 ActiveX 页面中选择 Automation Object后点击 OK 按钮，在Wizard窗口中的CoClass Name 文本框中输入类名称：MySamp。然后选中 Generator Event Support Code 复选框。点击 OK 按钮，Delphi就会自动建立一个自动化服务器类：TMySamp，可以看到，TMySamp类的定义如下：

type
TMySamp = class(TAutoObject, IConnectionPointContainer, IMySamp)
private
{ Private declarations }
FConnectionPoints: TConnectionPoints;
FConnectionPoint: TConnectionPoint;
FSinkList: TList;
FEvents: IMySampEvents;
public
procedure Initialize; override;
protected
{ Protected declarations }
property ConnectionPoints: TConnectionPoints read FConnectionPoints
implements IConnectionPointContainer;
procedure EventSinkChanged(const EventSink: IUnknown); override;
end;

同上面介绍的自动化类不同的是，TMySamp还实现了IConnectionPointContainer接口，接口的定义如下：

IConnectionPointContainer = interface
['{B196B284-BAB4-101A-B69C-00AA00341D07}']
function EnumConnectionPoints(out Enum: IEnumConnectionPoints): HResult;
stdcall;
function FindConnectionPoint(const iid: TIID;
out cp: IConnectionPoint): HResult; stdcall;
end;

在COM中，连接点(connection point)描述了一个实体，该实体提供了对输出接口的访问。如果客户端要判断一个服务器是否支持事件，就必须用QueryInterface函数查询IConnectionPointContainer接口。如果这个接口存在，那么服务器就支持事件。接口中的EnumConnectionPoints()方法供客户端遍历服务器支持的所有输出接口。客户端可以用FindConnectionPoint()方法得到一个指定的输出接口。
你还会注意到，FindConnectionPoint()方法的输出参数cp是一个IConnectionPoint接口，它代表一个输出接口。IConnectionPoint接口定义如下：

IConnectionPoint = interface
['{B196B286-BAB4-101A-B69C-00AA00341D07}']
function GetConnectionInterface(out iid: TIID): HResult; stdcall;
function GetConnectionPointContainer(out cpc: IConnectionPointContainer): HResult;
stdcall;
function Advise(const unkSink: IUnknown; out dwCookie: Longint): HResult; stdcall;
function Unadvise(dwCookie: Longint): HResult; stdcall;
function EnumConnections(out Enum: IEnumConnections): HResult; stdcall;
end;

IConnectionPoint接口中的GetConnectionInterface()方法提供了这个连接点支持的输出接口的IID。GetConnectionPointContainer ()方法提供了管理该连接点的接口IConnectionPointContainer。而Advise方法的工作实际上就是把服务器中的向外输出的事件引入客户端的事件接口。该方法的第一个参数是客户端的事件接口实例，第二个参数将接收一个标识这个连接的cookie。Unadvise()只是断开了由Advise()建立的客户/服务器模式的连接。EnumConnections()方法供客户端遍历当前所有处于活动状态的连接，即所有调用了Advise()的连接。
如果我们在这里仍用客户和服务器描述两者的关系，很显然会造成混淆，因此自动化定义了一些不同的术语。包含在客户程序中的输出接口实现被称为接收器(sink)，而向客户端触发事件的服务器对象被称为源(source)。与Delphi事件相比，自动化事件有两点优势。首先，它们能够实现多点广播，因为IConnectionPoint的Advise方法能够被调用多次。另外，自动化事件是自描述的(通过类型库和枚举方法)，这样就可以动态地控制它们。

1.5.1建立服务器端程序
下面我们建立自动化服务器应用程序，这个自动化服务器是一个进程外服务器(Out-Of-Process COM Server)。进程外COM服务器是在EXE中实现的，而不是在DLL中。因此，它们在来自客户应用程序的独立地址空间运行。
进程外COM服务器不输出进程内COM服务器所需的4个函数。所以它在Windows注册表中使用不同的注册方法。要注册一个进程外COM服务器，只需要运行服务器程序。将 /regserver 放在命令行中。Delphi将注册服务器和COM对象，然后退出。要撤销注册服务器，使用 /unregserver作为运行参数。
如果正常运行服务器，Delphi也将注册它。只是服务器应用程序将会继续运行。
首先建立一个新的Application，然后然后选择菜单 File | New ，在 New Items 窗口的 ActiveX 页面中选择 Automation Object后点击 OK 按钮，在Wizard窗口中的CoClass Name 文本框中输入类名称：ChartServer。然后选中 Generator Event Support Code 复选框。点击 OK 按钮，Delphi就会自动建立一个自动化服务器类：TChartServer。
保存工程，在Form1上添加一个ListBox控件并将Form1保存为MainForm.pas，将包含TChartServer类的Unit保存为ChartSource.pas，将工程保存为ChartServer.dpr。
打开类型库浏览器，可以看到其中包含接口IChartServer以及派遣接口IChartServerEvents，其中IChartServer接口用于COM对象，派遣接口是用于事件被对象激活的事件。
首先我们给IChartServer接口添加一个名为SendMessage的方法，并添加一个参数Message，参数类型为BSTR。给派遣接口IChartServerEvents添加一个EventMessage方法，方法的返回值为void（在Return type下拉框中没有Void，你可以直接输入）。并添加一个参数Message，参数类型为BSTR，Modify为空。设定完毕的类型库浏览窗口如下图所示：

打开ChartSource.pas，在TChartServer.SendMessage事件中输入以下代码：

procedure TChartServer.SendMessage(const Message: WideString);
begin
Form1.ListBox1.Items.Add(Message);
FEvents.EventMessage(Message);
end;

代码的含义是：当执行sendMessage方法后，将消息保存到ListBox1中然后引发EventMessage事件。
ChartSource.pas以及ChartServer_TLB.pas的完整代码如下：

程序清单 1-9 ChartSource.pas
unit ChartSource;

interface

uses
ComObj, ActiveX, AxCtrls, Classes, ChartServer_TLB, StdVcl,MainForm;

type
TChartServer = class(TAutoObject, IConnectionPointContainer, IChartServer)
private
{ Private declarations }
FConnectionPoints: TConnectionPoints;
FConnectionPoint: TConnectionPoint;
FSinkList: TList;
FEvents: IChartServerEvents;
public
procedure Initialize; override;
protected
{ Protected declarations }
property ConnectionPoints: TConnectionPoints read FConnectionPoints
implements IConnectionPointContainer;
procedure EventSinkChanged(const EventSink: IUnknown); override;
procedure SendMessage(const Message: WideString); safecall;
end;

implementation

uses ComServ;

procedure TChartServer.EventSinkChanged(const EventSink: IUnknown);
begin
FEvents := EventSink as IChartServerEvents;
if FConnectionPoint <> nil then
FSinkList := FConnectionPoint.SinkList;
end;

procedure TChartServer.Initialize;
begin
inherited Initialize;
FConnectionPoints := TConnectionPoints.Create(Self);
if AutoFactory.EventTypeInfo <> nil then
FConnectionPoint := FConnectionPoints.CreateConnectionPoint(
AutoFactory.EventIID, ckSingle, EventConnect)
else FConnectionPoint := nil;
end;

procedure TChartServer.SendMessage(const Message: WideString);
begin
Form1.ListBox1.Items.Add(Message);
FEvents.EventMessage(Message);
end;

initialization
TAutoObjectFactory.Create(ComServer, TChartServer, Class_ChartServer,
ciMultiInstance, tmApartment);
end.

程序清单 1-10 ChartServer_TLB.pas

unit ChartServer_TLB;

{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
interface

uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL;

// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
ChartServerMajorVersion = 1;
ChartServerMinorVersion = 0;

LIBID_ChartServer: TGUID = '{FA98CC76-B9F9-4484-AB91-32EC6869A22F}';

IID_IChartServer: TGUID = '{144F14CF-4214-495F-897A-4479F7D924EE}';
DIID_IChartServerEvents: TGUID = '{6AFB3BC1-1B30-45F2-941B-B2F662703083}';
CLASS_ChartServer: TGUID = '{DA942C9E-0B0A-4F8F-A58E-8A011CE3D24B}';
type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IChartServer = interface;
IChartServerDisp = dispinterface;
IChartServerEvents = dispinterface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
ChartServer = IChartServer;

// *********************************************************************//
// Interface: IChartServer
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {144F14CF-4214-495F-897A-4479F7D924EE}
// *********************************************************************//
IChartServer = interface(IDispatch)
['{144F14CF-4214-495F-897A-4479F7D924EE}']
procedure SendMessage(const Message: WideString); safecall;
end;

// *********************************************************************//
// DispIntf: IChartServerDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {144F14CF-4214-495F-897A-4479F7D924EE}
// *********************************************************************//
IChartServerDisp = dispinterface
['{144F14CF-4214-495F-897A-4479F7D924EE}']
procedure SendMessage(const Message: WideString); dispid 1;
end;

// *********************************************************************//
// DispIntf: IChartServerEvents
// Flags: (0)
// GUID: {6AFB3BC1-1B30-45F2-941B-B2F662703083}
// *********************************************************************//
IChartServerEvents = dispinterface
['{6AFB3BC1-1B30-45F2-941B-B2F662703083}']
procedure EventMessage(const Message: WideString); dispid 1;
end;

// *********************************************************************//
// The Class CoChartServer provides a Create and CreateRemote method to
// create instances of the default interface IChartServer exposed by
// the CoClass ChartServer. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoChartServer = class
class function Create: IChartServer;
class function CreateRemote(const MachineName: string): IChartServer;
end;

TChartServerEventMessage = procedure(Sender: TObject; var Message: OleVariant) of object;

// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TChartServer
// Help String : ChartServer Object
// Default Interface: IChartServer
// Def. Intf. DISP? : No
// Event Interface: IChartServerEvents
// TypeFlags : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
TChartServerProperties= class;
{$ENDIF}
TChartServer = class(TOleServer)
private
FOnEventMessage: TChartServerEventMessage;
FIntf: IChartServer;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps: TChartServerProperties;
function GetServerProperties: TChartServerProperties;
{$ENDIF}
function GetDefaultInterface: IChartServer;
protected
procedure InitServerData; override;
procedure InvokeEvent(DispID: TDispID; var Params: TVariantArray); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect; override;
procedure ConnectTo(svrIntf: IChartServer);
procedure Disconnect; override;
procedure SendMessage(const Message: WideString);
property DefaultInterface: IChartServer read GetDefaultInterface;
published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
property Server: TChartServerProperties read GetServerProperties;
{$ENDIF}
property OnEventMessage: TChartServerEventMessage read FOnEventMessage write FOnEventMessage;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object : TChartServer
// (This object is used by the IDE's Property Inspector to allow editing
// of the properties of this server)
// *********************************************************************//
TChartServerProperties = class(TPersistent)
private
FServer: TChartServer;
function GetDefaultInterface: IChartServer;
constructor Create(AServer: TChartServer);
protected
public
property DefaultInterface: IChartServer read GetDefaultInterface;
published
end;
{$ENDIF}

procedure Register;

implementation

uses ComObj;

class function CoChartServer.Create: IChartServer;
begin
Result := CreateComObject(CLASS_ChartServer) as IChartServer;
end;

class function CoChartServer.CreateRemote(const MachineName: string): IChartServer;
begin
Result := CreateRemoteComObject(MachineName, CLASS_ChartServer) as IChartServer;
end;

procedure TChartServer.InitServerData;
const
CServerData: TServerData = (
ClassID: '{DA942C9E-0B0A-4F8F-A58E-8A011CE3D24B}';
IntfIID: '{144F14CF-4214-495F-897A-4479F7D924EE}';
EventIID: '{6AFB3BC1-1B30-45F2-941B-B2F662703083}';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;

procedure TChartServer.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
ConnectEvents(punk);
Fintf:= punk as IChartServer;
end;
end;

procedure TChartServer.ConnectTo(svrIntf: IChartServer);
begin
Disconnect;
FIntf := svrIntf;
ConnectEvents(FIntf);
end;

procedure TChartServer.DisConnect;
begin
if Fintf <> nil then
begin
DisconnectEvents(FIntf);
FIntf := nil;
end;
end;

function TChartServer.GetDefaultInterface: IChartServer;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
Result := FIntf;
end;

constructor TChartServer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps := TChartServerProperties.Create(Self);
{$ENDIF}
end;

destructor TChartServer.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps.Free;
{$ENDIF}
inherited Destroy;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TChartServer.GetServerProperties: TChartServerProperties;
begin
Result := FProps;
end;
{$ENDIF}

procedure TChartServer.InvokeEvent(DispID: TDispID; var Params: TVariantArray);
begin
case DispID of
-1: Exit; // DISPID_UNKNOWN
1: if Assigned(FOnEventMessage) then
FOnEventMessage(Self, Params[0] {const WideString});
end; {case DispID}
end;

procedure TChartServer.SendMessage(const Message: WideString);
begin
DefaultInterface.SendMessage(Message);
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TChartServerProperties.Create(AServer: TChartServer);
begin
inherited Create;
FServer := AServer;
end;

function TChartServerProperties.GetDefaultInterface: IChartServer;
begin
Result := FServer.DefaultInterface;
end;

{$ENDIF}

procedure Register;
begin
RegisterComponents('Servers',[TChartServer]);
end;

end.

编译程序，然后运行 ChartServer.exe /regserver 注册服务器端程序。

1.5.2 建立客户端程序
在前面我们讲到，事件的实现需要客户端实现接口，原来在使用Delphi4的时候，我们需要写复杂的接口实现代码。不过在Delphi 5中情况得到了改观，我们可以很方便的，象使用控件一样创建客户端对事件的支持。首先我们需要把服务器端生成的类型库引入到Delphi的控件面板中。选择Delphi菜单的 Project | Import Type Library 项，在Import Type Library窗口中点击 Add 按钮，选择工程目录中的ChartServer.tlb。在 Class Name 列表中就会出现 TChartServer，将复选框Generate Component Warpper 选中。如下图所示：

然后点击 Install 按钮。在 Install 窗口中选择 Into New Package页面，在File Name框中输入 ChartServer 后点击 OK 按钮，Delphi就会建立工程 ChartServer.dpk：

点击ChartServer.dpk窗口中的 Compile 按钮，Delphi就会在控件面板的 ActiveX 页面下添加一个 ChartServer 控件按钮。
建立一个新的Application，将工程保存为Clientprj.dpr，将Form1保存为ClientForm.pas。选择菜单 Project | Add to project 将ChartServer_TLB.pas加入工程，在ClientForm的Uses中加入对ChartServer_TLB的引用。在类TForm1的Private段加入变量定义：
FChart:IChartServer;
在Form1上添加一个TListBox控件，一个TEdit控件，一个TButton控件以及一个ChartServer控件。选择控件ChartServer1，在事件OnEventMessage中添加以下代码：

ListBox1.Items.Add(Message);

在Form1的Create事件中添加以下代码：

FChart:= CoChartServer.Create;
ChartServer1.ConnectTo(FChart);

上面代码的含义是建立服务器组件FChart并将ChartServer1与服务器FChart相连接。
在Button1的Click事件中加入以下代码：

if Assigned(FChart)then
FChart.SendMessage(Edit1.Text);

上面的代码调用FChart的SendMessage方法发送Edit1中的文本。
完整的ClientForm.pas的代码如下：

程序清单 1-11 ClientForm.pas
unit ClientForm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, OleServer, ChartServer_TLB;

type
TForm1 = class(TForm)
ChartServer1: TChartServer;
ListBox1: TListBox;
Edit1: TEdit;
Button1: TButton;
procedure ChartServer1EventMessage(Sender: TObject;
var Message: OleVariant);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
FChart:IChartServer;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ChartServer1EventMessage(Sender: TObject;
var Message: OleVariant);
begin
ListBox1.Items.Add(Message);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FChart:= CoChartServer.Create;
ChartServer1.ConnectTo(FChart);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if Assigned(FChart)then
FChart.SendMessage(Edit1.Text);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ChartServer1.Disconnect;
FChart:=nil;
end;

end.

运行程序，程序会自动运行服务器ChartServer并打开窗口MainForm。在Edit1中输入一些文本后点击Button1，程序就会调用服务器的SendMessage方法发送文本，在服务器端实现该方法时会将文本显示在服务器窗口的ListBox1上并引发EventMessage事件，客户端响应EventMessage事件，将事件返回的字符串显示在ListBox1上。

在本章中，学习了基本的COM对象、COM服务器的基础并通过实例演示了如何建立并使用进程内服务器。在1.3节中，通过实例建立了IE扩展的COM对象。然后就是介绍了如何实现自动化服务器以及能够响应事件的自动化服务器。