david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
1623 lines
48 KiB
ObjectPascal
1623 lines
48 KiB
ObjectPascal
unit uROEventRepository;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 5 and up, Kylix 2 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the RemObjects SDK }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I RemObjects.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, SyncObjs, Contnrs,
|
|
uROSessions, uROClientIntf, uROClient, uROTypes, uROClasses, uROServerIntf;
|
|
|
|
type
|
|
IROEventsInvoker = interface;
|
|
TROEventReceiver = class;
|
|
TROSessionReference = class;
|
|
TROEventRepository = class;
|
|
|
|
TROInvokerInvokeMethod = procedure(__EventReceiver : TROEventReceiver; const aMessage : IROMEssage; const aTarget : IInterface) of object;
|
|
|
|
{ IROEventRepository }
|
|
IROEventRepository = interface
|
|
['{35D49EF1-F62C-4985-B092-8B09D235D81B}']
|
|
procedure AddSession(aSessionID : TGUID);
|
|
procedure RemoveSession(aSessionID : TGUID);
|
|
|
|
procedure StoreEventData(SourceSessionID : TGUID; Data : Binary;
|
|
const ExcludeSender: Boolean;
|
|
const ExcludeSessionList: Boolean;
|
|
const SessionList: String);
|
|
function GetEventData(SessionID : TGUID; var TargetStream : Binary) : integer;
|
|
end;
|
|
|
|
{ IROEventsInvoker }
|
|
IROEventsInvoker = interface
|
|
['{A7FF5762-8208-4A91-B6C2-5D4ECB014EE9}']
|
|
procedure Execute(const aTarget : TObject; EventData: TStream);
|
|
end;
|
|
|
|
TROSessionEvent = procedure(Sender : TROEventRepository ; const SessionID : TGUID) of object;
|
|
|
|
{ TROEventRepository }
|
|
TROEventRepository = class(TROComponent, IROEventRepository)
|
|
private
|
|
fSessionManager: TROCustomSessionManager;
|
|
fMessage: TROMessage;
|
|
fOnBeforeAddSession: TROSessionEvent;
|
|
fOnAfterRemoveSession: TROSessionEvent;
|
|
fOnAfterAddSession: TROSessionEvent;
|
|
fOnBeforeRemoveSession: TROSessionEvent;
|
|
procedure SetMessage(const Value: TROMessage);
|
|
|
|
protected
|
|
procedure SetSessionManager(const Value: TROCustomSessionManager); virtual;
|
|
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
|
|
{ Virtuals }
|
|
procedure DoStoreEventData(SourceSessionID : TGUID; Data : Binary;
|
|
const ExcludeSender: Boolean;
|
|
const ExcludeSessionList: Boolean;
|
|
const SessionList: String); virtual; abstract;
|
|
function DoGetEventData(SessionID : TGUID; var TargetStream : Binary) : integer; virtual; abstract;
|
|
procedure DoAddSession(aSessionID : TGUID); overload; virtual; abstract;
|
|
procedure DoAddSession(aSessionID : TGUID; aActiveEventServer: IROActiveEventServer); overload; virtual;
|
|
procedure DoRemoveSession(aSessionID : TGUID); virtual; abstract;
|
|
|
|
function QueryInterface(const IID: TGUID; out Obj): HResult; override;
|
|
|
|
public
|
|
{ IROEventRepository }
|
|
procedure StoreEventData(SourceSessionID : TGUID; Data : Binary;
|
|
const ExcludeSender: Boolean;
|
|
const ExcludeSessionList: Boolean;
|
|
const SessionList: String);
|
|
function GetEventData(SessionID : TGUID; var TargetStream : Binary) : integer;
|
|
|
|
procedure AddSession(aSessionID : TGUID); overload;
|
|
procedure AddSession(aSessionID: TGUID; aActiveEventServer: IROActiveEventServer); overload;
|
|
procedure RemoveSession(aSessionID : TGUID);
|
|
procedure CheckProperties; virtual;
|
|
|
|
// procedure DeleteEventData(anEvent: TROEventData); virtual;
|
|
|
|
published
|
|
property Message : TROMessage read fMessage write SetMessage;
|
|
property SessionManager : TROCustomSessionManager read fSessionManager write SetSessionManager;
|
|
|
|
property OnBeforeAddSession : TROSessionEvent read fOnBeforeAddSession write fOnBeforeAddSession;
|
|
property OnAfterAddSession : TROSessionEvent read fOnAfterAddSession write fOnAfterAddSession;
|
|
property OnAfterRemoveSession : TROSessionEvent read fOnAfterRemoveSession write fOnAfterRemoveSession;
|
|
property OnBeforeRemoveSession : TROSessionEvent read fOnBeforeRemoveSession write fOnBeforeRemoveSession;
|
|
end;
|
|
|
|
TROSessionRefToEventDataLink = class;
|
|
|
|
IROActiveEventServerList = interface
|
|
['{C6ACE445-267E-4217-9A9C-1D357A7CB3BF}']
|
|
function GetNext: IROActiveEventServerList;
|
|
procedure SetNext(aData: IROActiveEventServerList);
|
|
function GetServer: IROActiveEventServer;
|
|
|
|
property Server: IROActiveEventServer read GetServer;
|
|
property Next: IROActiveEventServerList read GetNext write SetNext;
|
|
procedure DispatchEvent(anEventDataItem : TROEventData; aSessionReference : TGUID; aSender: TObject);
|
|
end;
|
|
TIROActiveEventServerList = class(TInterfacedObject, IROActiveEventServerList)
|
|
private
|
|
fNext: IROActiveEventServerList;
|
|
fServer: IROActiveEventServer;
|
|
public
|
|
constructor Create(aNext: IROActiveEventServerList; aItem: IROActiveEventServer);
|
|
class function AddListener(aList: IROActiveEventServerList; aItem: IROActiveEventServer): IROActiveEventServerList;
|
|
class function RemoveListener(aList: IROActiveEventServerList; aItem: IROActiveEventServer): IROActiveEventServerList;
|
|
|
|
function GetNext: IROActiveEventServerList;
|
|
function GetServer: IROActiveEventServer;
|
|
procedure SetNext(aData: IROActiveEventServerList);
|
|
procedure DispatchEvent(anEventDataItem : TROEventData; aSessionReference : TGUID; aSender: TObject);
|
|
end;
|
|
|
|
{ TROSessionReference }
|
|
TROSessionReference = class
|
|
private
|
|
fTail: TROSessionRefToEventDataLink;
|
|
fHead: TROSessionRefToEventDataLink;
|
|
fSessionID: TGUID;
|
|
ActiveEventReference: IROActiveEventServerList;
|
|
|
|
function GetHead: TROSessionRefToEventDataLink;
|
|
function GetTail: TROSessionRefToEventDataLink;
|
|
|
|
public
|
|
constructor Create(aSessionID : TGUID);
|
|
|
|
property SessionID : TGUID read fSessionID;
|
|
property Head : TROSessionRefToEventDataLink read GetHead write fHead;
|
|
property Tail : TROSessionRefToEventDataLink read GetTail write fTail;
|
|
end;
|
|
|
|
{ TROSessionRefToEventDataLink }
|
|
TROSessionRefToEventDataLink = class
|
|
private
|
|
fNext: TROSessionRefToEventDataLink;
|
|
fEventData: TROEventData;
|
|
fSessionReference: TROSessionReference;
|
|
|
|
public
|
|
constructor Create(anEventDataItem : TROEventData; aSessionReference : TROSessionReference);
|
|
destructor Destroy; override;
|
|
|
|
property EventData : TROEventData read fEventData;
|
|
property SessionReference : TROSessionReference read fSessionReference;
|
|
property Next: TROSessionRefToEventDataLink read fNext write fNext;
|
|
end;
|
|
|
|
{ TROInMemoryEventRepository }
|
|
TROInMemoryEventRepository = class(TROEventRepository, IROSessionsChangesListener)
|
|
private
|
|
fSessionIDs: TStringList;
|
|
// fEvents : TObjectList;
|
|
fCritical : TCriticalSection;
|
|
FDestroyed: Boolean;
|
|
|
|
function GetSessionReferenceCount: integer;
|
|
function GetSessionReferences(Index: integer): TROSessionReference;
|
|
|
|
procedure UnRegisterSessionsChangesListener;
|
|
procedure RegisterSessionsChangesListener;
|
|
protected
|
|
procedure SetSessionManager(const Value: TROCustomSessionManager); override;
|
|
|
|
function FindSession(aSessionID: TGUID): TROSessionReference;
|
|
|
|
{ Overrides }
|
|
procedure DoStoreEventData(SourceSessionID : TGUID; Data : Binary;
|
|
const ExcludeSender: Boolean;
|
|
const ExcludeSessionList: Boolean;
|
|
const SessionList: String); override;
|
|
function DoGetEventData(SessionID : TGUID; var TargetStream : Binary) : integer; override;
|
|
procedure DoAddSession(aSessionID: TGUID); overload; override;
|
|
procedure DoAddSession(aSessionID : TGUID; aActiveEventServer: IROActiveEventServer); overload; override;
|
|
procedure DoRemoveSession(aSessionID: TGUID); override;
|
|
procedure RemoveSessionActiveListener(aSessionID: TGUID);
|
|
|
|
procedure Loaded; override;
|
|
|
|
{ IROSessionsChangesListener }
|
|
procedure SessionsChangedNotification(const aSessionID : TGUID; aSessionAction: TROSessionsActions; Sender: TObject);
|
|
|
|
public
|
|
// procedure DeleteEventData(anEvent: TROEventData); override;
|
|
procedure BeforeDestruction; override;
|
|
|
|
constructor Create(aOwner : TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
property SessionReferences[Index : integer] : TROSessionReference read GetSessionReferences;
|
|
property SessionReferenceCount : integer read GetSessionReferenceCount;
|
|
|
|
published
|
|
end;
|
|
|
|
TROOnEventExceptionEvent = procedure (Sender: TObject; anException: Exception) of object;
|
|
IROEventReceiverInvokers = interface
|
|
['{C8EA6D75-562E-4FE5-B4EF-47ACD4D2ADE8}']
|
|
function Invoke_GetEventsData(out EventsData: Binary): Integer;
|
|
procedure Invoke_RegisterEventClient(const EventTypes: String);
|
|
procedure Invoke_UnregisterEventClient(const EventTypes: String);
|
|
end;
|
|
{ TROEventReceiver }
|
|
TROEventReceiver = class(TROChannelAwareComponent, IROObjectRetainer, IROEventReceiver, IROEventReceiverInvokers)
|
|
private
|
|
fTimer : TROThreadTimer;
|
|
fActive: boolean;
|
|
fServiceName: string;
|
|
fHandlers : TStringList;
|
|
fOnActivate: TNotifyEvent;
|
|
fOnDeactivate: TNotifyEvent;
|
|
fOnPollException: TROOnEventExceptionEvent;
|
|
fRetainedObjects : TList;
|
|
fInterval: Integer;
|
|
fEventAwareChannel: IROActiveEventChannel;
|
|
fSynchronizeInvoke: Boolean;
|
|
|
|
procedure SetInterval(const Value: integer);
|
|
procedure SetActive(const Value: boolean);
|
|
procedure SetServiceName(const Value: string);
|
|
function GetClientID: TGUID;
|
|
function GetSynchronizeInvoke: Boolean;
|
|
|
|
protected
|
|
function GetObject: TObject;
|
|
procedure FireEvents(EventsDataStream: TStream); virtual;
|
|
|
|
// Proxy methods
|
|
function Invoke_GetEventsData(out EventsData: Binary): Integer;
|
|
procedure Invoke_RegisterEventClient(const EventTypes: String);
|
|
procedure Invoke_UnregisterEventClient(const EventTypes: String);
|
|
|
|
procedure OnTimerTick(Dummy: Cardinal);
|
|
|
|
procedure Dispatch(aStream: TStream; aCaller: TThread); reintroduce;
|
|
public
|
|
constructor Create(aOwner : TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Activate;
|
|
procedure Deactivate;
|
|
|
|
procedure RegisterEventHandlers(const EventIDs : array of string; const EventHandlers : array of TObject); overload;
|
|
procedure RegisterEventHandler(const EventID : string; const EventHandler : TObject);
|
|
procedure UnregisterEventHandlersByObject(const EventHandler : array of TObject);
|
|
procedure UnregisterEventHandlers(const EventIDs : array of string); overload;
|
|
procedure UnregisterEventHandler(const EventHandler : TObject); overload;
|
|
procedure UnregisterEventHandler(const EventIDs : string); overload;
|
|
function EventHandlersIsRegistered(const EventIDs: array of string; const EventHandlers: array of TObject): boolean; deprecated;
|
|
function AreEventHandlersRegistered(const aEventIDs: array of string; const aEventHandlers: array of TObject): boolean;
|
|
function IsEventHandlerRegistered(const aEventID: string; const aEventHandler: TObject): boolean;
|
|
procedure CheckProperties;
|
|
{ IROObjectRetainer }
|
|
procedure RetainObject(const anObject : TObject);
|
|
procedure ReleaseObject(const anObject : TObject);
|
|
function IsRetained(const anObject : TObject) : boolean;
|
|
|
|
property ClientID : TGUID read GetClientID;
|
|
|
|
published
|
|
property Active : boolean read fActive write SetActive default false;
|
|
property Interval : integer read fInterval write SetInterval default 30000;
|
|
property Message;
|
|
property Channel;
|
|
|
|
property OnPollException: TROOnEventExceptionEvent read fOnPollException write fOnPollException;
|
|
property OnActivate : TNotifyEvent read fOnActivate write fOnActivate;
|
|
property OnDeactivate : TNotifyEvent read fOnDeactivate write fOnDeactivate;
|
|
property ServiceName : string read fServiceName write SetServiceName;
|
|
property SynchronizeInvoke: Boolean read GetSynchronizeInvoke write fSynchronizeInvoke default true;
|
|
end;
|
|
|
|
{ TROEventProxy }
|
|
TROEventProxy = class(TInterfacedObject)
|
|
private
|
|
fMessage : IROMessage;
|
|
|
|
function GetMessage: IROMessage;
|
|
|
|
protected
|
|
property __Message : IROMessage read GetMessage;
|
|
|
|
public
|
|
constructor Create(const aMessage : IROMessage; CloneMessage : boolean);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TROEventWriter }
|
|
TROEventWriter = class(TROEventProxy, IROEventWriter)
|
|
private
|
|
fRepository : IROEventRepository;
|
|
fExcludeSender: boolean;
|
|
fExcludeSessionList: boolean;
|
|
fSessionList: TStringList;
|
|
|
|
function GetRepository: IROEventRepository;
|
|
|
|
protected
|
|
property Repository : IROEventRepository read GetRepository;
|
|
|
|
{ IROEventWriter }
|
|
function GetSessionList: TStrings;
|
|
function GetExcludeSender: boolean;
|
|
function GetExcludeSessionList: boolean;
|
|
procedure SetExcludeSender(const Value: boolean);
|
|
procedure SetExcludeSessionList(const Value: boolean);
|
|
|
|
public
|
|
constructor Create(const aMessage : IROMessage;
|
|
const aRepository : IROEventRepository); reintroduce;
|
|
destructor Destroy; override;
|
|
|
|
property ExcludeSender : boolean read GetExcludeSender write SetExcludeSender;
|
|
property ExcludeSessionList : boolean read GetExcludeSessionList write SetExcludeSessionList;
|
|
property SessionList : TStrings read GetSessionList;
|
|
end;
|
|
|
|
TROEventWriterClass = class of TROEventWriter;
|
|
|
|
{ TROEventInvoker }
|
|
{$M+}
|
|
TROEventInvoker = class(TROEventProxy, IROEventsInvoker)
|
|
private
|
|
fEventReceiver : TROEventReceiver;
|
|
|
|
protected
|
|
{ IROEventsInvoker }
|
|
procedure Execute(const aTarget : TObject; EventData: TStream);
|
|
|
|
property __EventReceiver : TROEventReceiver read fEventReceiver;
|
|
|
|
public
|
|
constructor Create(anEventReceiver : TROEventReceiver;
|
|
const aMessage : IROMessage; CloneMessage : boolean); reintroduce;
|
|
destructor Destroy; override;
|
|
end;
|
|
{$M-}
|
|
|
|
TROEventInvokerClass = class of TROEventInvoker;
|
|
|
|
procedure RegisterEventWriterClass(const anEventIID : TGUID; anEventWriteClass : TROEventWriterClass);
|
|
procedure UnregisterEventWriterClass(const anEventIID : TGUID);
|
|
function FindEventWriterClass(const anEventIID : TGUID) : TROEventWriterClass;
|
|
|
|
procedure RegisterEventInvokerClass(const anEventID : string; anEventWriteClass : TROEventInvokerClass);
|
|
procedure UnregisterEventInvokerClass(const anEventID : string);
|
|
function FindEventInvokerClass(const anEventID : string) : TROEventInvokerClass;
|
|
|
|
implementation
|
|
|
|
uses
|
|
uRORes;
|
|
|
|
var
|
|
_EventInvokers,
|
|
_EventWriters : TStringList;
|
|
|
|
procedure RegisterEventWriterClass(const anEventIID : TGUID; anEventWriteClass : TROEventWriterClass);
|
|
var id : string;
|
|
begin
|
|
id := GUIDToString(anEventIID);
|
|
_EventWriters.AddObject(id, TObject(anEventWriteClass));
|
|
end;
|
|
|
|
procedure UnregisterEventWriterClass(const anEventIID : TGUID);
|
|
var idx : integer;
|
|
begin
|
|
idx := _EventWriters.IndexOf(GUIDToString(anEventIID));
|
|
if (idx>=0)
|
|
then _EventWriters.Delete(idx);
|
|
end;
|
|
|
|
function FindEventWriterClass(const anEventIID : TGUID) : TROEventWriterClass;
|
|
var idx : integer;
|
|
id : string;
|
|
begin
|
|
result := NIL;
|
|
id := GUIDToString(anEventIID);
|
|
idx := _EventWriters.IndexOf(id);
|
|
if (idx>=0)
|
|
then result := TROEventWriterClass(_EventWriters.Objects[idx]);
|
|
end;
|
|
|
|
procedure RegisterEventInvokerClass(const anEventID : string; anEventWriteClass : TROEventInvokerClass);
|
|
begin
|
|
_EventInvokers.AddObject(anEventID, TObject(anEventWriteClass));
|
|
end;
|
|
|
|
procedure UnregisterEventInvokerClass(const anEventID : string);
|
|
var idx : integer;
|
|
begin
|
|
idx := _EventInvokers.IndexOf(anEventID);
|
|
if (idx>=0)
|
|
then _EventInvokers.Delete(idx);
|
|
end;
|
|
|
|
function FindEventInvokerClass(const anEventID : string) : TROEventInvokerClass;
|
|
var idx : integer;
|
|
begin
|
|
result := NIL;
|
|
idx := _EventInvokers.IndexOf(anEventID);
|
|
if (idx>=0)
|
|
then result := TROEventInvokerClass(_EventInvokers.Objects[idx]);
|
|
end;
|
|
|
|
{ TROEventRepository }
|
|
|
|
procedure TROEventRepository.AddSession(aSessionID: TGUID);
|
|
begin
|
|
CheckProperties;
|
|
if Assigned(fOnBeforeAddSession) then
|
|
fOnBeforeAddSession(Self, aSessionID);
|
|
|
|
DoAddSession(aSessionID);
|
|
|
|
if Assigned(fOnAfterAddSession) then
|
|
fOnAfterAddSession(Self, aSessionID);
|
|
end;
|
|
|
|
procedure TROEventRepository.AddSession(aSessionID: TGUID; aActiveEventServer: IROActiveEventServer);
|
|
begin
|
|
CheckProperties;
|
|
if Assigned(fOnBeforeAddSession) then
|
|
fOnBeforeAddSession(Self, aSessionID);
|
|
|
|
DoAddSession(aSessionID, aActiveEventServer);
|
|
|
|
if Assigned(fOnAfterAddSession) then
|
|
fOnAfterAddSession(Self, aSessionID);
|
|
end;
|
|
|
|
procedure TROEventRepository.RemoveSession(aSessionID: TGUID);
|
|
begin
|
|
CheckProperties;
|
|
if Assigned(fOnBeforeRemoveSession)
|
|
then fOnBeforeRemoveSession(Self, aSessionID);
|
|
|
|
DoRemoveSession(aSessionID);
|
|
|
|
if Assigned(fOnAfterRemoveSession)
|
|
then fOnAfterRemoveSession(Self, aSessionID);
|
|
end;
|
|
|
|
function TROEventRepository.GetEventData(SessionID: TGUID;
|
|
var TargetStream: Binary): integer;
|
|
begin
|
|
CheckProperties;
|
|
result := DoGetEventData(SessionID, TargetStream);
|
|
end;
|
|
|
|
procedure TROEventRepository.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited;
|
|
|
|
if (Operation<>opRemove) then Exit;
|
|
|
|
if (AComponent=fSessionManager) then fSessionManager := NIL
|
|
else if (AComponent=fMessage) then fMessage := NIL;
|
|
end;
|
|
|
|
function TROEventRepository.QueryInterface(const IID: TGUID; out Obj): HResult;
|
|
var eventwriterclass : TROEventWriterClass;
|
|
eventwriter : TROEventWriter;
|
|
id : string;
|
|
begin
|
|
result := inherited QueryInterface(IID, Obj);
|
|
|
|
if (result<>S_OK) then begin
|
|
id := GUIDToString(IID);
|
|
if (id='') then Exit;
|
|
|
|
eventwriterclass := FindEventWriterClass(IID);
|
|
if (eventwriterclass=NIL) then Exit;
|
|
CheckProperties;
|
|
eventwriter := eventwriterclass.Create(fMessage, Self);
|
|
if eventwriter.GetInterface(IID, Obj)
|
|
then result := S_OK
|
|
else eventwriter.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TROEventRepository.SetMessage(const Value: TROMessage);
|
|
begin
|
|
fMessage := Value;
|
|
if (fMessage<>NIL) then fMessage.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TROEventRepository.SetSessionManager(
|
|
const Value: TROCustomSessionManager);
|
|
begin
|
|
if (fSessionManager=Value) then Exit;
|
|
|
|
fSessionManager := Value;
|
|
if (fSessionManager<>NIL)
|
|
then fSessionManager.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TROEventRepository.StoreEventData(SourceSessionID : TGUID; Data : Binary;
|
|
const ExcludeSender: Boolean; const ExcludeSessionList: Boolean; const SessionList: String);
|
|
begin
|
|
CheckProperties;
|
|
DoStoreEventData(SourceSessionID, Data, ExcludeSender, ExcludeSessionList, SessionList);
|
|
end;
|
|
|
|
procedure TROEventRepository.DoAddSession(aSessionID: TGUID;
|
|
aActiveEventServer: IROActiveEventServer);
|
|
begin
|
|
DoAddSession(aSessionID);
|
|
end;
|
|
|
|
(*procedure TROEventRepository.DeleteEventData(anEvent: TROEventData);
|
|
begin
|
|
///
|
|
end;*)
|
|
|
|
procedure TROEventRepository.CheckProperties;
|
|
begin
|
|
// Check(SessionManager = nil, Name + '.SessionManager must be assigned.');
|
|
Check(Message = nil, Name + '.Message must be assigned.');
|
|
Message.CheckProperties;
|
|
end;
|
|
|
|
{ TROInMemoryEventRepository }
|
|
|
|
constructor TROInMemoryEventRepository.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
fCritical := TCriticalSection.Create;
|
|
// fEvents := TObjectList.Create(False); // cleaned up one by one
|
|
fSessionIDs := TStringList.Create;
|
|
fSessionIDs.Duplicates := dupIgnore;
|
|
fSessionIDs.Sorted := TRUE;
|
|
end;
|
|
|
|
destructor TROInMemoryEventRepository.Destroy;
|
|
var
|
|
i: Integer;
|
|
llink: TROSessionReference;
|
|
lItem, lnext: TROSessionRefToEventDataLink;
|
|
begin
|
|
FDestroyed:=True;
|
|
fCritical.Enter;
|
|
try
|
|
for i := fSessionIDs.Count -1 downto 0 do begin
|
|
llink := TROSessionReference(fSessionIDs.Objects[i]);
|
|
if llink = nil then continue;
|
|
lItem := llink.Head;
|
|
llink.Free;
|
|
while lItem <> nil do begin
|
|
if lItem.EventData <> nil then begin
|
|
if lItem.EventData.RemoveRef <= 0 then
|
|
// fEvents.Remove(lItem.EventData);
|
|
lItem.EventData.Free
|
|
end;
|
|
lnext := lItem.Next;
|
|
lItem.Free;
|
|
lItem := lNext;
|
|
end;
|
|
end;
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
FreeAndNIL(fSessionIDs);
|
|
// FreeAndNIL(fEvents);
|
|
FreeAndNIL(fCritical);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
function TROInMemoryEventRepository.DoGetEventData(SessionID: TGUID;
|
|
var TargetStream: Binary): integer;
|
|
var sessionreference : TROSessionReference;
|
|
prevref,
|
|
currref : TROSessionRefToEventDataLink;
|
|
chunksize : integer;
|
|
begin
|
|
result := 0;
|
|
if FDestroyed then Exit;
|
|
fCritical.Enter;
|
|
try
|
|
sessionreference := FindSession(SessionID);
|
|
if (sessionreference=NIL) then Exit;
|
|
|
|
TargetStream.Write(result, SizeOf(result));
|
|
|
|
currref := sessionreference.Head;
|
|
if (currref<>NIL) then begin
|
|
repeat
|
|
currref.EventData.Data.Position := 0;
|
|
chunksize := currref.EventData.Data.Size;
|
|
|
|
TargetStream.Write(chunksize, SizeOf(chunksize));
|
|
TargetStream.CopyFrom(currref.EventData.Data, 0);
|
|
|
|
Inc(result);
|
|
|
|
prevref := currref;
|
|
currref := currref.Next;
|
|
|
|
if (prevref.EventData.RemoveRef=0)then begin
|
|
// fEvents.Remove(prevref.EventData);
|
|
prevref.EventData.Free;
|
|
end;
|
|
|
|
prevref.Free;
|
|
|
|
until (currref=NIL);
|
|
|
|
sessionreference.Head := NIL;
|
|
sessionreference.Tail := NIL;
|
|
end;
|
|
|
|
// Updates the event count
|
|
TargetStream.Position := 0;
|
|
TargetStream.Write(result, SizeOf(result));
|
|
TargetStream.Position := 0;
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TROInMemoryEventRepository.DoStoreEventData(SourceSessionID : TGUID; Data : Binary;
|
|
const ExcludeSender: Boolean; const ExcludeSessionList: Boolean; const SessionList: String);
|
|
var newlink : TROSessionRefToEventDataLink;
|
|
newevent : TROEventData;
|
|
sessionref : TROSessionReference;
|
|
i : integer;
|
|
filteredsessionslist : TStringList;
|
|
isfiltered : boolean;
|
|
currsessionid : string;
|
|
begin
|
|
if FDestroyed then Exit;
|
|
filteredsessionslist := NIL;
|
|
isfiltered := SessionList<>'';
|
|
if isfiltered then begin
|
|
filteredsessionslist := TStringList.Create;
|
|
filteredsessionslist.Sorted := TRUE;
|
|
filteredsessionslist.Duplicates := dupIgnore;
|
|
filteredsessionslist.CommaText := SessionList;
|
|
end;
|
|
|
|
fCritical.Enter;
|
|
try
|
|
newevent := TROEventData.Create(Data);
|
|
try
|
|
for i := 0 to (SessionReferenceCount-1) do begin
|
|
sessionref := SessionReferences[i];
|
|
currsessionid := GUIDToString(sessionref.SessionID);
|
|
|
|
// Filters the sessions the message will go to
|
|
if isfiltered then begin
|
|
if ExcludeSessionList then begin
|
|
if (filteredsessionslist.IndexOf(currsessionid)>=0)
|
|
then Continue;
|
|
end
|
|
else begin
|
|
if not (filteredsessionslist.IndexOf(currsessionid)>=0)
|
|
then Continue;
|
|
end;
|
|
end;
|
|
|
|
if IsEqualGUID(sessionref.SessionID, SourceSessionID) and ExcludeSender
|
|
then Continue;
|
|
if sessionref.ActiveEventReference <> nil then begin
|
|
newevent.AddRef; // we don't want the event to be freed before we're done with it.
|
|
sessionref.ActiveEventReference.DispatchEvent(newevent, sessionref.SessionID, Self);
|
|
end
|
|
else begin
|
|
newlink := TROSessionRefToEventDataLink.Create(newevent, sessionref);
|
|
|
|
if (sessionref.Head=NIL)
|
|
then sessionref.Head := newlink;
|
|
|
|
if (sessionref.Tail<>NIL)
|
|
then sessionref.Tail.Next := newlink;
|
|
|
|
sessionref.Tail := newlink;
|
|
end;
|
|
end;
|
|
finally
|
|
if newevent.RemoveRef < 1 then
|
|
newevent.Free;
|
|
end;
|
|
finally
|
|
fCritical.Leave;
|
|
FreeAndNIL(filteredsessionslist);
|
|
end;
|
|
end;
|
|
|
|
procedure TROInMemoryEventRepository.DoRemoveSession(aSessionID: TGUID);
|
|
var
|
|
idx : integer;
|
|
sessionreference : TROSessionReference;
|
|
prevref,
|
|
currref : TROSessionRefToEventDataLink;
|
|
begin
|
|
if FDestroyed then Exit;
|
|
fCritical.Enter;
|
|
try
|
|
idx := fSessionIDs.IndexOf(GUIDToString(aSessionID));
|
|
if idx>=0 then begin
|
|
sessionreference := TROSessionReference(fSessionIDs.Objects[idx]);
|
|
currref := sessionreference.Head;
|
|
if (currref<>NIL) then begin
|
|
repeat
|
|
prevref := currref;
|
|
currref := currref.Next;
|
|
|
|
if (prevref.EventData.RemoveRef=0)
|
|
then
|
|
prevref.EventData.Free;
|
|
|
|
prevref.Free;
|
|
|
|
until (currref=NIL);
|
|
sessionreference.Head := NIL;
|
|
sessionreference.Tail := NIL;
|
|
end;
|
|
fSessionIDs.Objects[idx].Free;
|
|
fSessionIDs.Delete(idx);
|
|
end;
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TROInMemoryEventRepository.DoAddSession(aSessionID: TGUID);
|
|
begin
|
|
DoAddSession(aSessionID, nil);
|
|
end;
|
|
|
|
function TROInMemoryEventRepository.GetSessionReferenceCount: integer;
|
|
begin
|
|
result := fSessionIDs.Count;
|
|
end;
|
|
|
|
function TROInMemoryEventRepository.GetSessionReferences(
|
|
Index: integer): TROSessionReference;
|
|
begin
|
|
result := TROSessionReference(fSessionIDs.Objects[Index]);
|
|
end;
|
|
|
|
function TROInMemoryEventRepository.FindSession(
|
|
aSessionID: TGUID): TROSessionReference;
|
|
var idx : integer;
|
|
begin
|
|
result := NIL;
|
|
|
|
idx := fSessionIDs.IndexOf(GUIDToString(aSessionID));
|
|
if (idx>=0)
|
|
then result := TROSessionReference(fSessionIDs.Objects[idx]);
|
|
end;
|
|
|
|
procedure TROInMemoryEventRepository.UnRegisterSessionsChangesListener;
|
|
var
|
|
Ref: IROSessionsChangesNotifier;
|
|
SelfRef: IROSessionsChangesListener;
|
|
begin
|
|
if GetInterface(IROSessionsChangesListener, SelfRef) then begin
|
|
if Assigned(fSessionManager) and
|
|
fSessionManager.GetInterface(IROSessionsChangesNotifier, ref) then begin
|
|
ref.UnRegisterSessionsChangesListener(SelfRef);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TROInMemoryEventRepository.RegisterSessionsChangesListener;
|
|
var
|
|
Ref: IROSessionsChangesNotifier;
|
|
SelfRef: IROSessionsChangesListener;
|
|
begin
|
|
if GetInterface(IROSessionsChangesListener, SelfRef) then begin
|
|
if Assigned(fSessionManager) and
|
|
fSessionManager.GetInterface(IROSessionsChangesNotifier, ref) then begin
|
|
ref.RegisterSessionsChangesListener(SelfRef);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TROInMemoryEventRepository.SetSessionManager(
|
|
const Value: TROCustomSessionManager);
|
|
begin
|
|
if (csDesigning in ComponentState) or (csLoading in ComponentState) then begin
|
|
inherited;
|
|
Exit;
|
|
end;
|
|
|
|
UnRegisterSessionsChangesListener;
|
|
inherited;
|
|
RegisterSessionsChangesListener;
|
|
end;
|
|
|
|
procedure TROInMemoryEventRepository.Loaded;
|
|
begin
|
|
inherited;
|
|
RegisterSessionsChangesListener;
|
|
end;
|
|
|
|
procedure TROInMemoryEventRepository.SessionsChangedNotification(
|
|
const aSessionID: TGUID; aSessionAction: TROSessionsActions; Sender: TObject);
|
|
var
|
|
idx: Integer;
|
|
lRef: IROActiveEventServer;
|
|
sessionreference: TROSessionReference;
|
|
begin
|
|
if FDestroyed then Exit;
|
|
if aSessionAction in [saDelete, saTmpSessionDelete] then
|
|
RemoveSession(aSessionID);
|
|
if aSessionAction = saRemoveActiveListener then begin
|
|
fCritical.Enter;
|
|
try
|
|
idx := fSessionIDs.IndexOf(GUIDToString(aSessionID));
|
|
if idx>=0 then begin
|
|
sessionreference := TROSessionReference(fSessionIDs.Objects[idx]);
|
|
if Supports(Sender, IROActiveEventServer, lref) then begin
|
|
sessionreference.ActiveEventReference := TIROActiveEventServerList.RemoveListener(sessionreference.ActiveEventReference, lRef);
|
|
end else
|
|
sessionreference.ActiveEventReference := nil;
|
|
end;
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TROInMemoryEventRepository.BeforeDestruction;
|
|
begin
|
|
UnRegisterSessionsChangesListener;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TROInMemoryEventRepository.DoAddSession(aSessionID: TGUID;
|
|
aActiveEventServer: IROActiveEventServer);
|
|
var newsession : TROSessionReference;
|
|
idx: Integer;
|
|
begin
|
|
if FDestroyed then Exit;
|
|
fCritical.Enter;
|
|
try
|
|
idx := fSessionIDs.IndexOf(GUIDToString(aSessionID));
|
|
if idx < 0 then begin
|
|
newsession := TROSessionReference.Create(aSessionID);
|
|
if aActiveEventServer <> nil then begin
|
|
newsession.ActiveEventReference := TIROActiveEventServerList.AddListener(newsession.ActiveEventReference, aActiveEventServer);
|
|
aActiveEventServer.EventsRegistered(self, aSessionID);
|
|
end;
|
|
fSessionIDs.AddObject(GUIDToString(aSessionID), newsession);
|
|
end
|
|
else begin
|
|
newsession := TROSessionReference(fSessionIDs.Objects[idx]);
|
|
if aActiveEventServer <> nil then begin
|
|
newsession.ActiveEventReference := TIROActiveEventServerList.AddListener(newsession.ActiveEventReference, aActiveEventServer);
|
|
aActiveEventServer.EventsRegistered(self, aSessionID);
|
|
end;
|
|
end;
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TROInMemoryEventRepository.RemoveSessionActiveListener(
|
|
aSessionID: TGUID);
|
|
var
|
|
idx : integer;
|
|
sessionreference : TROSessionReference;
|
|
begin
|
|
if FDestroyed then Exit;
|
|
fCritical.Enter;
|
|
try
|
|
idx := fSessionIDs.IndexOf(GUIDToString(aSessionID));
|
|
if idx>=0 then begin
|
|
sessionreference := TROSessionReference(fSessionIDs.Objects[idx]);
|
|
sessionreference.ActiveEventReference := nil;
|
|
end;
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
end;
|
|
|
|
(*
|
|
procedure TROInMemoryEventRepository.DeleteEventData(
|
|
anEvent: TROEventData);
|
|
begin
|
|
fCritical.Enter;
|
|
try
|
|
fEvents.Remove(anEvent);
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
end;
|
|
*)
|
|
|
|
{ TROSessionReference }
|
|
|
|
constructor TROSessionReference.Create(aSessionID: TGUID);
|
|
begin
|
|
inherited Create;
|
|
|
|
fSessionID := aSessionID;
|
|
end;
|
|
|
|
function TROSessionReference.GetHead: TROSessionRefToEventDataLink;
|
|
begin
|
|
Result := fHead;
|
|
end;
|
|
|
|
function TROSessionReference.GetTail: TROSessionRefToEventDataLink;
|
|
begin
|
|
Result := fTail;
|
|
end;
|
|
|
|
{ TROSessionRefToEventDataLink }
|
|
|
|
constructor TROSessionRefToEventDataLink.Create(
|
|
anEventDataItem: TROEventData; aSessionReference: TROSessionReference);
|
|
begin
|
|
inherited Create;
|
|
anEventDataItem.AddRef;
|
|
|
|
fEventData := anEventDataItem;
|
|
fSessionReference := aSessionReference;
|
|
end;
|
|
|
|
destructor TROSessionRefToEventDataLink.Destroy;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
{ TROEventReceiver }
|
|
|
|
constructor TROEventReceiver.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
fHandlers := TStringList.Create;
|
|
fInterval := 30000;
|
|
|
|
fSynchronizeInvoke := true;
|
|
end;
|
|
|
|
destructor TROEventReceiver.Destroy;
|
|
begin
|
|
FreeAndNIL(fHandlers);
|
|
FreeAndNIL(fRetainedObjects);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TROEventReceiver.Activate;
|
|
begin
|
|
Active := TRUE;
|
|
end;
|
|
|
|
procedure TROEventReceiver.Deactivate;
|
|
begin
|
|
Active := FALSE;
|
|
end;
|
|
|
|
procedure TROEventReceiver.SetActive(const Value: boolean);
|
|
begin
|
|
if Value <> fActive then begin
|
|
if Value and not (csDesigning in ComponentState) then
|
|
CheckProperties;
|
|
|
|
fActive := Value;
|
|
|
|
if (Channel = nil) or not Supports(Channel, IROActiveEventChannel, fEventAwareChannel) then
|
|
fEventAwareChannel := nil;
|
|
|
|
if Value then
|
|
begin
|
|
if fEventAwareChannel <> nil then
|
|
fEventAwareChannel.RegisterEventReceiver(self)
|
|
else
|
|
if FTimer = nil then
|
|
fTimer := TROThreadTimer.Create(OnTimerTick, fInterval, false);
|
|
end else begin
|
|
if fEventAwareChannel <> nil then
|
|
fEventAwareChannel.UnregisterEventReceiver(self)
|
|
else
|
|
if fTimer <> nil then
|
|
begin
|
|
fTimer.AsyncFree;
|
|
fTimer := nil;
|
|
end;
|
|
end;
|
|
|
|
if Value then begin
|
|
if Assigned(fOnActivate) then fOnActivate(Self);
|
|
end
|
|
else begin
|
|
if Assigned(fOnDeactivate) then fOnDeactivate(Self);
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TROEventReceiver.SetInterval(const Value: integer);
|
|
begin
|
|
fInterval := Value;
|
|
if fTimer <> nil then
|
|
fTimer.Timeout := Value;
|
|
end;
|
|
|
|
procedure TROEventReceiver.SetServiceName(const Value: string);
|
|
begin
|
|
fServiceName := Trim(Value);
|
|
end;
|
|
|
|
procedure TROEventReceiver.Invoke_RegisterEventClient(const EventTypes: String);
|
|
var
|
|
__message : IROMessage;
|
|
__channel : IROTransportChannel;
|
|
ClientId: string;
|
|
begin
|
|
CheckProperties;
|
|
__message := (Message as IROMessage);
|
|
__channel := (Channel as IROTransportChannel);
|
|
|
|
try
|
|
__message.InitializeRequestMessage(__channel, 'RemObjects', ServiceName, 'RegisterEventClient');
|
|
__channel.BeforeDispatch(__message); // sets the client id for some channels
|
|
ClientId := GuidToString(__message.ClientID);
|
|
__message.Write('ClientID', TypeInfo(String), ClientId, []);
|
|
__message.Write('EventTypes', TypeInfo(String), EventTypes, []);
|
|
__message.Finalize;
|
|
|
|
__channel.Dispatch(__message);
|
|
|
|
finally
|
|
__Message.FreeStream;
|
|
end
|
|
end;
|
|
|
|
procedure TROEventReceiver.Invoke_UnregisterEventClient(const EventTypes: String);
|
|
var
|
|
__message : IROMessage;
|
|
__channel : IROTransportChannel;
|
|
ClientId: string;
|
|
begin
|
|
CheckProperties;
|
|
__message := (Message as IROMessage);
|
|
__channel := (Channel as IROTransportChannel);
|
|
|
|
|
|
try
|
|
__message.InitializeRequestMessage(__channel, 'RemObjects', ServiceName, 'UnregisterEventClient');
|
|
__channel.BeforeDispatch(__message);
|
|
ClientId := GuidToString(__message.ClientID);
|
|
__message.Write('ClientID', TypeInfo(String), ClientID, []);
|
|
__message.Write('EventTypes', TypeInfo(String), EventTypes, []);
|
|
__message.Finalize;
|
|
|
|
__channel.Dispatch(__message);
|
|
|
|
finally
|
|
__Message.FreeStream;
|
|
end
|
|
end;
|
|
|
|
function TROEventReceiver.Invoke_GetEventsData(out EventsData: Binary): Integer;
|
|
var
|
|
__message : IROMessage;
|
|
__channel : IROTransportChannel;
|
|
ClientId: string;
|
|
begin
|
|
CheckProperties;
|
|
__message := (Message as IROMessage);
|
|
__channel := (Channel as IROTransportChannel);
|
|
|
|
try
|
|
__message.InitializeRequestMessage(__channel, 'RemObjects', ServiceName, 'GetEventsData');
|
|
__channel.BeforeDispatch(__message);
|
|
ClientId := GuidToString(__message.ClientID);
|
|
__message.Write('ClientID', TypeInfo(String), ClientID, []);
|
|
__message.Finalize;
|
|
|
|
__channel.Dispatch(__message);
|
|
|
|
__message.Read('Result', TypeInfo(Integer), result, []);
|
|
__message.Read('EventsData', TypeInfo(Binary), EventsData, []);
|
|
finally
|
|
__message.FreeStream;
|
|
end
|
|
end;
|
|
|
|
procedure TROEventReceiver.FireEvents(EventsDataStream : TStream);
|
|
var
|
|
tempstream : TStream;
|
|
chunksize, idx, cnt : integer;
|
|
messageclone : IROMessage;
|
|
eventInvokerclass : TROEventInvokerClass;
|
|
eventInvoker : TROEventInvoker;
|
|
begin
|
|
CheckProperties;
|
|
tempstream := NIL;
|
|
eventInvoker := NIL;
|
|
|
|
messageclone := (Message as IROMessageCloneable).Clone;
|
|
|
|
EventsDataStream.Position := 0;
|
|
|
|
if fEventAwareChannel <> nil then begin
|
|
// event aware channels send one event at a time.
|
|
messageclone.ReadFromStream(EventsDataStream);
|
|
|
|
eventInvokerclass := FindEventInvokerClass(messageclone.InterfaceName);
|
|
eventInvoker := eventInvokerclass.Create(Self, messageclone, FALSE);
|
|
|
|
try
|
|
for idx := 0 to fHandlers.Count -1 do begin
|
|
if SameText(fHandlers[idx], messageclone.InterfaceName) then
|
|
eventInvoker.Execute(fHandlers.Objects[idx], EventsDataStream);
|
|
end;
|
|
finally
|
|
FreeAndNIL(eventInvoker);
|
|
end;
|
|
|
|
end
|
|
else begin
|
|
EventsDataStream.Read(cnt, SizeOf(integer));
|
|
|
|
while (EventsDataStream.Position<EventsDataStream.Size-1) do try
|
|
EventsDataStream.Read(chunksize, SizeOf(integer));
|
|
|
|
tempstream := TMemoryStream.Create;
|
|
tempstream.CopyFrom(EventsDataStream, chunksize);
|
|
tempstream.Position := 0;
|
|
|
|
messageclone.ReadFromStream(tempstream);
|
|
|
|
eventInvokerclass := FindEventInvokerClass(messageclone.InterfaceName);
|
|
eventInvoker := eventInvokerclass.Create(Self, messageclone, FALSE);
|
|
|
|
try
|
|
for idx := 0 to fHandlers.Count -1 do begin
|
|
if SameText(fHandlers[idx], messageclone.InterfaceName) then
|
|
eventInvoker.Execute(fHandlers.Objects[idx], tempstream);
|
|
end;
|
|
finally
|
|
FreeAndNIL(eventInvoker);
|
|
end;
|
|
finally
|
|
tempstream.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TROEventReceiver.OnTimerTick(Dummy: Cardinal);
|
|
var
|
|
eventsdata: Binary;
|
|
cnt : integer;
|
|
begin
|
|
if Channel.Busy then Exit;
|
|
CheckProperties;
|
|
|
|
eventsdata := NIL;
|
|
try
|
|
eventsdata := NIL;
|
|
try
|
|
cnt := Invoke_GetEventsData(eventsdata);
|
|
|
|
// Fires the events...
|
|
if (cnt>0) and (eventsdata<>NIL) then begin
|
|
Dispatch(eventsdata, fTimer);
|
|
end;
|
|
except
|
|
on e: Exception do
|
|
begin
|
|
if @fOnPollException <> nil then
|
|
fOnPollException(self, e);
|
|
end;
|
|
end;
|
|
|
|
finally
|
|
if (eventsdata<>NIL)
|
|
then eventsdata.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TROEventReceiver.RegisterEventHandlers(
|
|
const EventIDs: array of string;
|
|
const EventHandlers: array of TObject);
|
|
var clientid, eventID, eventtypes : string;
|
|
i : integer;
|
|
begin
|
|
// Adds a reference to the event handler object
|
|
clientid := GUIDTOString(Self.ClientID);
|
|
eventtypes := '';
|
|
|
|
for i := 0 to Length(EventIDs)-1 do begin
|
|
eventID := EventIDs[i];
|
|
eventtypes := eventtypes+eventID+',';
|
|
end;
|
|
Delete(eventtypes, Length(eventtypes), 1);
|
|
|
|
// Sends the remote request
|
|
if fEventAwareChannel = nil then
|
|
Invoke_RegisterEventClient(eventtypes);
|
|
|
|
//Moved here to avoid invalid list in case registration is incorrect.
|
|
//(for example if connection to server temporary broken)
|
|
for i := 0 to Length(EventIDs)-1 do begin
|
|
// Adds a reference to the local event handler object
|
|
eventID := EventIDs[i];
|
|
fHandlers.AddObject(eventID, EventHandlers[i]);
|
|
end;
|
|
end;
|
|
|
|
{$WARN SYMBOL_DEPRECATED OFF} // delphi warns on the implementation of this method because it's defined as deprecated.
|
|
function TROEventReceiver.EventHandlersIsRegistered(const EventIDs: array of string; const EventHandlers: array of TObject): boolean;
|
|
begin
|
|
result := AreEventHandlersRegistered(EventIDs, EventHandlers);
|
|
end;
|
|
{$WARN SYMBOL_DEPRECATED ON}
|
|
function TROEventReceiver.AreEventHandlersRegistered(const aEventIDs: array of string; const aEventHandlers: array of TObject): boolean;
|
|
|
|
var
|
|
i : integer;
|
|
|
|
begin
|
|
Result := True;
|
|
for i := 0 to Length(aEventIDs) - 1 do begin
|
|
if not IsEventHandlerRegistered(aEventIDs[i], aEventHandlers[i]) then begin
|
|
Result := False;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TROEventReceiver.IsEventHandlerRegistered(const aEventID: string; const aEventHandler: TObject): boolean;
|
|
var
|
|
j : integer;
|
|
begin
|
|
Result := False;
|
|
for j := 0 to fHandlers.Count - 1 do
|
|
if (fHandlers.Objects[j] = aEventHandler) and (fHandlers[j] = aEventID) then begin
|
|
Result := True;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
procedure TROEventReceiver.UnregisterEventHandlers(const EventIDs: array of string);
|
|
var clientid, eventID, eventtypes : string;
|
|
i, idx : integer;
|
|
begin
|
|
clientid := GUIDTOString(Self.ClientID);
|
|
eventtypes := '';
|
|
|
|
for i := 0 to Length(EventIDs)-1 do begin
|
|
eventID := EventIDs[i];
|
|
|
|
// Removes the reference to the local event handler object
|
|
idx := fHandlers.IndexOf(eventID);
|
|
if (idx>=0)
|
|
then fHandlers.Delete(idx);
|
|
|
|
eventtypes := eventtypes+eventID+',';
|
|
|
|
end;
|
|
|
|
Delete(eventtypes, Length(eventtypes), 1);
|
|
|
|
// Sends the remote request
|
|
if fEventAwareChannel = nil then
|
|
Invoke_UnregisterEventClient(eventtypes);
|
|
end;
|
|
|
|
function TROEventReceiver.GetClientID: TGUID;
|
|
begin
|
|
CheckProperties;
|
|
result := Message.ClientID;
|
|
end;
|
|
|
|
function TROEventReceiver.IsRetained(const anObject: TObject): boolean;
|
|
begin
|
|
result := (fRetainedObjects<>NIL) and (fRetainedObjects.IndexOf(anObject)>=0)
|
|
end;
|
|
|
|
procedure TROEventReceiver.ReleaseObject(const anObject: TObject);
|
|
var idx : integer;
|
|
begin
|
|
// Only creates it if necessary
|
|
if (fRetainedObjects=NIL) then Exit;
|
|
|
|
idx := fRetainedObjects.IndexOf(anObject);
|
|
if (idx>=0) then fRetainedObjects.Delete(idx);
|
|
end;
|
|
|
|
procedure TROEventReceiver.RetainObject(const anObject: TObject);
|
|
begin
|
|
// Only creates it if necessary
|
|
if (fRetainedObjects=NIL) then
|
|
fRetainedObjects := TList.Create;
|
|
|
|
fRetainedObjects.Add(anObject);
|
|
end;
|
|
|
|
|
|
type
|
|
TMyThread = class(TThread) end; // in d6 a thread is private
|
|
TSyncClass = class
|
|
private
|
|
fData: TStream;
|
|
fCaller: TROEventReceiver;
|
|
public
|
|
property Caller: TROEventReceiver read fCaller write fCaller;
|
|
property Data: TStream read fData write fData;
|
|
procedure DoDispatch;
|
|
end;
|
|
|
|
|
|
procedure TSyncClass.DoDispatch;
|
|
begin
|
|
fCaller.FireEvents(Data);
|
|
end;
|
|
|
|
|
|
procedure TROEventReceiver.Dispatch(aStream: TStream; aCaller: TThread);
|
|
var
|
|
lSync: TSyncClass;
|
|
begin
|
|
if fSynchronizeInvoke and Assigned(aCaller) then
|
|
begin
|
|
lSync := TSyncClass.Create;
|
|
try
|
|
lSync.Caller := Self;
|
|
lSync.Data := aStream;
|
|
TMyThread(aCaller).Synchronize(lSync.DoDispatch);
|
|
finally
|
|
lSync.Free;
|
|
end;
|
|
end else
|
|
FireEvents(aStream);
|
|
end;
|
|
|
|
function TROEventReceiver.GetSynchronizeInvoke: Boolean;
|
|
begin
|
|
Result := fSynchronizeInvoke;
|
|
end;
|
|
|
|
procedure TROEventReceiver.RegisterEventHandler(const EventID: string;
|
|
const EventHandler: TObject);
|
|
begin
|
|
RegisterEventHandlers([EventID], [EventHandler]);
|
|
end;
|
|
|
|
procedure TROEventReceiver.UnregisterEventHandlersByObject(
|
|
const EventHandler: array of TObject);
|
|
var clientid, eventID, eventtypes : string;
|
|
i, idx : integer;
|
|
begin
|
|
clientid := GUIDTOString(Self.ClientID);
|
|
eventtypes := '';
|
|
|
|
for i := 0 to Length(EventHandler)-1 do begin
|
|
|
|
// Removes the reference to the local event handler object
|
|
idx := fHandlers.IndexOfObject(EventHandler[i]);
|
|
if (idx>=0)
|
|
then begin
|
|
eventID := fHandlers[i];
|
|
fHandlers.Delete(idx)
|
|
end else continue;
|
|
|
|
eventtypes := eventtypes+eventID+',';
|
|
|
|
end;
|
|
|
|
Delete(eventtypes, Length(eventtypes), 1);
|
|
|
|
// Sends the remote request
|
|
// if fEventAwareChannel = nil then
|
|
Invoke_UnregisterEventClient(eventtypes);
|
|
end;
|
|
|
|
procedure TROEventReceiver.UnregisterEventHandler(
|
|
const EventHandler: TObject);
|
|
begin
|
|
UnregisterEventHandlersByObject([EventHandler]);
|
|
end;
|
|
|
|
procedure TROEventReceiver.UnregisterEventHandler(const EventIDs: string);
|
|
begin
|
|
UnregisterEventHandlers([EventIDs]);
|
|
end;
|
|
|
|
procedure TROEventReceiver.CheckProperties;
|
|
begin
|
|
Check(Channel = nil, Name + '.Channel must be assigned.');
|
|
Channel.CheckProperties;
|
|
Check(Message = nil, Name + '.Message must be assigned.');
|
|
Message.CheckProperties;
|
|
Check(ServiceName = '', Name + '.ServiceName must be set.');
|
|
end;
|
|
|
|
function TROEventReceiver.GetObject: TObject;
|
|
begin
|
|
result := Self;
|
|
end;
|
|
|
|
{ TROEventWriter }
|
|
|
|
constructor TROEventWriter.Create(const aMessage : IROMessage;
|
|
const aRepository : IROEventRepository);
|
|
begin
|
|
inherited Create(aMessage, TRUE);
|
|
|
|
fSessionList := TStringList.Create;
|
|
fSessionList.Sorted := TRUE;
|
|
fSessionList.Duplicates := dupIgnore;
|
|
|
|
fExcludeSender := TRUE;
|
|
fExcludeSessionList := FALSE; // By default only includes those in the session list
|
|
|
|
fRepository := aRepository;
|
|
end;
|
|
|
|
destructor TROEventWriter.Destroy;
|
|
begin
|
|
fRepository := NIL;
|
|
FreeAndNIL(fSessionList);
|
|
inherited;
|
|
end;
|
|
|
|
{function TROEventWriter.GetMessage: IROMessage;
|
|
begin
|
|
result := fMessage;
|
|
end;}
|
|
|
|
function TROEventWriter.GetExcludeSender: boolean;
|
|
begin
|
|
result := fExcludeSender
|
|
end;
|
|
|
|
function TROEventWriter.GetExcludeSessionList: boolean;
|
|
begin
|
|
result := fExcludeSessionList;
|
|
end;
|
|
|
|
function TROEventWriter.GetRepository: IROEventRepository;
|
|
begin
|
|
result := fRepository
|
|
end;
|
|
|
|
function TROEventWriter.GetSessionList: TStrings;
|
|
begin
|
|
result := fSessionList;
|
|
end;
|
|
|
|
procedure TROEventWriter.SetExcludeSender(const Value: boolean);
|
|
begin
|
|
fExcludeSender := Value
|
|
end;
|
|
|
|
procedure TROEventWriter.SetExcludeSessionList(const Value: boolean);
|
|
begin
|
|
fExcludeSessionList := Value
|
|
end;
|
|
|
|
{ TROEventProxy }
|
|
|
|
constructor TROEventProxy.Create(const aMessage: IROMessage; CloneMessage: boolean);
|
|
begin
|
|
inherited Create;
|
|
|
|
if CloneMessage then begin
|
|
if (aMessage=NIL) then raise EROException.Create(err_MessageNotAssigned);
|
|
fMessage := (aMessage as IROMessageCloneable).Clone
|
|
end
|
|
else fMessage := aMessage;
|
|
end;
|
|
|
|
destructor TROEventProxy.Destroy;
|
|
begin
|
|
fMessage := NIL;
|
|
inherited;
|
|
end;
|
|
|
|
function TROEventProxy.GetMessage: IROMessage;
|
|
begin
|
|
result := fMessage
|
|
end;
|
|
|
|
{ TROEventInvoker }
|
|
constructor TROEventInvoker.Create(anEventReceiver: TROEventReceiver;
|
|
const aMessage: IROMessage; CloneMessage: boolean);
|
|
begin
|
|
inherited Create(aMessage, CloneMessage);
|
|
|
|
fEventReceiver := anEventReceiver;
|
|
end;
|
|
|
|
destructor TROEventInvoker.Destroy;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
procedure TROEventInvoker.Execute(const aTarget : TObject; EventData: TStream);
|
|
var mtd : TROInvokerInvokeMethod;
|
|
intf : IInterface;
|
|
begin
|
|
__Message.ReadFromStream(EventData);
|
|
|
|
mtd := nil;
|
|
@mtd := MethodAddress('Invoke_'+__Message.MessageName);
|
|
if (@mtd <> nil) then begin
|
|
aTarget.GetInterface(IInterface, intf);
|
|
mtd(__EventReceiver, __Message, intf);
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TSyncClass }
|
|
|
|
{ TIROActiveEventServerList }
|
|
|
|
class function TIROActiveEventServerList.AddListener(
|
|
aList: IROActiveEventServerList;
|
|
aItem: IROActiveEventServer): IROActiveEventServerList;
|
|
begin
|
|
result := aList;
|
|
while aList <> nil do begin
|
|
if aList.Server = aItem then exit;
|
|
aList := aList.Next;
|
|
end;
|
|
Result := TIROActiveEventServerList.Create(Result, aItem);
|
|
end;
|
|
|
|
constructor TIROActiveEventServerList.Create(
|
|
aNext: IROActiveEventServerList; aItem: IROActiveEventServer);
|
|
begin
|
|
inherited Create;
|
|
fNext := aNext;
|
|
fServer := aItem;
|
|
end;
|
|
|
|
procedure TIROActiveEventServerList.DispatchEvent(
|
|
anEventDataItem: TROEventData; aSessionReference: TGUID;
|
|
aSender: TObject);
|
|
var
|
|
lItem: IROActiveEventServerList;
|
|
begin
|
|
lItem := Self;
|
|
while lItem <> nil do begin
|
|
lItem.Server.DispatchEvent(anEventDataItem, aSessionReference, aSender);
|
|
lItem := lItem.Next;
|
|
if lItem <> nil then
|
|
anEventDataItem.AddRef;
|
|
end;
|
|
end;
|
|
|
|
function TIROActiveEventServerList.GetNext: IROActiveEventServerList;
|
|
begin
|
|
result := fNext;
|
|
end;
|
|
|
|
function TIROActiveEventServerList.GetServer: IROActiveEventServer;
|
|
begin
|
|
result := fServer;
|
|
end;
|
|
|
|
class function TIROActiveEventServerList.RemoveListener(
|
|
aList: IROActiveEventServerList; aItem: IROActiveEventServer): IROActiveEventServerList;
|
|
var
|
|
lPrev: IROActiveEventServerList;
|
|
begin
|
|
lPrev := nil;
|
|
result := aList;
|
|
while aList <> nil do begin
|
|
if aList.Server = aItem then begin
|
|
if lPrev = nil then begin
|
|
result := aList.Next;
|
|
exit;
|
|
end else begin
|
|
lPrev.Next := aList.Next;
|
|
end;
|
|
end;
|
|
aList := aList.Next;
|
|
end;
|
|
end;
|
|
|
|
procedure TIROActiveEventServerList.SetNext(
|
|
aData: IROActiveEventServerList);
|
|
begin
|
|
fNext := aData;
|
|
end;
|
|
|
|
initialization
|
|
_EventInvokers := TStringList.Create;
|
|
_EventInvokers.Sorted := TRUE;
|
|
_EventInvokers.Duplicates := dupIgnore;
|
|
|
|
_EventWriters := TStringList.Create;
|
|
_EventWriters.Sorted := TRUE;
|
|
_EventWriters.Duplicates := dupIgnore;
|
|
|
|
finalization
|
|
FreeAndNIL(_EventInvokers);
|
|
FreeAndNIL(_EventWriters);
|
|
|
|
end.
|