利用RTTI实现Delphi的多播事件代理研究
我们知道Delphi的每个对象可以包含多个Property，Property中可以是方法，例如TButton.OnClick属性。Delphi提供的仅仅是
一对一的设置，无法直接让TButton.OnClick去调用多个方法，而Java中采用Listener模式有类似AddListener方法提供多播。
Delphi多播的思想源于Allen Bauer的Blog：http://blogs.embarcadero.com/abauer/2008/08/15/38865，
cnWizard的武稀松大侠在此思想基础上实现了Win32的Delphi多播机制见：http://www.raysoftware.cn/?p=44#comment-2442，并且应用于cnWizard;
开源项目DSharp实现了更加完整的多播机制，可提供基于接口的多播，见：https://code.google.com/p/delphisorcery/
本人希望借鉴前人的基础上，实现一个对象的事件多播代理，即TEventAgent是一个TObject的事件多播代理器，将一个TObject传给TEventAgent后， TEventAgent扫描TObject所有事件，并为每个事件提供多播功能。
下面程序是一个简单示例，引用了 DSharp.Core.Events.pas单元，并在Delphi XE3 测试成功.
1 unit utObjEventAgent; 2 3 interface 4 5 uses System.Generics.Collections, DSharp.Core.Events, System.TypInfo, Classes; 6 7 type 8 TEventLinker=class(DSharp.Core.Events.TEvent) //单个事件的多播器 9 protected 10 FLinkedObject: TObject; 11 FLinkedProperty: PPropInfo; 12 FOriginal:TMethod; 13 14 FEventTypeData:PTypeData; 15 FEventName:String; 16 procedure MethodAdded(const Method: TMethod); override; 17 procedure MethodRemoved(const Method: TMethod); override; 18 procedure Notify(Sender: TObject; const Item: TMethod; 19 Action: System.Generics.Collections.TCollectionNotification); override; 20 property Owner; 21 property RefCount; 22 public 23 constructor Create(LinkedObj:TObject; LinkedPrpt:PPropInfo); 24 destructor Destroy; override; 25 end; 26 27 TEventAgent=class //对象的事件多播代理 28 protected 29 FOwner:TObject; 30 FPropList: PPropList; 31 FNameList:TDictionary<String, TEventLinker>; 32 procedure Prepare; virtual; 33 procedure Clear; 34 public 35 constructor Create(aOwner:TObject); virtual; 36 destructor Destroy;override; 37 function GetEventCount: Int32; 38 function GetEventName(Index: Int32): PWideChar; 39 procedure AddEventNotifier(EventName: String; const NotifierMethod: TMethod);overload; // 添加事件处理函数 40 procedure RemoveEventNotifier(EventName: String; const NotifierMethod: TMethod);overload; // 移除时间处理函数 41 end; 42 43 implementation 44 45 uses System.Rtti; 46 47 { TEventLinker } 48 49 constructor TEventLinker.Create(LinkedObj:TObject; LinkedPrpt:PPropInfo); 50 begin 51 inherited Create(LinkedPrpt.PropType^, nil); 52 FLinkedObject:=LinkedObj; 53 FLinkedProperty:=LinkedPrpt; 54 FEventName:=FLinkedProperty^.Name; 55 FOriginal:=GetMethodProp(FLinkedObject, FLinkedProperty); 56 SetMethodProp(FLinkedObject, FLinkedProperty, Self.GetInvoke); 57 if Assigned(FOriginal.Data) and Assigned(FOriginal.Code) then Add(FOriginal); //将原事件方法加入多播列表 58 end; 59 60 destructor TEventLinker.Destroy; 61 begin 62 SetMethodProp(FLinkedObject, FLinkedProperty, FOriginal); 63 inherited; 64 end; 65 66 procedure TEventLinker.MethodAdded(const Method: TMethod); 67 begin 68 end; 69 70 procedure TEventLinker.MethodRemoved(const Method: TMethod); 71 begin 72 end; 73 74 procedure TEventLinker.Notify(Sender: TObject; const Item: TMethod; 75 Action: System.Generics.Collections.TCollectionNotification); 76 begin 77 end; 78 79 { TEventAgent } 80 81 procedure TEventAgent.AddEventNotifier(EventName: String; 82 const NotifierMethod: TMethod); 83 var 84 V:TEventLinker; 85 begin 86 if FNameList.TryGetValue(EventName, V) then 87 begin 88 if V.IndexOf(NotifierMethod)<0 then 89 V.Add(NotifierMethod); 90 end; 91 end; 92 93 procedure TEventAgent.Clear; 94 var 95 Item: TPair<String, TEventLinker>; 96 begin 97 for Item in FNameList do 98 Item.Value.Free; 99 FNameList.Clear; 100 if Assigned(FPropList) then FreeMem(FPropList); 101 end; 102 103 constructor TEventAgent.Create(aOwner:TObject); 104 begin 105 inherited Create; 106 FNameList:=TDictionary<String, TEventLinker>.Create; 107 FOwner:=aOwner; 108 Prepare; 109 end; 110 111 destructor TEventAgent.Destroy; 112 begin 113 Clear; 114 FNameList.Free; 115 inherited; 116 end; 117 118 function TEventAgent.GetEventCount: Int32; 119 begin 120 Result:=FNameList.Count; 121 end; 122 123 function TEventAgent.GetEventName(Index: Int32): PWideChar; 124 begin 125 Result:=PWideChar(FNameList.Keys.ToArray[Index]); 126 end; 127 128 procedure TEventAgent.Prepare; 129 var 130 N, i:Integer; 131 Linker:TEventLinker; 132 Context: TRttiContext; 133 begin 134 Clear; 135 N:=GetPropList(FOwner.ClassInfo, FPropList); 136 for i := 0 to N-1 do 137 if FPropList^[i].PropType^.Kind = tkMethod then 138 begin 139 if FPropList[i].GetProc=nil then Continue; 140 Linker:=TEventLinker.Create(FOwner, FPropList[i]); 141 Linker.FEventName:=FPropList[i].Name; 142 FNameList.Add(Linker.FEventName, Linker); 143 end; 144 end; 145 146 147 procedure TEventAgent.RemoveEventNotifier(EventName: String; 148 const NotifierMethod: TMethod); 149 var 150 V:TEventLinker; 151 begin 152 if FNameList.TryGetValue(EventName, V) then 153 begin 154 V.Remove(NotifierMethod); 155 end; 156 end; 157 158 end.
测试程序演示一个TButton被事件多播代理，其OnClick,OnMouseDown均有3个多播方法。
测试程序：
1 unit Unit1; 2 3 interface 4 5 uses 6 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, utObjEventAgent, DSharp.Core.Events, ObjAuto, 8 Vcl.StdCtrls; 9 10 type 11 TForm1 = class(TForm) 12 Button1: TButton; 13 Memo1: TMemo; 14 procedure FormCreate(Sender: TObject); 15 procedure Button1Click(Sender: TObject); 16 procedure Button1MouseDown(Sender: TObject; Button: TMouseButton; 17 Shift: TShiftState; X, Y: Integer); 18 private 19 { Private declarations } 20 procedure OnClick1(Sender:TObject); 21 procedure OnClick2(Sender:TObject); 22 procedure Button1MouseDown1(Sender: TObject; Button: TMouseButton; 23 Shift: TShiftState; X, Y: Integer); 24 procedure Button1MouseDown2(Sender: TObject; Button: TMouseButton; 25 Shift: TShiftState; X, Y: Integer); 26 public 27 { Public declarations } 28 FAgent:TEventAgent; 29 end; 30 31 var 32 Form1: TForm1; 33 34 implementation 35 36 uses System.Rtti; 37 38 {$R *.dfm} 39 40 procedure TForm1.Button1Click(Sender: TObject); 41 begin 42 Memo1.Lines.Add('Button1Click'); 43 end; 44 45 procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton; 46 Shift: TShiftState; X, Y: Integer); 47 begin 48 Memo1.Lines.Add(Format('Clicked at (%d, %d)', [X, Y])); 49 end; 50 51 procedure TForm1.Button1MouseDown1(Sender: TObject; Button: TMouseButton; 52 Shift: TShiftState; X, Y: Integer); 53 begin 54 Memo1.Lines.Add('Button1MouseDown1') 55 end; 56 57 procedure TForm1.Button1MouseDown2(Sender: TObject; Button: TMouseButton; 58 Shift: TShiftState; X, Y: Integer); 59 begin 60 Memo1.Lines.Add('Button1MouseDown2') 61 end; 62 63 procedure TForm1.FormCreate(Sender: TObject); 64 var 65 V:TNotifyEvent; 66 M:TMouseEvent; 67 begin 68 FAgent:=TEventAgent.Create(Button1); 69 V:= Self.OnClick1; 70 FAgent.AddEventNotifier('OnClick', TMethod(V)); 71 V:= Self.OnClick2; 72 FAgent.AddEventNotifier('OnClick', TMethod(V)); 73 M:= Self.Button1MouseDown1; 74 FAgent.AddEventNotifier('OnMouseDown', TMethod(M)); 75 M:= Self.Button1MouseDown2; 76 FAgent.AddEventNotifier('OnMouseDown', TMethod(M)); 77 end; 78 79 procedure TForm1.OnClick1(Sender: TObject); 80 begin 81 Memo1.Lines.Add('OnClick1'); 82 end; 83 84 procedure TForm1.OnClick2(Sender: TObject); 85 begin 86 Memo1.Lines.Add('OnClick2'); 87 end; 88 89 end.
测试程序dfm文件
1 object Form1: TForm1 2 Left = 0 3 Top = 0 4 Caption = 'Form1' 5 ClientHeight = 311 6 ClientWidth = 643 7 OnCreate = FormCreate 8 object Button1: TButton 9 Left = 88 10 Top = 56 11 Width = 75 12 Height = 25 13 Caption = 'Button1' 14 OnClick = Button1Click 15 OnMouseDown = Button1MouseDown 16 end 17 object Memo1: TMemo 18 Left = 264 19 Top = 32 20 Width = 329 21 Height = 225 22 Lines.Strings = ( 23 'Memo1') 24 end 25 end
我的多播代理机制原理是，将所代理对象的所有事件指向代理器对应的函数，由此函数再以此调用多个回调函数。
1.当所代理事件没有任何事件回调时，多播代理不会修改事件函数指针，原对象此事件回调仍然为nil，
2.当所代理事件已经有事件回调函数指针，多播代理会将自己替换原函数指针，并且将原函数指针加入多播列表中.
我的多播机制有如下特点：
1.兼容Delphi的事件回调机制，因此对于老的程序，不用怎么修改，就能被回调多个函数，实现多播。
2.此多播机制不限于界面对象，可代理任何对象，只要此对象有放入public或published的事件property属性，均被自动代理，无所谓其传入的参数是什么类型及有多少个。
3.用户的对象如果需要多播功能，仅需要按照单个事件模式设计即可，多播代理自动帮他实现多播。
再举例1：
比如我们网络通讯假设用的是TTcpClient，从服务器接收数据。接收来的数据进行处理，处理过程有很多，比如有的模块需要存盘到文件，有的处理模块进行数据转发，有的模块需要进行解码分析。
如果使用多播，则可以简单的方法实现。
假如原来的网络程序仅实现了数据存储功能，需要增加解码处理功能，我们不需要修改原来的程序，增加解码模块即可：
1.新建一个DataModule, 放上一个TTcpClient，设置要连接的服务器端口地址
unit Unit2;
interface
uses
System.SysUtils, System.Classes, Web.Win.Sockets, utObjEventAgent;
type
TDataModule2 = class(TDataModule)
TcpClient1: TTcpClient;
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
FLink:TEventAgent;
end;
var
DataModule2: TDataModule2;
implementation
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
procedure TDataModule2.DataModuleCreate(Sender: TObject);
begin
FLink:=TEventAgent.Create(TcpClient1);
TcpClient1.Active:=True;
end;
procedure TDataModule2.DataModuleDestroy(Sender: TObject);
begin
FLink.Free;
end;
end.
2.接着，只需在不同的模块去接收你的数据，例如数据存储模块：
unit Unit3;
interface
uses utObjEventAgent, Unit2, Classes, Web.Win.Sockets;
type
TPersistModule=class
protected
FStream:TFileStream;
private
procedure OnDataReceive(Sender: TObject; Buf: PAnsiChar; var DataLen: Integer);
public
constructor Create;
destructor Destroy;override;
end;
implementation
{ TPersistModule }
constructor TPersistModule.Create;
var
V:TSocketDataEvent;
begin
inherited Create;
FStream:=TFileStream.Create('C:\test.dat', fmCreate);
V:= Self.OnDataReceive;
DataModule2.FLink.AddEventNotifier('OnReceive', TMethod(V));
end;
destructor TPersistModule.Destroy;
var
V:TSocketDataEvent;
begin
V:= Self.OnDataReceive;
DataModule2.FLink.RemoveEventNotifier('OnReceive', TMethod(V));
FStream.Free;
inherited;
end;
procedure TPersistModule.OnDataReceive(Sender: TObject; Buf: PAnsiChar;
var DataLen: Integer);
begin
FStream.Write(Buf^, DataLen);
end;
end.
3.数据解码模块
unit Unit4;
interface
uses utObjEventAgent, Unit2, Classes, Web.Win.Sockets, utDecoder;
type
TDecodeModule=class
protected
FDecoder:TDecoder;
private
procedure OnData(Sender: TObject; Buf: PAnsiChar; var DataLen: Integer);
public
constructor Create;
destructor Destroy;override;
end;
implementation
{ TDecodeModule }
constructor TDecodeModule.Create;
var
V:TSocketDataEvent;
begin
inherited Create;
FDecoder:=TDecoder.Create
V:= Self.OnData;
DataModule2.FLink.AddEventNotifier('OnReceive', TMethod(V));
end;
destructor TDecodeModule.Destroy;
var
V:TSocketDataEvent;
begin
V:= Self.OnData;
DataModule2.FLink.RemoveEventNotifier('OnReceive', TMethod(V));
Fdecoder.Free;
inherited;
end;
procedure TDecodeModule.OnData(Sender: TObject; Buf: PAnsiChar;
var DataLen: Integer);
begin
FDecoder.Decode(Pointer(Buf), DataLen);
end;
end.
再举例2：
借用 “Delphi 实现事件侦听与触发”的例子：
const
evtDataChanged = 'evtDataChanged';
//数据处理类, 用于提供数据
TOnData=procedure( Name, City, CellPhone:String; Age: Integer ) of Object;
TNwDataClass = class( TObject)
private
FOnData:TOnData;
public
Link:TEventAgent;
constructor Create;
destructor Destroy;override;
procedure AddData( Name, City, CellPhone:String; Age: Integer );
property OnData:TOnData read FOnData write FOnData;
end;
//界面显示类
TNwInterface = class( TForm )
procedure FormCreate( Sender: TObject );
procedure FormDestroy( Sender: TObject );
protected
procedure OnEvent( Name, City, CellPhone:String; Age: Integer );
procedure OnEvent2( Name, City, CellPhone:String; Age: Integer );
public
procedure AddDataToList( Name, City, CellPhone:String; Age: Integer);
procedure AddDataToFile( Name, City, CellPhone:String; Age: Integer );
end;
// TNwDataClass 应该有一个全局的实例, 用于提供数据. 在下面的代码中, 就以
// instanceDataClass 为这个实例
implementation
{ TNwDataClass }
constructor TNwDataClass.Create;
begin
inherited Create;
Link:=TEventAgent.Create(Self);
end;
destructor TNwDataClass.Destroy;
begin
Link.Free;
inherited;
end;
procedure TNwDataClass.AddData( Name, City, CellPhone:String; Age: Integer );
begin
//数据处理代码,忽视Link的存在
if Assigned(FOnData) then FOnData(Name, City, CellPhone, Age);
end;
{ TNwInterface }
procedure TNwInterface.FormCreate( Sender: TObject );
var V:TOnData;
begin
V:= Self.OnEvent;
instanceDataClass.Link.AddEventNotifier('OnData', TMethod(V));
V:= Self.OnEvent2;
instanceDataClass.Link.AddEventNotifier('OnData', TMethod(V));
end;
procedure TNwInterface.FormDestroy( Sender: TObject );
var V:TOnData;
begin
V:= Self.OnEvent;
instanceDataClass.Link.RemoveEventNotifier('OnData', TMethod(V));
V:= Self.OnEvent2;
instanceDataClass.Link.RemoveEventNotifier('OnData', TMethod(V));
end;
procedure TNwInterface.OnEvent( Name, City, CellPhone:String; Age: Integer );
begin
AddDataToList( Name, City, CellPhone, Age);
end;
procedure TNwInterface.OnEvent2( Name, City, CellPhone:String; Age: Integer );
begin
AddDataToFile( Name, City, CellPhone, Age);
end;
procedure TNwInterface.AddDataToList( Name, City, CellPhone:String; Age: Integer );
begin
//用于处理显示数据的代码.
end;
procedure TNwInterface.AddDataToFile( Name, City, CellPhone:String; Age: Integer );
begin
//用于保存数据的代码.
end;