delphi - 如何测试泛型接口(interface)的类型？

Question

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

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

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 必须找到作为参数提供的消息类型的订阅者，并将其发送给实现正确接口(interface)以使用该类型消息的订阅者。

  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 .

Answer 1

编辑:找到一种方法让这个问题不那么复杂(请根据您的喜好对此答案进行投票；花了相当长的时间才得到它的正确结果)。
请注意，它使用新的 Rtti 单元，因此它仅适用于 Delphi 2010 及更高版本(我使用 Delphi XE 来开发它，我尚未在 Delphi 2010 中验证这一点) .

对于支持，您需要存储一些 IID GUID与您的界面以及查询它们的方法。
由于您希望将其与泛型一起使用，因此您希望能够从接口(interface)类型而不是从接口(interface)引用(如 Hallvard Vassbotn showed with a hack in 2006 )查询 IID GUID。
新RTTI Delphi 2010 中引入的功能可以让您做到这一点:

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.

现在更改了代码，我对其进行了一些重新排列，并将其分布在更多单元中以保持概览。

ClassicMessageSubscriberUnit:具有非泛型接口(interface)IMessage和ISubscriber(它们源自IImplementedWithClass，这使得它更容易记录事情。

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 接口(interface)，该接口(interface)源自通用 ISupporterOf 和名为 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、一些类型别名和一些用于管理列表的实际代码，以便我可以实际测试它。

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 库):

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.

--杰罗恩

旧解决方案:

这可能可以，但我仍然发现解决方案有点复杂。

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

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 的接口(interface)，因此 Supports 可以检查 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。

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:包含特定消息(接口(interface)和类类型)，其中包含 IID GUID，以通过 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:包含特定订阅者(接口(interface)类型和类类型)，现在不再需要 Supports 方法:它们只包含 使用方法。

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