delphi - Delphi-如何通过通用界面GUID使用Supports？

（下面的代码）

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

我受到了Spring4d库（基于事件的体系结构）样本的启发。

基本上，事件总线


允许向其添加订户
允许向订阅者发送事件


我对subscribe方法感兴趣

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

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

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>接口。

我现在所做的是找到与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>接口（请参见下文）。因此，只要aHandler实现任何IEventHandler<T : IEvent>接口，它就始终返回true。

当aEvtGuid是从通用接口的RttiInterfaceType获得的GUID时，如何查找处理程序是否支持IEventHandler<aEvtGUid>？

编辑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.

最佳答案

可能的解决方法：

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;