给出了发布/订阅框架的以下代码.
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 – 如何测试通用接口的类型?所遇到的程序开发问题。
如果觉得内存溢出网站内容还不错,欢迎将内存溢出网站推荐给程序员好友。
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)