如何测试通用接口的类型? [英] How to test the type of a generic interface?

问题描述

我不确定标题是否有意义，但希望您可以通过一些代码来理解我的问题.

I'm not sure if the title makes sense, but I hope you can understand my question with some code.

为发布/订阅框架提供以下代码.

Given the following code for a publish/subscribe framework.

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;

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

How can I loop the subscribers list and send the message to the proper subscribers?

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

The subscribers list will have all subscribers for all types of messages. The SendMessage have to find the subscribers for the type of message provided as param and send it to whom implements the proper interface to consume that type of message.

  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;

谢谢！

顺便说一句，此代码基于以下

BTW, this code is based on this blog post.

推荐答案

编辑:找到了一种减少混淆感的方法(请您对这个答案进行投票，您花了很长时间使其正确).
请注意，它使用了新的 Rtti 单元，因此它仅对Delphi 2010及更高版本有效(我使用Delphi XE进行了开发，但尚未在Delphi 2010中进行验证).

Edit: found a way to make this less convoluted (please vote on this answer as you like this; it took quite a while to get it right).
Note it uses the new Rtti unit, so it works only for Delphi 2010 and up (I used Delphi XE for developing this, I did not yet verify this in Delphi 2010).

对于 Supports ，您需要存储一些 IID GUID 带有您的界面以及查询它们的方法.
由于您想将其与泛型一起使用，因此您希望能够从接口类型而不是从接口引用中查询IID GUID(如 RTTI 允许您执行以下操作:

For the Supports, you need to store some IID GUIDs with your interfaces and a means to query them.
Since you want to use this with generics, you want to able to query the IID GUID from an interface type, not from an interface reference (as Hallvard Vassbotn showed with a hack in 2006).
The new RTTI introduced in Delphi 2010 allows you to do 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 changed code, which I rearranged a bit, and spread over more units to keep the overview.

ClassicMessageSubscriberUnit :具有非通用接口 IMessage 和 ISubscriber (它们来自 IImplementedWithClass 记录事物.

ClassicMessageSubscriberUnit: has the non generic interfaces IMessage and ISubscriber (they descend from IImplementedWithClass which makes it easier to log things.

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 :包含通用的 ISubscriberOf 接口，该接口继承于通用的 ISupporterOf 和名为 TSupporterOf :

GenericSubscriberOfUnit: contains the generic ISubscriberOf interface which descends from the generic ISupporterOf and a generic 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 :现在仅包含 TMessageService ，一些类型别名和一些用于管理列表的实际代码，因此我可以对其进行实际测试.

MessageServiceUnit: now only contains TMessageService, some type aliases and some actual code for managing the list so I could actually 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.

最后是我用来测试所有内容的单元(它使用位于 http://bo.codeplex.com的bo库):

Finally a unit 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

旧解决方案:

这也许可以做到，但我仍然发现解决方案有些复杂.

This might do it, but I still find the solution a bit convoluted.

MessageServiceUnit : ISubscriberOf 现在具有 GUID 和 Supports 方法来检查 IMessage实际上受支持.

MessageServiceUnit: ISubscriberOf now has a GUID and a Supports method to check if the IMessage is in fact 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 :每条消息都有一个带有 GUID 的接口，因此 Supports 可以检查GUID .

MessagesUnit: Messages each have an interface with a GUID so Supports can check for 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 :所有订阅者都有一个 Supports 方法，用于检查正确的 GUID .

MessageSubscribersUnit: all subscribers have a Supports method checking the right 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.

MessagesUnit :包含特定的消息(接口和类类型)，其中包含IID GUID，以便通过 Supports 加以区分.

MessagesUnit: contains the specific messages (both the interface and class types), which contain the IID GUIDs to distinguish them with 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 :包含特定的订阅者(接口和类类型)，现在不再需要 Supports 方法:它们仅包含消费方法.

MessageSubscribersUnit: contains the specific subscribers (both the interface and class types), which now do not need the Supports method any more: they only contain 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

--jeroen

这篇关于如何测试通用接口的类型?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！