delphi – 如何测试通用接口的类型?

delphi – 如何测试通用接口的类型?,第1张

概述我不确定标题是否有意义,但我希望你能用一些代码理解我的问题. 给出了发布/订阅框架的以下代码. type IMessage = interface ['{B1794F44-F6EE-4E7B-849A-995F05897E1C}'] end; ISubscriber = interface ['{D655967E-90C6-4613-92C5-1E5B53619EE0 我不确定标题是否有意义,但我希望你能用一些代码理解我的问题.

给出了发布/订阅框架的以下代码.

type  IMessage = interface    ['{B1794F44-F6EE-4E7B-849A-995F05897E1C}']  end;  ISubscriber = interface    ['{D655967E-90C6-4613-92C5-1E5B53619EE0}']  end;  ISubscriberOf<T: IMessage> = interface(ISubscriber)    procedure Consume(const message: T);  end;  TMessageService = class  private    FSubscribers: TList<ISubscriber>;  public    constructor Create;    destructor Destroy; overrIDe;    procedure SendMessage(const message: IMessage);    procedure Subscribe(const Subscriber: ISubscriber);    procedure Unsubscribe(const Subscriber: ISubscriber);  end;

那会像这样使用:

TMyMessage = class(TInterfacedobject,IMessage);TMySubscriber = class(TInterfacedobject,ISubscriberOf<TMyMessage>)  procedure Consume(const Message: TMyMessage);end;TMyOtherMessage = class(TInterfacedobject,IMessage);TMyOtherSubscriber = class(TInterfacedobject,ISubscriberOf<TMyOtherMessage>)  procedure Consume(const Message: TOtherMessage);end;

如何循环订阅者列表并将消息发送给适当的订阅者?

订阅者列表将包含所有类型消息的所有订阅者. SendMessage必须找到作为param提供的消息类型的订阅者,并将其发送给实现适当接口的消费者,以使用该类型的消息.

procedure TMessageService.SendMessage(const message: IMessage);  var    Subscriber: ISubscriber;  begin    for Subscriber in FSubscribers do    begin      // How to send the message only to the subscribers of the correspondent type of message    end;  end;

谢谢!

顺便说一下,这段代码基于这个blog post.

解决方法 编辑:找到一种方法可以减少这种错误(请按照您的喜好对此答案进行投票;它需要很长时间才能正确完成).
请注意它使用新的Rtti单元,因此它仅适用于Delphi 2010及更高版本(我使用Delphi XE进行开发,我还没有在Delphi 2010中验证这一点).

对于Supports,您需要使用您的接口存储一些IID GUID以及查询它们的方法.
由于您希望将此与泛型一起使用,因此您希望能够从接口类型而不是从接口引用(如Hallvard Vassbotn showed with a hack in 2006)查询IID GUID.
Delphi 2010中引入的新RTTI允许您这样做:

unit RttiUnit;interfacetype  TRtti = record    //1 similar to http://hallvards.blogspot.com/2006/09/Hack11-get-guID-of-interface-reference.HTML but for the interface type,not for a reference    class function GetInterfaceIID<T: IInterface>(var IID: TGUID): Boolean; static;  end;implementationuses  TypInfo,Rtti;class function TRtti.GetInterfaceIID<T>(var IID: TGUID): Boolean;var  TypeInfoOfT: PTypeInfo;  RttiContext: TRttiContext;  RttiInterfaceType: TRttiInterfaceType;  RttiType: TRttiType;begin  TypeInfoOfT := TypeInfo(T);  RttiContext := TRttiContext.Create();  RttiType := RttiContext.GetType(TypeInfoOfT);  if RttiType is TRttiInterfaceType then  begin    RttiInterfaceType := RttiType as TRttiInterfaceType;    IID := RttiInterfaceType.GUID;    Result := True;  end  else    Result := False;end;end.

所以现在改变了代码,我重新安排了一些,并扩展到更多单元以保持概述.

ClassicmessageSubscriberUnit:具有非通用接口IMessage和ISubscriber(它们来自IImplementeDWithClass,这使得更容易记录事物.

unit ClassicmessageSubscriberUnit;interfacetype  IImplementeDWithClass = interface(IInterface)    function ToString: string;  end;  IMessage = interface(IImplementeDWithClass)    ['{B1794F44-F6EE-4E7B-849A-995F05897E1C}']  end;  ISubscriber = interface(IImplementeDWithClass)    ['{D655967E-90C6-4613-92C5-1E5B53619EE0}']  end;implementationend.

GenericSubscriberOfUnit:包含通用的ISubscriberOf接口,它来自通用的ISupporterOf和一个名为TSupporterOf的通用基础实现:

unit GenericSubscriberOfUnit;interfaceuses  ClassicmessageSubscriberUnit;type  ISupporterOf<T: IMessage> = interface(ISubscriber)    ['{0905B3EB-B17E-4AD2-98E2-16F05D19484C}']    function Supports(const Message: T): Boolean;  end;  ISubscriberOf<T: IMessage> = interface(ISupporterOf<T>)    ['{6FD82B1D-61C6-4572-BA7D-D70DA9A73285}']    procedure Consume(const Message: T);  end;type  TSupporterOf<T: IMessage> = class(TInterfacedobject,ISubscriber,ISupporterOf<T>)    function Supports(const Message: T): Boolean;  end;implementationuses  SysUtils,RttiUnit;function TSupporterOf<T>.Supports(const Message: T): Boolean;var  IID: TGUID;begin  if TRtti.GetInterfaceIID<T>(IID) then    Result := SysUtils.Supports(Message,IID)  else    Result := False;end;end.

MessageServiceUnit:现在只包含TMessageService,一些类型别名和一些用于管理列表的实际代码,所以我可以实际测试它.

unit MessageServiceUnit;interfaceuses  Generics.Collections,ClassicmessageSubscriberUnit,GenericSubscriberOfUnit;type  ISubscriberOfIMessage = ISubscriberOf<IMessage>;  TListISubscriber = TList<ISubscriber>;  TMessageService = class  private    FSubscribers: TListISubscriber;  strict protected    procedure Consume(const SubscriberOf: ISubscriberOfIMessage; const Message: IMessage); virtual;  public    constructor Create;    destructor Destroy; overrIDe;    procedure SendMessage(const Message: IMessage);    procedure Subscribe(const Subscriber: ISubscriber);    procedure Unsubscribe(const Subscriber: ISubscriber);  end;implementationuses  SysUtils;constructor TMessageService.Create;begin  inherited Create();  FSubscribers := TListISubscriber.Create();end;destructor TMessageService.Destroy;begin  FreeAndNil(FSubscribers);  inherited Destroy();end;procedure TMessageService.SendMessage(const Message: IMessage);var  LocalMessage: IMessage;  lSubscriber: ISubscriber;  lSubscriberOf: ISubscriberOf<IMessage>;begin  for lSubscriber in FSubscribers do  begin    LocalMessage := Message; // to prevent premature freeing of Message    if Supports(lSubscriber,ISubscriberOf<IMessage>,lSubscriberOf) then      if lSubscriberOf.Supports(LocalMessage) then        Consume(lSubscriberOf,LocalMessage);  end;end;procedure TMessageService.Subscribe(const Subscriber: ISubscriber);begin  FSubscribers.Add(Subscriber);end;procedure TMessageService.Unsubscribe(const Subscriber: ISubscriber);begin  FSubscribers.Remove(Subscriber);end;procedure TMessageService.Consume(const SubscriberOf: ISubscriberOfIMessage; const Message: IMessage);begin  SubscriberOf.Consume(Message);end;end.

最后我用来测试一切的单元(它在http://bo.codeplex.com使用bo库):

unit GenericpublishSubscribeMainFormunit;interfaceuses  windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,Dialogs,StdCtrls,LoggerInterfaceUnit,MessageServiceUnit,MessageSubscribersUnit,ClassicmessageSubscriberUnit;type  TGenericpublishSubscribeMainForm = class(TForm)    TestPublisherbutton: Tbutton;    LogMemo: TMemo;    procedure TestPublisherbuttonClick(Sender: TObject);  strict private    FLogger: ILogger;  strict protected    function GetLogger: ILogger;    property Logger: ILogger read GetLogger;  public    destructor Destroy; overrIDe;  end;type  TLoggingMessageService = class(TMessageService)  strict private    FLogger: ILogger;  strict protected    procedure Consume(const SubscriberOf: ISubscriberOfIMessage; const Message: IMessage); overrIDe;  public    constructor Create(const Logger: ILogger);    property Logger: ILogger read FLogger;  end;var  GenericpublishSubscribeMainForm: TGenericpublishSubscribeMainForm;implementationuses  LoggerUnit,OutputDeBUGVIEwLoggerUnit,LoggersUnit,MessagesUnit;{$R *.dfm}destructor TGenericpublishSubscribeMainForm.Destroy;begin  inherited Destroy;  FLogger := nil;end;function TGenericpublishSubscribeMainForm.GetLogger: ILogger;begin  if not Assigned(FLogger) then    FLogger :=  TTeeLogger.Create([      TOutputDeBUGVIEwLogger.Create(),TStringsLogger.Create(LogMemo.lines)    ]);  Result := FLogger;end;procedure TGenericpublishSubscribeMainForm.TestPublisherbuttonClick(Sender: TObject);var  LoggingMessageService: TLoggingMessageService;begin  LoggingMessageService := TLoggingMessageService.Create(Logger);  try    LoggingMessageService.Subscribe(TMySubscriber.Create() as ISubscriber);    LoggingMessageService.Subscribe(TMyOtherSubscriber.Create() as ISubscriber);    LoggingMessageService.SendMessage(TMyMessage.Create());    LoggingMessageService.SendMessage(TMyOtherMessage.Create());  finally    LoggingMessageService.Free;  end;end;constructor TLoggingMessageService.Create(const Logger: ILogger);begin  inherited Create();  FLogger := Logger;end;procedure TLoggingMessageService.Consume(const SubscriberOf: ISubscriberOfIMessage; const Message: IMessage);var  MessageImplementeDWithClass: IImplementeDWithClass;  MessageString: string;  SubscribeImplementeDWithClass: IImplementeDWithClass;  SubscriberOfString: string;begin  SubscribeImplementeDWithClass := SubscriberOf;  MessageImplementeDWithClass := Message;  SubscriberOfString := SubscribeImplementeDWithClass.ToString;  MessageString := MessageImplementeDWithClass.ToString; // wrong VMT here,Delphi XE SP2  Logger.Log('Consume(SubscriberOf: %s,Message:%s);',[SubscriberOfString,MessageString]);//    [SubscriberOf.Classtype.Classname,Message.Classtype.Classname]);  inherited Consume(SubscriberOf,Message);end;end.

–jeroen

旧解决方案:

这可能会这样做,但我仍然觉得解决方案有点复杂.

MessageServiceUnit:ISubscriberOf现在有一个GUID和一个Supports方法来检查IMessage是否实际上是受支持的.

unit MessageServiceUnit;interfaceuses  Generics.Collections;type  IMessage = interface(IInterface)    ['{B1794F44-F6EE-4E7B-849A-995F05897E1C}']  end;  ISubscriber = interface(IInterface)    ['{D655967E-90C6-4613-92C5-1E5B53619EE0}']  end;  ISubscriberOf<T: IMessage> = interface(ISubscriber)    ['{6FD82B1D-61C6-4572-BA7D-D70DA9A73285}']    procedure Consume(const Message: T);    function Supports(const Message: T): Boolean;  end;  TMessageService = class  private    FSubscribers: TList<ISubscriber>;  public    constructor Create;    destructor Destroy; overrIDe;    procedure SendMessage(const Message: IMessage);    procedure Subscribe(const Subscriber: ISubscriber);    procedure Unsubscribe(const Subscriber: ISubscriber);  end;implementationuses  SysUtils;constructor TMessageService.Create;begin  inherited Create();end;destructor TMessageService.Destroy;begin  inherited Destroy();end;procedure TMessageService.SendMessage(const Message: IMessage);var  lSubscriber: ISubscriber;  lSubscriberOf: ISubscriberOf<IMessage>;begin  for lSubscriber in FSubscribers do  begin    if Supports(lSubscriber,lSubscriberOf) then      if lSubscriberOf.Supports(Message) then        lSubscriberOf.Consume(Message);  end;end;procedure TMessageService.Subscribe(const Subscriber: ISubscriber);begin  FSubscribers.Add(Subscriber);end;procedure TMessageService.Unsubscribe(const Subscriber: ISubscriber);begin  FSubscribers.Remove(Subscriber);end;end.

MessagesUnit:每个消息都有一个带GUID的接口,因此支持可以检查GUID.

unit MessagesUnit;interfaceuses  MessageServiceUnit;type  IMyMessage = interface(IMessage)    ['{84B42EC8-CAC0-44B4-97A8-05AE5B636236}']  end;  TMyMessage = class(TInterfacedobject,IMessage,IMyMessage);  IMyOtherMessage = interface(IMessage)    ['{AB323765-FF7B-4852-91AA-B7ECC1845B41}']  end;  TMyOtherMessage = class(TInterfacedobject,IMyOtherMessage);implementationend.

MessageSubscribersUnit:所有订阅者都有一个支持方法来检查正确的GUID.

unit MessageSubscribersUnit;interfaceuses  MessagesUnit,MessageServiceUnit;type  TMySubscriber = class(TInterfacedobject,ISubscriberOf<IMyMessage>)    procedure Consume(const Message: IMyMessage);    function Supports(const Message: IMyMessage): Boolean;  end;  TMyOtherSubscriber = class(TInterfacedobject,ISubscriberOf<IMyOtherMessage>)    procedure Consume(const Message: IMyOtherMessage);    function Supports(const Message: IMyOtherMessage): Boolean;  end;implementationuses  SysUtils;procedure TMySubscriber.Consume(const Message: IMyMessage);begin  //end;function TMySubscriber.Supports(const Message: IMyMessage): Boolean;begin  Result := SysUtils.Supports(Message,IMyMessage);end;procedure TMyOtherSubscriber.Consume(const Message: IMyOtherMessage);begin  //end;function TMyOtherSubscriber.Supports(const Message: IMyOtherMessage): Boolean;begin  Result := SysUtils.Supports(Message,IMyOtherMessage);end;end.

MessagesUnit:包含特定消息(接口和类类型),其中包含IID GUID以区分它们与Supports.

unit MessagesUnit;interfaceuses  MessageServiceUnit,ClassicmessageSubscriberUnit;type  IMyMessage = interface(IMessage)    ['{84B42EC8-CAC0-44B4-97A8-05AE5B636236}']  end;  TMyMessage = class(TInterfacedobject,IMyOtherMessage);implementationend.

MessageSubscribersUnit:包含特定订阅者(接口和类类型),现在不再需要Supports方法:它们只包含Consume方法.

unit MessageSubscribersUnit;interfaceuses  MessagesUnit,GenericSubscriberOfUnit,ClassicmessageSubscriberUnit;type  TMySubscriber = class(TSupporterOf<IMyMessage>,ISubscriberOf<IMyMessage>)    procedure Consume(const Message: IMyMessage);  end;  TMyOtherSubscriber = class(TSupporterOf<IMyOtherMessage>,ISubscriberOf<IMyOtherMessage>)    procedure Consume(const Message: IMyOtherMessage);  end;implementationuses  SysUtils;procedure TMySubscriber.Consume(const Message: IMyMessage);begin  //end;procedure TMyOtherSubscriber.Consume(const Message: IMyOtherMessage);begin  //end;end.

–jeroen

总结

以上是内存溢出为你收集整理的delphi – 如何测试通用接口的类型?全部内容,希望文章能够帮你解决delphi – 如何测试通用接口的类型?所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错,欢迎将内存溢出网站推荐给程序员好友。

欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/langs/1240310.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2022-06-06
下一篇 2022-06-06

发表评论

登录后才能评论

评论列表(0条)

保存