События агрегатора - объект литой интерфейс

Question

Как узнать, если объект поддерживает IHandle < T> и есть любого возможно обходной путь для достижения этой цели в Дельфах (2010, Х)? Также кто-нибудь видел хорошую реализацию агрегатора событий для delphi?

IHandle<TMessage> = interface 
procedure Handle(AMessage: TMessage); 
end; 

EventAggregator = class 
private 
FSubscribers: TList<TObject>; 
public 
constructor Create; 
destructor Destroy; override; 
procedure Subscribe(AInstance: TObject); 
procedure Unsubscribe(AInstance: TObject); 
procedure Publish<T>(AMessage: T); 
end; 

procedure EventAggregator.Publish<T>(AMessage: T); 
var 
    LReference: TObject; 
    LTarget: IHandle<T>; 
begin 
    for LReference in FSubscribers do 
    begin 
     LTarget:= LReference as IHandle<T>; // <-- Wish this would work 
     if Assigned(LTarget) then 
     LTarget.Handle(AMessage); 
    end; 
end; 

procedure EventAggregator.Subscribe(AInstance: TObject); 
begin 
FSubscribers.Add(AInstance); 
end; 

procedure EventAggregator.Unsubscribe(AInstance: TObject); 
begin 
FSubscribers.Remove(AInstance) 
end; 

Update

Я хотел бы отметить отличную статью «Родовые интерфейсы в Delphi» Малкольм Гровс link

, который описывает именно то, что я хотел бы достичь.

Answer 1

Рабочий прототип. Не тестировалось в производстве!

unit zEventAggregator; 

interface 

uses 
    Classes, TypInfo, SysUtils, Generics.Collections; 

type 
    /// <summary> 
    /// Denotes a class which can handle a particular type of message. 
    /// </summary> 
    /// <typeparam name="TMessage">The type of message to handle.</typeparam> 
    IHandle<TMessage> = interface 
    /// <summary> 
    /// Handles the message. 
    /// </summary> 
    /// <param name="message">The message.</param> 
    procedure Handle(AMessage: TMessage); 
    end; 

    /// <summary> 
    /// Subscription token 
    /// </summary> 
    ISubscription = interface 
    ['{3A557B05-286B-4B86-BDD4-9AC44E8389CF}'] 
    procedure Dispose; 
    function GetSubscriptionType: string; 
    property SubscriptionType: string read GetSubscriptionType; 
    end; 

    TSubscriber<T> = class(TInterfacedObject, ISubscription) 
    strict private 
    FAction: TProc<T>; 
    FDisposed: Boolean; 
    FHandle: IHandle<T>; 
    FOwner: TList < TSubscriber <T>> ; 
    public 
    constructor Create(AOwner: TList < TSubscriber <T>> ; AAction: TProc<T>; AHandle: IHandle<T>); 
    destructor Destroy; override; 
    procedure Dispose; 
    procedure Publish(AMessage: T); 
    function GetSubscriptionType: string; 
    end; 

    TEventBroker<T> = class 
    strict private 
    FSubscribers: TList < TSubscriber <T>> ; 
    public 
    constructor Create; 
    destructor Destroy; override; 
    procedure Publish(AMessage: T); 
    function Subscribe(AAction: IHandle<T>): ISubscription; overload; 
    function Subscribe(AAction: TProc<T>): ISubscription; overload; 
    end; 

    TBaseEventAggregator = class 
    strict protected 
    FEventBrokers: TObjectDictionary<PTypeInfo, TObject>; 
    public 
    constructor Create; 
    destructor Destroy; override; 
    function GetEvent<TMessage>: TEventBroker<TMessage>; 
    end; 

    /// <summary> 
    /// Enables loosely-coupled publication of and subscription to events. 
    /// </summary> 
    TEventAggregator = class(TBaseEventAggregator) 
    public 
    /// <summary> 
    /// Publishes a message. 
    /// </summary> 
    /// <typeparam name="T">The type of message being published.</typeparam> 
    /// <param name="message">The message instance.</param> 
    procedure Publish<TMessage>(AMessage: TMessage); 
    /// <summary> 
    /// Subscribes an instance class handler IHandle<TMessage> to all events of type TMessage/> 
    /// </summary> 
    function Subscribe<TMessage>(AAction: IHandle<TMessage>): ISubscription; overload; 
    /// <summary> 
    /// Subscribes a method to all events of type TMessage/> 
    /// </summary> 
    function Subscribe<TMessage>(AAction: TProc<TMessage>): ISubscription; overload; 
    end; 

implementation 

{ TSubscriber<T> } 

constructor TSubscriber<T>.Create(AOwner: TList < TSubscriber <T>> ; AAction: TProc<T>; AHandle: IHandle<T>); 
begin 
    FAction := AAction; 
    FDisposed := False; 
    FHandle := AHandle; 
    FOwner := AOwner; 
end; 

destructor TSubscriber<T>.Destroy; 
begin 
    Dispose; 
    inherited; 
end; 

procedure TSubscriber<T>.Dispose; 
begin 
    if not FDisposed then 
    begin 
    TMonitor.Enter(Self); 
    try 
     if not FDisposed then 
     begin 
     FAction := nil; 
     FHandle := nil; 
     FOwner.Remove(Self); 
     FDisposed := true; 
     end; 
    finally 
     TMonitor.Exit(Self); 
    end; 
    end; 
end; 

function TSubscriber<T>.GetSubscriptionType: string; 
begin 
    Result:= GetTypeName(TypeInfo(T)); 
end; 

procedure TSubscriber<T>.Publish(AMessage: T); 
var 
    a: TProc<T>; 
begin 
    if Assigned(FAction) then 
    TProc<T>(FAction)(AMessage) 
    else if Assigned(FHandle) then 
    FHandle.Handle(AMessage); 
end; 

{ TEventBroker<T> } 

constructor TEventBroker<T>.Create; 
begin 
    FSubscribers := TList < TSubscriber <T>> .Create; 
end; 

destructor TEventBroker<T>.Destroy; 
begin 
    FreeAndNil(FSubscribers); 
    inherited; 
end; 

procedure TEventBroker<T>.Publish(AMessage: T); 
var 
    LTarget: TSubscriber<T>; 
begin 
    TMonitor.Enter(Self); 
    try 
    for LTarget in FSubscribers do 
    begin 
     LTarget.Publish(AMessage); 
    end; 
    finally 
    TMonitor.Exit(Self); 
    end; 
end; 

function TEventBroker<T>.Subscribe(AAction: IHandle<T>): ISubscription; 
var 
    LSubscriber: TSubscriber<T>; 
begin 
    TMonitor.Enter(Self); 
    try 
    LSubscriber := TSubscriber<T>.Create(FSubscribers, nil, AAction); 
    FSubscribers.Add(LSubscriber); 
    Result := LSubscriber; 
    finally 
    TMonitor.Exit(Self); 
    end; 
end; 

function TEventBroker<T>.Subscribe(AAction: TProc<T>): ISubscription; 
var 
    LSubscriber: TSubscriber<T>; 
begin 
    TMonitor.Enter(Self); 
    try 
    LSubscriber := TSubscriber<T>.Create(FSubscribers, AAction, nil); 
    FSubscribers.Add(LSubscriber); 
    Result := LSubscriber; 
    finally 
    TMonitor.Exit(Self); 
    end; 
end; 

{ TBaseEventAggregator } 

constructor TBaseEventAggregator.Create; 
begin 
    FEventBrokers := TObjectDictionary<PTypeInfo, TObject>.Create([doOwnsValues]); 
end; 

destructor TBaseEventAggregator.Destroy; 
begin 
    FreeAndNil(FEventBrokers); 
    inherited; 
end; 

function TBaseEventAggregator.GetEvent<TMessage>: TEventBroker<TMessage>; 
var 
    LEventBroker: TObject; 
    LEventType: PTypeInfo; 
    s: string; 
begin 
    LEventType := TypeInfo(TMessage); 
    s:= GetTypeName(LEventType); 

    if not FEventBrokers.TryGetValue(LEventType, LEventBroker) then 
    begin 
    TMonitor.Enter(Self); 
    try 
     if not FEventBrokers.TryGetValue(LEventType, LEventBroker) then 
     begin 
     LEventBroker := TEventBroker<TMessage>.Create; 
     FEventBrokers.Add(LEventType, LEventBroker); 
     end; 
    finally 
     TMonitor.Exit(Self); 
    end; 
    end; 

    Result := TEventBroker<TMessage>(LEventBroker); 
end; 

{ TEventAggregator } 

procedure TEventAggregator.Publish<TMessage>(AMessage: TMessage); 
begin 
    GetEvent<TMessage>.Publish(AMessage); 
end; 

function TEventAggregator.Subscribe<TMessage>(AAction: IHandle<TMessage>): ISubscription; 
begin 
    Result := GetEvent<TMessage>.Subscribe(AAction); 
end; 

function TEventAggregator.Subscribe<TMessage>(AAction: TProc<TMessage>): ISubscription; 
begin 
    Result := GetEvent<TMessage>.Subscribe(AAction); 
end; 

end. 

Комментарии?

Answer 2

Я думаю, возможный обходной путь, чтобы использовать не универсальный интерфейс с GUID:

IMessageHandler = interface 
    ['...'] 
    procedure Handle(const AMessage: TValue); 
end; 

Answer 3

Чтобы иметь возможность проверить, если экземпляр реализует данный интерфейс, что интерфейс должен иметь определенный идентификатор GUID. Таким образом, добавить GUID в интерфейс (вы также будете нуждаться в этом Guid в константный или переменной, так что вы можете Refernce позже в коде):

const 
    IID_Handle: TGUID = '{0D3599E1-2E1B-4BC1-ABC9-B654817EC6F1}'; 

type 
    IHandle<TMessage> = interface 
    ['{0D3599E1-2E1B-4BC1-ABC9-B654817EC6F1}'] 
    procedure Handle(AMessage: TMessage); 
    end; 

(Вы не должны использовать свой GUID, это просто пример .. нажмите ctrl + shift + G, чтобы создать новый указатель в среде IDE).

Затем проверьте, если зарегистрированный абонент поддерживает этот интерфейс:

//  LTarget:= LReference as IHandle; // <-- Wish this would work 
     if Supports(LReference, IID_Handle, LTarget) then 
     LTarget.Handle(AMessage); 

Однако это не занимает общую часть интерфейса во внимание, что только проверяет GUID.

Для этого вам потребуется дополнительная логика, чтобы проверить, действительно ли объект поддерживает тип сообщения.

Кроме того, поскольку вы имеете дело с классами, которые будут реализовывать интерфейс и, следовательно, должны вытекать из TInterfacedObject (или совместимого интерфейса с этим классом), вы должны хранить все ссылки на созданный объект в переменных интерфейса, список подписчиков из ссылки на TObjects 'на один из II-интерфейсов'. И в этом есть определенный класс для этого тоже:

FSubscribers: TInterfaceList; 

Конечно, вы должны изменить подпись к подписываться/отписываться функции тоже:

procedure Subscribe(AInstance: IInterface); 
procedure Unsubscribe(AInstance: IInterface); 

Я думаю, что лучший путь будет вывести общий интерфейс IHandle. Таким образом, вы можете обеспечить, чтобы все подписчики реализовали базовый интерфейс IHandler, изменив подпись subscribe/unsibscribe, чтобы взять IHandler вместо IInterface.

Затем IHandler может использовать функции, необходимые для определения того, поддерживает ли абонент данный тип сообщения или нет.

Это будет прочитано читателем как упражнение. Вы можете начать с моего маленького тестового приложения (D2010), которое вы можете скачать с My Test App.

N.B. Приложение-тест исследует возможность использования дженериков в интерфейсе и, скорее всего, сбой при публикации событий. Используйте отладчик на один шаг, чтобы узнать, что произойдет.Я не сбой при публикации целого числа 0, который, похоже, работает. Причина в том, что как Int, так и String-обработчик будут вызваны независимо от типа ввода для публикации (как обсуждалось ранее).

Answer 4

Другим подходом было бы пропустить интерфейсы altogheter и перейти с функциональными возможностями отправки TObject.

Нам нужна запись сообщений для этого:

TMessage = record 
    MessageId: Word; 
    Value: TValue; 
    end; 

, а также какое-то событие идентификаторов:

const 
    EVENT_BASE = WM_USER; 
    MY_EVENT = EVENT_BASE; 
    OTHER_EVENT = MY_EVENT + 1; 

и обновить публикацию рутины:

procedure TEventAggregator.Publish<T>(MsgId: Word; const Value: T); 
var 
    LReference: TObject; 
    Msg: TMessage; 
begin 
    Msg.MessageId := MsgId; 
    Msg.Value := TValue.From(Value); 

    for LReference in FSubscribers do begin 
    LReference.Dispatch(Msg); 
    end; 
end; 

Тогда любой объект может быть абонентом событий. Чтобы обрабатывать событие, обработчик должен только указать, какой идентификатор события обрабатывать (или перехватывать его в DefaultHandler).

Чтобы обработать сообщение MY_EVENT, просто добавьте в класс:

procedure HandleMyEvent(var Msg: TMessage); message MY_EVENT; 

Смотрите также пример на рассылку из документации Дельфах: TObjectDispatch

Таким образом, мы можем публиковать сообщения и пусть подписчика выбирайте, какие из них нужно обрабатывать. Кроме того, тип может быть определен в обработчике. Кроме того, можно объявить (в документации, а не код), что данный идентификатор события должен иметь заданный тип, поэтому обработчик события для MY_EVENT может просто получить доступ к значению как Msg.Value.AsInteger.

N.B. Сообщение передается как var, поэтому оно может быть изменено подписчиками. Если это неприемлемо, запись Msg должна быть повторно инициализирована перед каждой отправкой.

Answer 5

Открыть URL и захватить файл почтового индекса http://qc.embarcadero.com/wc/qcmain.aspx?d=91796