372 lines
12 KiB
ObjectPascal
372 lines
12 KiB
ObjectPascal
|
unit uRORemoteDataModule;
|
||
|
|
|
||
|
|
{----------------------------------------------------------------------------}
|
||
|
|
{ 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,
|
||
|
|
{$IFDEF MSWINDOWS}Windows,{$ENDIF}
|
||
|
|
{$IFDEF DELPHI5}Forms,{$ENDIF}
|
||
|
|
// {$IFDEF FPC}Forms,{$ENDIF}
|
||
|
|
uROServerIntf, uROClientIntf, uROSessions, uROClasses, uROTypes, uROEventRepository, uROClient;
|
||
|
|
|
||
|
|
type { Events }
|
||
|
|
TActivateEvent = procedure(const aClientID : TGUID; aSession : TROSession; const aMessage : IROMessage) of object;
|
||
|
|
TDeactivateEvent = procedure(const aClientID : TGUID; aSession : TROSession) of object;
|
||
|
|
TGetDispatchInfoEvent = procedure(const aTransport : IROTransport; const aMessage : IROMessage) of object;
|
||
|
|
|
||
|
|
TRegisterEventClientEvent = procedure(const aClientID : TGUID; const EventTypes : string) of object;
|
||
|
|
|
||
|
|
{ TRORemoteDataModule }
|
||
|
|
TRORemoteDataModule = class(TDataModule, IROObjectActivation, IRODispatchNotifier, IROServerEventsBroker, IInterface, IROObjectRetainer)
|
||
|
|
private
|
||
|
|
fRefCount : integer;
|
||
|
|
fClientID: TGUID;
|
||
|
|
fOnActivate: TActivateEvent;
|
||
|
|
fOnDeactivate: TDeactivateEvent;
|
||
|
|
fSessionManager : TROCustomSessionManager;
|
||
|
|
fSession: TROSession;
|
||
|
|
fNewSession,
|
||
|
|
fRequiresSession,
|
||
|
|
fDestroySession : boolean;
|
||
|
|
fOnGetDispatchInfo: TGetDispatchInfoEvent;
|
||
|
|
fEventRepository: TROEventRepository;
|
||
|
|
fOnBeforeUnregisterEventClient: TRegisterEventClientEvent;
|
||
|
|
fOnBeforeRegisterEventClient: TRegisterEventClientEvent;
|
||
|
|
fTransport: IROTransport;
|
||
|
|
|
||
|
|
fRetainedObjects : TList;
|
||
|
|
|
||
|
|
procedure SetSessionManager(const Value: TROCustomSessionManager);
|
||
|
|
procedure SetEventRepository(const Value: TROEventRepository);
|
||
|
|
function GetSession: TROSession;
|
||
|
|
function GetEventRepository: TROEventRepository;
|
||
|
|
|
||
|
|
protected
|
||
|
|
{ IInterface }
|
||
|
|
function QueryInterface(const IID: TGUID; out Obj): HResult; reintroduce; virtual; stdcall;
|
||
|
|
function _AddRef: Integer; virtual; stdcall;
|
||
|
|
function _Release: Integer; virtual; stdcall;
|
||
|
|
|
||
|
|
{ IRODispatchNotifier }
|
||
|
|
procedure GetDispatchInfo(const aTransport : IROTransport; const aMessage : IROMessage); virtual;
|
||
|
|
|
||
|
|
{ IROObjectActivation }
|
||
|
|
procedure _OnActivate(aClientID: TGUID; const aMessage : IROMessage);
|
||
|
|
procedure _OnDeactivate(aClientID: TGUID);
|
||
|
|
procedure IROObjectActivation.OnActivate = _OnActivate;
|
||
|
|
procedure IROObjectActivation.OnDeactivate = _OnDeactivate;
|
||
|
|
|
||
|
|
{ IROServerEventsBroker }
|
||
|
|
procedure RegisterEventClient(const ClientID, EventTypes : string);
|
||
|
|
procedure UnregisterEventClient(const ClientID, EventTypes : string);
|
||
|
|
function GetEventsData(const ClientID : string; out EventsData : Binary) : integer;
|
||
|
|
|
||
|
|
{ IROObjectRetainer }
|
||
|
|
procedure RetainObject(const anObject : TObject);
|
||
|
|
function IsRetained(const anObject : TObject) : boolean;
|
||
|
|
procedure ReleaseObject(const anObject: TObject);
|
||
|
|
|
||
|
|
{ Internal }
|
||
|
|
procedure DoOnActivate(aClientID: TGUID; const aMessage : IROMessage); virtual;
|
||
|
|
procedure DoOnDeactivate(aClientID: TGUID); virtual;
|
||
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||
|
|
function CustomRequireSession(const aMessage : IROMessage) : boolean; virtual;
|
||
|
|
|
||
|
|
{$IFDEF DELPHI7UP}
|
||
|
|
procedure Synchronize(aMethod: TThreadMethod);
|
||
|
|
{$ENDIF DELPHI7UP}
|
||
|
|
public
|
||
|
|
constructor Create(aOwner : TComponent); override;
|
||
|
|
destructor Destroy; override;
|
||
|
|
|
||
|
|
procedure DestroySession;
|
||
|
|
|
||
|
|
property RefCount : integer read fRefCount;
|
||
|
|
property ClientID : TGUID read fClientID write fClientID;
|
||
|
|
property Transport: IROTransport read fTransport;
|
||
|
|
property Session : TROSession read GetSession;
|
||
|
|
property NewSession : boolean read fNewSession;
|
||
|
|
|
||
|
|
published
|
||
|
|
property RequiresSession : boolean read fRequiresSession write fRequiresSession default FALSE;
|
||
|
|
property SessionManager : TROCustomSessionManager read fSessionManager write SetSessionManager;
|
||
|
|
property EventRepository : TROEventRepository read GetEventRepository write SetEventRepository;
|
||
|
|
|
||
|
|
property OnActivate : TActivateEvent read fOnActivate write fOnActivate;
|
||
|
|
property OnDeactivate : TDeactivateEvent read fOnDeactivate write fOnDeactivate;
|
||
|
|
|
||
|
|
property OnBeforeRegisterEventClient : TRegisterEventClientEvent read fOnBeforeRegisterEventClient write fOnBeforeRegisterEventClient;
|
||
|
|
property OnBeforeUnregisterEventClient : TRegisterEventClientEvent read fOnBeforeUnregisterEventClient write fOnBeforeUnregisterEventClient;
|
||
|
|
|
||
|
|
property OnGetDispatchInfo : TGetDispatchInfoEvent read fOnGetDispatchInfo write fOnGetDispatchInfo;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TRORemoteDataModuleClass = class of TRORemoteDataModule;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
uses
|
||
|
|
SysUtils,
|
||
|
|
{$IFDEF DELPHI5}ComObj,{$ENDIF DELPHI5}
|
||
|
|
uRORes;
|
||
|
|
|
||
|
|
constructor TRORemoteDataModule.Create(aOwner: TComponent);
|
||
|
|
begin
|
||
|
|
inherited Create(aOwner);
|
||
|
|
end;
|
||
|
|
|
||
|
|
destructor TRORemoteDataModule.Destroy;
|
||
|
|
begin
|
||
|
|
FreeAndNIL(fRetainedObjects);
|
||
|
|
inherited;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TRORemoteDataModule._AddRef: Integer;
|
||
|
|
begin
|
||
|
|
if (csDesigning in ComponentState) then
|
||
|
|
result := -1
|
||
|
|
else
|
||
|
|
result := InterlockedIncrement(fRefCount);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TRORemoteDataModule._Release: Integer;
|
||
|
|
begin
|
||
|
|
if (csDesigning in ComponentState) then begin
|
||
|
|
result := -1
|
||
|
|
end
|
||
|
|
else begin
|
||
|
|
result := InterlockedDecrement(fRefCount);
|
||
|
|
if (result=0)
|
||
|
|
then Destroy;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TRORemoteDataModule.QueryInterface(const IID: TGUID;
|
||
|
|
out Obj): HResult;
|
||
|
|
begin
|
||
|
|
result := inherited QueryInterface(IID, Obj);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRORemoteDataModule._OnActivate(aClientID: TGUID; const aMessage : IROMessage);
|
||
|
|
begin
|
||
|
|
fClientID := aClientID;
|
||
|
|
|
||
|
|
DoOnActivate(aClientID, aMessage); // Loads the session if a session manager is assigned
|
||
|
|
|
||
|
|
if Assigned(fOnActivate)
|
||
|
|
then fOnActivate(aClientID, fSession, aMessage);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRORemoteDataModule._OnDeactivate(aClientID: TGUID);
|
||
|
|
begin
|
||
|
|
if Assigned(fOnDeactivate)
|
||
|
|
then fOnDeactivate(aClientID, fSession);
|
||
|
|
|
||
|
|
DoOnDeactivate(aClientID); // Releases the session
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRORemoteDataModule.DoOnActivate(aClientID: TGUID; const aMessage : IROMessage);
|
||
|
|
begin
|
||
|
|
if (csDesigning in ComponentState) then Exit;
|
||
|
|
|
||
|
|
fSession := NIL;
|
||
|
|
if not CustomRequireSession(aMessage) then Exit;
|
||
|
|
|
||
|
|
if Assigned(fSessionManager) then begin
|
||
|
|
fNewSession := FALSE;
|
||
|
|
fDestroySession := FALSE; // Resets the flags
|
||
|
|
|
||
|
|
fSession := fSessionManager.FindSession(aClientID);
|
||
|
|
|
||
|
|
if (fSession=NIL) then begin
|
||
|
|
|
||
|
|
if RequiresSession
|
||
|
|
then RaiseError(err_SessionNotFound, [GUIDToString(aClientID)], EROSessionNotFound)
|
||
|
|
else begin
|
||
|
|
fSession := fSessionManager.CreateSession(aClientID);
|
||
|
|
fNewSession := TRUE;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else begin
|
||
|
|
if RequiresSession then
|
||
|
|
RaiseError('SessionManager required, but not assigned');
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRORemoteDataModule.DoOnDeactivate(aClientID: TGUID);
|
||
|
|
var
|
||
|
|
lSessionID: TGUID;
|
||
|
|
begin
|
||
|
|
if (csDesigning in ComponentState) then Exit;
|
||
|
|
|
||
|
|
if Assigned(fSessionManager) and (fSession<>NIL) then begin
|
||
|
|
|
||
|
|
if fDestroySession then begin
|
||
|
|
if NewSession then begin
|
||
|
|
fSessionManager.DeleteTemporarySession(fSession)
|
||
|
|
end
|
||
|
|
else begin
|
||
|
|
lSessionID := fSession.SessionID;
|
||
|
|
fSessionManager.ReleaseSession(fSession, false);
|
||
|
|
fSessionManager.DeleteSession(lSessionID, false)
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else begin
|
||
|
|
fSessionManager.ReleaseSession(fSession, NewSession);
|
||
|
|
end;
|
||
|
|
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRORemoteDataModule.Notification(AComponent: TComponent;
|
||
|
|
Operation: TOperation);
|
||
|
|
begin
|
||
|
|
inherited;
|
||
|
|
|
||
|
|
if (Operation=opRemove) then begin
|
||
|
|
if (AComponent=fSessionManager) then fSessionManager := NIL
|
||
|
|
else if (AComponent=fEventRepository) then fEventRepository := NIL;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRORemoteDataModule.DestroySession;
|
||
|
|
begin
|
||
|
|
fDestroySession := TRUE;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRORemoteDataModule.GetDispatchInfo(const aTransport: IROTransport; const aMessage: IROMessage);
|
||
|
|
begin
|
||
|
|
if Assigned(fOnGetDispatchInfo) then
|
||
|
|
fOnGetDispatchInfo(aTransport, aMessage);
|
||
|
|
fTransport := aTransport;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TRORemoteDataModule.CustomRequireSession(const aMessage: IROMessage): boolean;
|
||
|
|
begin
|
||
|
|
result := not Assigned(aMessage) or not SameText(aMessage.MessageName, 'GetDescriptor');
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRORemoteDataModule.SetSessionManager(
|
||
|
|
const Value: TROCustomSessionManager);
|
||
|
|
begin
|
||
|
|
fSessionManager := Value;
|
||
|
|
if (fSessionManager<>NIL) then fSessionManager.FreeNotification(Self);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$IFDEF DELPHI7UP}
|
||
|
|
procedure TRORemoteDataModule.Synchronize(aMethod: TThreadMethod);
|
||
|
|
begin
|
||
|
|
TThread.Synchronize(nil, aMethod);
|
||
|
|
end;
|
||
|
|
{$ENDIF DELPHI7UP}
|
||
|
|
|
||
|
|
function TRORemoteDataModule.GetEventsData(const ClientID: string; out EventsData: Binary): integer;
|
||
|
|
begin
|
||
|
|
result := 0;
|
||
|
|
if (fEventRepository=NIL) then Exit;
|
||
|
|
|
||
|
|
EventsData := Binary.Create;
|
||
|
|
result := EventRepository.GetEventData(Session.SessionID, EventsData);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRORemoteDataModule.RegisterEventClient(const ClientID, EventTypes: string);
|
||
|
|
var
|
||
|
|
lActive: IROActiveEventServer;
|
||
|
|
begin
|
||
|
|
if Assigned(fOnBeforeRegisterEventClient) then
|
||
|
|
fOnBeforeRegisterEventClient(StringToGUID(ClientID), EventTypes);
|
||
|
|
|
||
|
|
if assigned(fEventRepository) then begin
|
||
|
|
if Supports(Transport, IROActiveEventServer, lActive) then
|
||
|
|
fEventRepository.AddSession(StringToGUID(ClientID), lActive)
|
||
|
|
else
|
||
|
|
fEventRepository.AddSession(StringToGUID(ClientID));
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRORemoteDataModule.UnregisterEventClient(const ClientID, EventTypes: string);
|
||
|
|
begin
|
||
|
|
if Assigned(fOnBeforeUnregisterEventClient) then
|
||
|
|
fOnBeforeUnregisterEventClient(StringToGUID(ClientID), EventTypes);
|
||
|
|
|
||
|
|
if assigned(fEventRepository) then
|
||
|
|
fEventRepository.RemoveSession(StringToGUID(ClientID));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRORemoteDataModule.SetEventRepository(const Value: TROEventRepository);
|
||
|
|
begin
|
||
|
|
if (fEventRepository=Value) then Exit;
|
||
|
|
|
||
|
|
fEventRepository := Value;
|
||
|
|
if (fEventRepository<>NIL) then
|
||
|
|
fEventRepository.FreeNotification(Self);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TRORemoteDataModule.GetSession: TROSession;
|
||
|
|
var errmsg : string;
|
||
|
|
begin
|
||
|
|
if not (csDesigning in ComponentState) then begin
|
||
|
|
if (fSession=NIL) then begin
|
||
|
|
errmsg := 'The session has not been initialized.';
|
||
|
|
if SessionManager=NIL then errmsg := errmsg+' '+Name+'''s SessionManager property is set to NIL.';
|
||
|
|
raise EROException.Create(errmsg);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
result := fSession;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TRORemoteDataModule.GetEventRepository: TROEventRepository;
|
||
|
|
var errmsg : string;
|
||
|
|
begin
|
||
|
|
if not (csDesigning in ComponentState) then begin
|
||
|
|
if (fEventRepository=NIL) then begin
|
||
|
|
errmsg := errmsg+' '+Name+'''s EventRepository property is not assigned';
|
||
|
|
raise EROException.Create(errmsg);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
result := fEventRepository;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TRORemoteDataModule.IsRetained(const anObject: TObject): boolean;
|
||
|
|
begin
|
||
|
|
result := (fRetainedObjects<>NIL) and (fRetainedObjects.IndexOf(anObject)>=0)
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRORemoteDataModule.RetainObject(const anObject: TObject);
|
||
|
|
begin
|
||
|
|
// Only creates it if necessary
|
||
|
|
if (fRetainedObjects=NIL) then
|
||
|
|
fRetainedObjects := TList.Create;
|
||
|
|
|
||
|
|
fRetainedObjects.Add(anObject);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRORemoteDataModule.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;
|
||
|
|
|
||
|
|
end.
|