Delphi - как использовать опоры с общим интерфейсом GUID?

Question

(код ниже)

Я пишу автобус событий с Delphi и библиотекой Spring4d.

Я был вдохновлен образцами библиотеки Spring4d (Архитектура Event Based)

В основном, автобус событие

1. Позволяет добавлять абонентов к нему
2. Позволяет отправлять события абонентам

Меня интересует метод 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>, когда он пытается подписаться на это событие.

То, что я сделал сейчас, это найти RttiInterfaceType, соответствующий IEventHandler.

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> интерфейса (см ниже). Поэтому он всегда возвращает true, как только aHandler реализует любой интерфейс IEventHandler<T : IEvent>.

Как найти, поддерживает ли обработчик IEventHandler<aEvtGUid>, когда aEvtGuid - это GUID, полученный из RttiInterfaceType общего интерфейса?

Edit 1

Я также попытался

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

Который всегда возвращает истину, а также.

---

Код

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;