众所周知，delhpi对象有属性、方法和事件，但我们不能在TLB编辑器中
找到com事件，这里告诉您如何创建Com事件。
Writing COM Automation Events - by Borland Developer Support Staff
Abstract:A short tutorial on writing simple Automation server and client classes.
WHAT IS AN AUTOMATION EVENT?
The typical COM Client/Server model that you have probably worked with before allows the client to call the server through a supported interface. This is fine when a client calls the server to perform an action or retrieve data, but what about when the server wants to ask things of the client? Incoming interfaces are just that: incoming. There is no way for the server to talk to any of its clients. This is where the Server Events model comes into play. A Server that supports Events not only responds to calls from the client, but can also report status and make its own requests of the client. For Example: A client makes a request for the server to download a file. Instead of waiting for the server to finish this download before continuing (as with the previous model), the client can go about another task. When the server is done, it can fire an Event that lets the client know it is finished, thus allowing the client to respond accordingly.
HOW DO THEY DO IT?
The way in which a client is called by the server is not too much different in concept from the reverse. The server defines and fires events while the client is responsible for connecting to and implementing events. This is accomplished through an events interface or outgoing interface defined in the server object抯 type library. Now before we really get started, it抯 time for some terminology.
Connection Point: An entity describing the access to an events interface.
Event Source: An object that defines an outgoing interface and fires events, typically the Automation Server.
Event Sink: An object that implements an event interface and responds to events, typically the client.
Advise: Linking a sink to a connection point so that the sink抯 methods can be accessed by the source.
These are the main pieces of the Events model. If I were to sum this article up in one sentence it would be this: Simply put, an event sink will connect to a source via a connection point, thereby allowing the source to fire events implemented by the sink. My Goal now is to step through a simple server and client. The client will have a button that will call a server method. This method will simply fire and event that the client will catch and report via a memo control.
LET'S WRITE THE SERVER
Any Automation server that wants to communicate using events needs to define an outgoing interface, and must implement an incoming interface for finding and attaching to those interfaces. This incoming interface is IConnectionPointContainer. The client will use this interface to find or enumerate the connection points supported by the sink with the FindConnectionPoint and EnumConnectionPoints methods. An IConnectionPoint connection point will be returned, from which the client can then call Advise() to advise its sink to the connection point. Both of these interfaces are defined in ACTIVEX.PAS. You don抰 have to do it manually thankfully. The Automation Wizard will do all this for you.
So let抯 begin. Open a New Application and drop a TMemo on the form. Now go to New|Automation Object to start the Automation Wizard. Here you are asked for a coClass name. This example will use SimpleEventServer. Before clicking OK, check the box marked Generate Event Support Code. This is the implementation for your IConnectionPointContainer related things as described in the above paragraph (POOF!!! Delphi Magic!!!). The result will be a unit containing your TSimpleServer object and it抯 coClass definitions. Delphi will also generate a Type Library that includes the typical dual incoming interfaces ISimpleEventServer and ISimpleEventServerDisp, plus one you have not seen before, your outgoing events interface ISimpleEventServerEvents.
ISimpleEventServer now needs to expose a method for our client to call. Open the Type Library Editor (if it is not open already) and add a method CallServer(). Now we need to define an event for the server to fire, so we will and the method EventFired() to the ISimpleEventServerEvents. With this done, click on the Refresh Implementation button and then go back to the source unit for your server. You抣l notice that a method has been added. When the client calls the server, the server will inform the user via its memo, then fire the EventFired event. Implement it as follows:
procedure CallServer; safecall;
begin
Form1.Memo1.Lines.Add('I have been called by a client');
if FEvents <> nil then
begin
FEvents.EventFired;
Form1.Memo1.Lines.Add('I am firing an Event');
end;
end;
NOTE: FEvents is our outgoing interface. Notice that we check it before we fire the event off it. This ensures that a client is actually listening. If it has not been advised to a client sink, it will return NIL.
With that squared away, the Server is complete! Build and run it once to register it with the system.
THE CLIENT
Start a new application and add a TMemo and a button. Now go to the Unit source and add the TLB unit of your server to the USES clause so we can have access to those types and methods. Your main form object will need fields to hold the interfaces to the Server object and the event sink. Declare them in the private field as follows:
?
private
{ Private declarations }
FServer: ISimpleEventServer;
FEventSink: IUnknown;
FConnectionToken: integer;
?/pre>
Once this groundwork is complete, we can start on the only difficult task in COM events: The implementation of the Event Sink. It starts by defining the Event Sink Object, which is an automation object, and therefore must implement IDispatch. The job of the Event Sink is to delegate calls to itself by the server through it抯 Invoke() method. It then calls the local implementation for the event. To enforce a level of separation here, we will leave these implementations in the main unit and hold a reference to the main form in the sink object to call them off of. Here is the Event Sink Definition:
TEventSink = class(TInterfacedObject, IUnknown,IDispatch)
private
FController: TForm2;
{IUknown methods}
function QueryInterface(const IID: TGUID; out Obj):HResult;stdcall;
{Idispatch}
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;
public
constructor Create(Controller: TForm2);
end;
Most of these methods do not need to be implemented. Making them simply return S_OK will do fine, for all except QueryInterface() and Invoke(). These methods are used by the server to obtain interfaces and call your event handlers.
function TEventSink.QueryInterface(const IID: TGUID; out Obj):HResult;stdcall;
begin
if GetInterFace(IID,Obj) then
Result := S_OK
else if IsEqualIID(IID,ISimpleEventServerEvents) then
Result := QueryInterface(IDispatch,Obj)
else
Result := E_NOINTERFACE;
end;
This method first takes care its own IDispatch and IUnknown, then it recurses to get the outgoing interface if being queried for ISimpleEventServerEvents.
function TEventSink.Invoke(DispID: integer; const IID: TGUID; LocaleID: integer; Flags: Word; var Params; VarResult,ExcepInfo,ArgErr:Pointer): HResult;
begin
Result := S_OK;
case DispID of
1: FController.OnEventFired;
end;
end;
The case statement above would, of course, have more statements if we had more events, but this interface and sink only support one. Note that Invoke() calls our handler through a local reference to the main form object where our event handler resides. The Event Sink constructor should handle setting this up:
constructor TEventSink.Create(Controller: TForm2);
begin
inherited Create;
FController := Controller;
end;
With the methods and objects in place, all that is left is to connect sink to source! We will do this in the Client抯 OnCreate event handler:
procedure TForm2.FormCreate(Sender: TObject);
begin
FServer := CoSimpleEventServer.Create;
FEventSink := TEventSink.Create(form2);
InterfaceConnect(FServer, ISimpleEventServerEvents,FEventSink,FconnectionToken);
end;
NOTE: Remember the FEventSink is an IUnknown, and we are receiving and interface from the TEventSink constructor, not a standard reference. This will allow us to advise a connection point to it.
First, we create our server using its coClass. Then we create an instance of our Event sink. As I said earlier, the InterfaceConnect() method is easier to use, but you lose some functionality and understanding. You can use it here by passing in your server抯 interface, the IID of the events interface you are querying for, the IUnknown of your newly created event sink, and an integer representing the connection. You MUST hold onto this integer if you wish to properly unadvise the connection. You can disconnect by simply calling InterfaceDisconnect() using the token integer you received from your InterfaceConnect() call.
Now compile and run the client. The server should start and that抯 it! You are now connected and listening for events! Click the client抯 button to test your event.
SOURCE UNITS EXAMPLES
Below are the units Server Object and Client Object units. Ommited is the Main form of the server.
**********************************
-------------------------------source-----------------------------
//SrvUnit2.pas
//Contains the Automation Server Object
unit SrvUnit2;
interface
uses
ComObj, ActiveX, AxCtrls, Classes, SrvEvent_TLB, StdVcl, Srvunit1;
type
TSimpleEventServer = class(TAutoObject, IConnectionPointContainer, ISimpleEventServer)
private
{ Private declarations }
FConnectionPoints: TConnectionPoints;
FConnectionPoint: TConnectionPoint;
FEvents: ISimpleEventServerEvents;
{ note: FEvents maintains a *single* event sink. For access to more
than one event sink, use FConnectionPoint.SinkList, and iterate
through the list of sinks. }
public
procedure Initialize; override;
protected
{ Protected declarations }
property ConnectionPoints: TConnectionPoints read FConnectionPoints
implements IConnectionPointContainer;
procedure EventSinkChanged(const EventSink: IUnknown); override;
procedure CallServer; safecall;
end;
implementation
uses ComServ;
procedure TSimpleEventServer.EventSinkChanged(const EventSink: IUnknown);
begin
FEvents := EventSink as ISimpleEventServerEvents;
end;
procedure TSimpleEventServer.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 TSimpleEventServer.CallServer;
begin
Form1.Memo1.Lines.Add('I have been called by a client');
if FEvents <> nil then
begin
FEvents.EventFired;
Form1.Memo1.Lines.Add('I am firing an Event');
end;
end;
initialization
TAutoObjectFactory.Create(ComServer, TSimpleEventServer, Class_SimpleEventServer,
ciMultiInstance, tmApartment);
end.
//clientunit.pas
unit ClientUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,SrvEvent_TLB,ActiveX, ComObj, StdCtrls;
type
TForm2 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FServer: ISimpleEventServer;
FEventSink: IUnknown;
FConnectionToken: integer;
public
{ Public declarations }
procedure OnEventFired;
end;
TEventSink = class(TInterfacedObject, IUnknown,IDispatch)
private
FController: TForm2;
{IUknown methods}
function QueryInterface(const IID: TGUID; out Obj):HResult;stdcall;
{Idispatch}
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;
public
constructor Create(Controller: TForm2);
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.OnEventFired;
begin
Memo1.Lines.Add('I have recieved an event');
end;
constructor TEventSink.Create(Controller: TForm2);
begin
inherited Create;
FController := Controller;
end;
function TEventSink.Invoke(DispID: integer; const IID: TGUID; LocaleID: integer; Flags: Word; var Params; VarResult,ExcepInfo,ArgErr:Pointer): HResult;
begin
Result := S_OK;
case DispID of
1: FController.OnEventFired;
end;
end;
function TEventSink.QueryInterface(const IID: TGUID; out Obj):HResult;stdcall;
begin
if GetInterFace(IID,Obj) then
Result := S_OK
else if IsEqualIID(IID,ISimpleEventServerEvents) then
Result := QueryInterface(IDispatch,Obj)
else
Result := E_NOINTERFACE;
end;
function TEventSink.GetTypeInfoCount(out Count: Integer): HResult;
begin
Result := S_OK;
end;
function TEventSink.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
begin
Result := S_OK;
end;
function TEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := S_OK;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
FServer := CoSimpleEventServer.Create;
FEventSink := TEventSink.Create(form2);
InterfaceConnect(FServer, ISimpleEventServerEvents,FEventSink,FConnectionToken);
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
Memo1.Lines.Add('I am calling the Server');
FServer.CallServer;
end;
procedure TForm2.FormDestroy(Sender: TObject);
begin
InterfaceDisconnect(FServer,ISimpleEventServer,FConnectionToken);
FServer := nil;
FEventSink := nil;
end;
end.
运行程序，click button1,客户memo1出现
I am calling the Server
I have recieved an event
如果没有出现I have recieved an event，检查server的接口单元（*_tlb.pas）
ISimpleEventServerEvents = dispinterface
['{50402DF8-E13C-41D1-B607-8CC73A84162A}']
procedure EventFired; dispid 1;
上述声明的dispid 必须与
clientunit.pas 中下列函数的DispID一致。
function TEventSink.Invoke(DispID: integer; const IID: TGUID; LocaleID: integer; Flags: Word; var Params; VarResult,ExcepInfo,ArgErr:Pointer): HResult;
begin
Result := S_OK;
case DispID of
1: FController.OnEventFired;
end;
end;
好好理解一下，然后再来一个在事件中传递参数的例子：
在server端打开tlb编辑器，
在ISimpleEventServer添加一个方法，名为CallByParam，无参数。
在SimpleEventServerEvents添加一个方法，名为PramEvent,,方法参数名为str，类型为bstr（const）
刷新tlb编辑器。
这时在_tlb.pas文件中可以看到以下声明
ISimpleEventServerDisp = dispinterface
['{2914C9D6-D67B-43E7-A3B5-F666CF207EBE}']
procedure CallServer; dispid 1;
procedure CallByParam; dispid 2;
end;
// *********************************************************************//
// DispIntf: ISimpleEventServerEvents
// Flags: (0)
// GUID: {50402DF8-E13C-41D1-B607-8CC73A84162A}
// *********************************************************************//
ISimpleEventServerEvents = dispinterface
['{50402DF8-E13C-41D1-B607-8CC73A84162A}']
procedure EventFired; dispid 1;
procedure ParamEvent(const str: WideString); dispid 2;
end;
注意CallByParam的dispid ，等一下要用。
实现部分：
procedure TSimpleEventServer.CallByParam;
begin
Form1.Memo1.Lines.Add('I have been called by another client');
if FEvents <> nil then
begin
FEvents.ParamEvent('CallParam');
Form1.Memo1.Lines.Add('参数事件');
end;
end;
编译。
转到client,在TForm2的public段加以下声名：
procedure OnPramEvent(str:WideString);
实现部分：
procedure TForm2.OnPramEvent(str:WideString);
begin
Memo1.Lines.Add('收到一个带参数事件'+str);
end;
TEventSink.Invoke现在变成这样：
function TEventSink.Invoke(DispID: integer; const IID: TGUID; LocaleID: integer; Flags: Word; var Params; VarResult,ExcepInfo,ArgErr:Pointer): HResult;
var V:Olevariant;
begin
Result := S_OK;
case DispID of
1: FController.OnEventFired;
2: begin
V:=OleVariant(TDispParams(Params).rgvarg^[0]);
FController.OnPramEvent(v);
end;
end;
end;
注意上面的DispID,在你的机子中是否为2。
较难理解的是 V:=OleVariant(TDispParams(Params).rgvarg^[0]);
Params是Invoke传递回来的无类型参数，通过TDispParams强制转换，现在
我们知道，如果有第二个参数的话，可以用rgvarg^[1]获得。
最后，在TForm2中加入一个按扭，事件为：
procedure TForm2.Button2Click(Sender: TObject);
begin
Memo1.Lines.Add('I am calling the Server');
FServer.CallByParam;
end;
运行client,效果如何？
浪费了我1小时，谢我啊？