Delphi - 如何使用泛型接口GUID来支持Supports函数？

Question

Delphi - 如何使用泛型接口GUID来支持Supports函数？

delphicastingspring4d

4

以下是代码：

我正在使用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.

- Ludovic C

1

GUID和泛型不兼容。请寻找其他解决方案。 - David Heffernan

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Ondrej Kelle · Accepted Answer

一种可能的解决办法:

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;