（以下代码）
我正在用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.
答案 0 :(得分：4)
可能的解决方法：
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;