程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 利用RTTI實現Delphi的多播事件代理研究

利用RTTI實現Delphi的多播事件代理研究

編輯：Delphi

我們知道Delphi的每個對象可以包含多個Property，Property中可以是方法，例如TButton.OnClick屬性。Delphi提供的僅僅是

一對一的設置，無法直接讓TButton.OnClick去調用多個方法，而Java中采用Listener模式有類似AddListener方法提供多播。

Delphi多播的思想源於的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 測試成功.

  
 
 
  
 
   TEventLinker=(DSharp.Core.Events.TEvent)     //   
    
        MethodAdded( Method: TMethod);       MethodRemoved( Method: TMethod);       Notify(Sender: TObject;        Action: System.Generics.Collections.TCollectionNotification);              
           Destroy;     
   TEventAgent=                 //     
         FNameList:TDictionary<String, TEventLinker>        Prepare;             
        Create(aOwner:TObject);         Destroy;                      AddEventNotifier(EventName: String;  NotifierMethod: TMethod);;    //        RemoveEventNotifier(EventName: String;  NotifierMethod: TMethod);; //    
 
 
  
 
 
  
    Create(LinkedPrpt.PropType^,    FLinkedObject:=   FLinkedProperty:=   FEventName:=   FOriginal:=     Assigned(FOriginal.Data)  Assigned(FOriginal.Code)  Add(FOriginal);  //  
  
      
  TEventLinker.MethodAdded( 
  
  TEventLinker.MethodRemoved( 
  
  TEventLinker.Notify(Sender: TObject;   
  
 
 
     
  
    FNameList.TryGetValue(EventName, V) 
   
      V.IndexOf(NotifierMethod)< 
      
    
     Item: TPair<String, TEventLinker>   
      Item  FNameList 
        Assigned(FPropList)     
  
      FNameList:=TDictionary<String, TEventLinker>   FOwner:=   
  
       
  
   Result:=  
  
   Result:=  
  
    
    N:=    i :=   N- 
      FPropList^[i].PropType^.Kind = tkMethod 
   
      FPropList[i].GetProc=      Linker:=     Linker.FEventName:=      
 
     
  
    FNameList.TryGetValue(EventName, V) 
   
      
 .

測試程序演示一個TButton被事件多播代理，其OnClick,OnMouseDown均有3個多播方法。
測試程序：

  
 
 
 
    
 
   TForm1 =                      
     
                         
     
     
 
  
 
 
  
 
 
  
   Memo1.Lines.Add(  
   
   Memo1.Lines.Add(Format(  
   
   Memo1.Lines.Add(  
   
   Memo1.Lines.Add(  
  
   
   FAgent:=   V:=   FAgent.AddEventNotifier(   V:=   FAgent.AddEventNotifier(   M:=   FAgent.AddEventNotifier(   M:=   FAgent.AddEventNotifier(  
  
   Memo1.Lines.Add(  
  
   Memo1.Lines.Add(  
 .

測試程序dfm文件

    Left = 
   Top = 
   Caption = 
   ClientHeight = 
   ClientWidth = 
   OnCreate =        Left = 
     Top = 
     Width = 
     Height = 
     Caption = 
     OnClick =     OnMouseDown =   
        Left = 
     Top = 
     Width = 
     Height = 
     Lines.Strings =

我的多播代理機制原理是，將所代理對象的所有事件指向代理器對應的函數，由此函數再以此調用多個回調函數。
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;