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

我不确定标题是否有意义,但我希望你能用一些代码理解我的问题.

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

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;

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：具有非通用接口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接口,它来自通用的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.

–jeroen

旧解决方案：

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

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的接口,因此支持可以检查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：所有订阅者都有一个支持方法来检查正确的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.

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方法：它们只包含Consume方法.

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