Delphi - 如何使用具有通用接口(interface) GUID 的支持？

Question

(代码如下)

我正在使用 Delphi 和 Spring4d 库编写事件总线。

我的灵感来自 Spring4d 库(基于事件的架构)的示例

基本上，事件总线

1. 允许添加订阅者
2. 允许向订阅者分派(dispatch)事件

我对 subscribe 感兴趣方法

TEventBus.subscribe(aHandler : TInterfacedObject; aEvtGuid : TGUID);

我在查找给定的 aHandler 是否支持 IEventHandler 接口(interface)时遇到问题:

TMyClass = class(TInterfacedObject, IEventHandler<IMyEvent>) // ...
TMyOtherClass = class(TInterfacedObject, IEventHandler<IMyOtherEvent>) // ...

aEvtBus.subscribe(aMyClass, IMyEvent) // ok
aEvtBus.subscribe(aMyOtherClass, IMyOtherEvent) // ok
aEvtBus.subscribe(aMyOtherClass, IMyEvent) // should fail
aEvtBus.subscribe(aMyClass, IMyOtherEvent) // should fail

我正在尝试检查是否 aHandler支持IEventHandler<aEvtGUid>当它尝试订阅此事件时的接口(interface)。

我现在所做的就是找到IEventHandler对应的RttiInterfaceType。

lRttiHandlerType := TType.FindType('IEventHandler<' + lRttiEventIntfType.QualifiedName + '>');
lRttiHandlerIntfType := TRttiInterfaceType(lRttiHandlerType);

然后，我想到了使用

SysUtils.Supports(aHandler, lRttiHandlerIntfType.GUID);

问题是 RttiInterfaceType.GUID 始终指向

{97797738-9DB8-4748-92AA-355031294954}

此 GUID 对应于通用 IEventHandler<T : IEvent>接口(interface)(见下文)。因此，只要 aHandler 实现任何 IEventHandler<T : IEvent> ，它总是返回 true界面。

如何确定处理程序是否支持 IEventHandler<aEvtGUid>当aEvtGuid是从通用接口(interface)的RttiInterfaceType获取的GUID时？

编辑1

我也尝试过

  lValue := TValue.From<TInterfacedObject>(aListener);
  lValue.TryCast( lRttiHandlerIntfType.Handle, lValueCast );

它也总是返回 true。

<小时/>

代码

unit Unit1;


interface


uses
  Spring.Collections,
  Spring.Collections.Lists;


type

  { Event Definitions }

  IEvent = interface(IInterface)
    ['{45434EEC-6125-4349-A673-5077DE6F54C9}']
  End;

  IMyEvent = interface(IEvent)
    ['{C5B07E59-4459-46CF-91CC-4F9706255FCC}']
  end;

  IMyOtherEvent = interface(IEvent)
    ['{8C31AF25-711C-403E-B424-8193696DDE46}']
  end;

  TEvent = class(TInterfacedObject, IEvent);

  TMyEvent = class(TEvent, IMyEvent);

  TMyOtherEvent = class(TEvent, IMyOtherEvent);

  { Event handlers }

  IEventHandler<T: IEvent> = interface(IInterface)
    ['{97797738-9DB8-4748-92AA-355031294954}']
    procedure Handle(aEvent: T);
  end;

  IEventHandler = interface(IEventHandler<IEvent>)
    ['{C3699410-A64A-4C9F-8D87-D95841AD044C}']
  end;

  { Classes that handle events }

  TMyClass = class(TInterfacedObject, IEventHandler<IMyEvent>)
    procedure Handle(aEvent: IMyEvent);
  end;

  TMyOtherClass = class(TInterfacedObject, IEventHandler<IMyOtherEvent>)
    procedure Handle(aEvent: IMyOtherEvent);
  end;

  { Event Bus }

  TEventBus = class
  private
    fSuscribers: IDictionary<TGUID, IList<TObject>>;

  public
    constructor Create;
    procedure Suscribe(
      aListener : TInterfacedObject;
      aEventType: TGUID);
    procedure Dispatch<T: IEvent>(aEvent: T);
    procedure Test;
  end;


implementation


uses
  VCL.Dialogs,
  Rtti,
  Spring.Reflection,
  SysUtils;

procedure TMyClass.Handle(aEvent: IMyEvent);
begin
  ShowMessage('MyClass handle IMyEvent');
end;

{ TMyOtherClass }

procedure TMyOtherClass.Handle(aEvent: IMyOtherEvent);
begin
  ShowMessage('MyOtherClass handle IMyOtherEvent');
end;

constructor TEventBus.Create;
begin
  inherited;
  fSuscribers := TCollections.CreateDictionary<TGUID, IList<TObject>>;;
end;

procedure TEventBus.Dispatch<T>(aEvent: T);
begin
  //
end;

procedure TEventBus.Suscribe(aListener : TInterfacedObject; aEventType: TGUID);
var
  lRttiContext                            : TRttiContext;
  lRttiHandlerType                        : TRttiType;
  lEventHandlerIntfName                   : string;
  lRttiEventIntfType, lRttiHandlerIntfType: TRttiInterfaceType;
  aSuscriberList                          : IList<TObject>;
begin

  if not TType.TryGetInterfaceType(aEventType, lRttiEventIntfType) then
    raise Exception.Create('Impossible to find event type');

  lRttiHandlerType := TType.FindType('IEventHandler<' + lRttiEventIntfType.QualifiedName + '>');

  if lRttiHandlerType = nil then
    raise Exception.Create('Impossible to find handler type');

  if not (lRttiHandlerType.TypeKind = TTypeKind.tkInterface) then
    raise Exception.Create('Handler type is not interface');

  lRttiHandlerIntfType := TRttiInterfaceType(lRttiHandlerType);

  if not Supports(aListener, lRttiHandlerIntfType.GUID) then
    raise Exception.CreateFmt('Subscriber does not support interface %s with guid %s', [lRttiHandlerIntfType.QualifiedName, GUIDToString(lRttiHandlerIntfType.GUID)]);
    
  if not fSuscribers.ContainsKey(aEventType) then
    fSuscribers.Add(aEventType, TCollections.CreateList<TObject>);

  aSuscriberList := fSuscribers.Items[aEventType];

  if not aSuscriberList.Contains(aListener) then
    aSuscriberList.Add(aListener);


end;


procedure TEventBus.Test;
var
  aObj1 : TMyClass;
  aObj2 : TMyOtherClass;
begin

  aObj1 := TMyClass.Create;
  aObj2 := TMyOtherClass.Create;

  Suscribe(aObj1, IMyEvent);
  Suscribe(aObj2, IMyOtherEvent);

  try
    Suscribe(aObj1, IMyOtherEvent);
    raise Exception.Create('Should not be there');
  except on E: Exception do
    ShowMessage(E.Message);
  end;
  
  

end;

end.

Answer 1

可能的解决方法:

type
  THelper = class helper for TObject
    class function SupportsEventHandler<T: IEvent>: Boolean;
  end;

function GetInterfaceTypeInfo(InterfaceTable: PInterfaceTable): PTypeInfo;
var
  P: PPointer;
begin
  if Assigned(InterfaceTable) and (InterfaceTable^.EntryCount > 0) then
  begin
    P := Pointer(NativeUInt(@InterfaceTable^.Entries[InterfaceTable^.EntryCount]));
    Result := Pointer(NativeUInt(P^) + SizeOf(Pointer));
  end
  else
    Result := nil;
end;

class function THelper.SupportsEventHandler<T>: Boolean;
var
  InterfaceTable: PInterfaceTable;
  IntfTypeInfo: PTypeInfo;
  I: Integer;
begin
  Result := False;

  InterfaceTable := TMyClass.GetInterfaceTable;
  IntfTypeInfo := GetInterfaceTypeInfo(InterfaceTable);
  for I := 0 to InterfaceTable^.EntryCount - 1 do
  begin
    if IsEqualGUID(InterfaceTable^.Entries[I].IID, IEventHandler<IEvent>) and (IntfTypeInfo = TypeInfo(IEventHandler<T>)) then
    begin
      Result := True;
      Break;
    end;

    Inc(IntfTypeInfo);
  end;
end;

使用示例:

var
  Handler: IInterface;
begin
  Handler := TMyClass.Create;

  if (Handler as TObject).SupportsEventHandler<IMyEvent> then
    Writeln('IMyEvent: Yes')
  else
    Writeln('IMyEvent: No');

  if (Handler as TObject).SupportsEventHandler<IMyOtherEvent> then
    Writeln('IMyOtherEvent: Yes')
  else
    Writeln('IMyOtherEvent: No');
end;