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.