zoukankan html css js c++ java

利用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://bitbucket.org/sglienke/dsharp

本人希望借鉴前人的基础上，实现一个对象的事件多播代理，即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:	est.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;

查看全文

相关阅读:
PAT Basic 1077 互评成绩计算 (20 分)
PAT Basic 1055 集体照 (25 分)
PAT Basic 1059 C语言竞赛 (20 分)
PAT Basic 1072 开学寄语 (20 分)
PAT Basic 1049 数列的片段和 (20 分)
蓝桥杯BASIC-13 数列排序
 蓝桥杯入门——3.序列求和
 蓝桥杯入门——2.圆的面积
 蓝桥杯入门——1.Fibonacci数列
 树的总结（遍历，BST，AVL原型，堆，练习题）

原文地址：https://www.cnblogs.com/hezihang/p/3299481.html