Edit : found a way to make this less confusing (vote for this answer as you like, it took quite a while to figure it out).
Note that it uses the new Rtti element, so it only works for Delphi 2010 and above (I used Delphi XE for this, I have not confirmed this yet in Delphi 2010).
For Supports you need to save some IID GUIDs with your interfaces and the means to request them.
Since you want to use this with generics, you want to request the GUID IID from the type of interface, not a link to the interface (as Hallvard Vassbotn showed with a hack in 2006 ).
The new RTTI introduced in Delphi 2010 does just that:
unit RttiUnit; interface type 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; implementation uses 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.
So, now the code has changed, which I changed a little, and spread to a larger number of units to keep the review.
ClassicMessageSubscriberUnit : has no common IMessage and ISubscriber (they come down with IImplementedWithClass , which makes it easy to record events.
unit ClassicMessageSubscriberUnit; interface type 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; implementation end.
GenericSubscriberOfUnit : contains a common ISubscriberOf interface, which is omitted from a common ISupporterOf and a common base implementation called TSupporterOf :
unit GenericSubscriberOfUnit; interface uses 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; implementation uses 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 : now only contains TMessageService , some type aliases and some actual code to manage the list so I can test it.
unit MessageServiceUnit; interface uses 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; implementation uses 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.
Finally, the block that I used to test everything (it uses the bo library at http://bo.codeplex.com ):
unit GenericPublishSubscribeMainFormUnit; interface uses 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; implementation uses 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
Old solution:
This can do it, but I still find the solution a bit confusing.
MessageServiceUnit : ISubscriberOf now has a GUID and Supports method to check if IMessage supported.
unit MessageServiceUnit; interface uses 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; implementation uses 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, ISubscriberOf<IMessage>, 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 . Messages have an interface with a GUID , so Supports can verify the GUID .
unit MessagesUnit; interface uses 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, IMessage, IMyOtherMessage); implementation end.
MessageSubscribersUnit : For all subscribers, the Supports method checks for the correct GUID .
unit MessageSubscribersUnit; interface uses 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; implementation uses 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.
MessageUnit : Contains specific messages (both an interface and class types) that contain IIDs to distinguish them from Supports .
unit MessagesUnit; interface uses MessageServiceUnit, ClassicMessageSubscriberUnit; 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, IMessage, IMyOtherMessage); implementation end.
MessageSubscribersUnit : contains specific subscribers (both the interface and class types), which now do not need the Supports method: they contain only the Consume method.
unit MessageSubscribersUnit; interface uses MessagesUnit, MessageServiceUnit, GenericSubscriberOfUnit, ClassicMessageSubscriberUnit; type TMySubscriber = class(TSupporterOf<IMyMessage>, ISubscriber, ISubscriberOf<IMyMessage>) procedure Consume(const Message: IMyMessage); end; TMyOtherSubscriber = class(TSupporterOf<IMyOtherMessage>, ISubscriber, ISubscriberOf<IMyOtherMessage>) procedure Consume(const Message: IMyOtherMessage); end; implementation uses SysUtils; procedure TMySubscriber.Consume(const Message: IMyMessage); begin // end; procedure TMyOtherSubscriber.Consume(const Message: IMyOtherMessage); begin // end; end.
- Jeroen