unit uROClient;

{----------------------------------------------------------------------------}
{ 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
  {$IFDEF REMOBJECTS_TRIAL}uROTrial,{$ENDIF}
  {$IFDEF RemObjects_UseEncryption}uROEncryption,{$ENDIF}
  Classes, SysUtils, TypInfo, uROTypes,
  uRODL, uROSerializer, uROClientIntf, uROClasses;

const
  EmptyGUID : TGUID = '{00000000-0000-0000-0000-000000000000}';

  MetadataRequestIDLength = 4;
  MetadataRequestID : array[0..MetadataRequestIDLength-1] of char = 'RODL';

  ProbeRequestIDLength = 5;
  ProbeRequestID : array[0..ProbeRequestIDLength-1] of char = 'PROBE';

  ProbeResponseIDLength = 8;
  ProbeResponseID : array[0..ProbeResponseIDLength-1] of char = 'PROBEDOK';

  name_Exception = 'ROException'; // User by the message components to write exceptions
  DataFormatXml = 'text/xml; charset="utf-8"';
  DataFormatBinary = 'application/binary';

type
  TROCustomRODLReader = class;
  TROMessage = class;
  TROTransportChannel = class;

  EROChannelBusy = class(EROException);

  EROUnknownType = class(EROUnknownItem);
  EROMessageTooLarge = class(EROException);

  EROSessionNotFound = class(EROException);
  EROSessionExpired = class(EROSessionNotFound);
  SessionNotFoundException = class(EROSessionNotFound);

  TROEventSinkType = (esWriter, esReader);
  { TROProxy }

  TROProxy = class(TInterfacedObject, IUnknown)
  private
    fMessage,
    fTransportChannel : pointer;
    // Weak references because the Application frees the components before ref counting steps in. This results in AVs

    fInterfaceName : string;

    function _GetMessage: IROMessage;  // cannot use "GetMessage" name for C++Builder compatibility
    function GetTransportChannel: IROTransportChannel;
    function GetInterfaceName:string;

  protected
    function __GetInterfaceName:string; virtual; abstract;

  public
    constructor Create(const aMessage : IROMessage; const aTransportChannel : IROTransportChannel); overload; virtual;

    // Added to support polymorphic invocation in Data Abstract. Shouldn't be used in regular situations.
    constructor Create(const anInterfaceName : string;
                       const aMessage : IROMessage;
                       const aTransportChannel : IROTransportChannel); overload; virtual;

    property __Message : IROMessage read _GetMessage;
    property __TransportChannel : IROTransportChannel read GetTransportChannel;
    property __InterfaceName:string read GetInterfaceName;
  end;

  TROProxyClass = class of TROProxy;

  { TROComponent }
  TROComponent = class(TComponent)
  end;

  { TROMessageAwareComponent }
  TROMessageAwareComponent = class(TROComponent)
  private
    fMessage: TROMessage;

  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetMessage(const Value: TROMessage); virtual;

  public
    property Message : TROMessage read fMessage write SetMessage;
  end;

  { TROChannelAwareComponent }
  TROChannelAwareComponent = class(TROMessageAwareComponent)
  private
    fChannel: TROTransportChannel;

  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetChannel(const Value: TROTransportChannel); virtual;

  public
    property Channel : TROTransportChannel read fChannel write SetChannel;
  end;

  { TROMessage }
  TStreamOperation = procedure(aStream : TStream) of object;

  TROServerExceptionEvent = procedure(anException : Exception; var RaiseException: boolean) of object;
  TROInitializeMessageEvent = procedure(Sender : TROMessage; const aTransport : IROTransport; const anInterfaceName, aMessageName : string) of object;
  TROFinalizeMessageEvent = procedure(Sender : TROMessage) of object;
  TROWriteMessageParameterEvent = procedure(Sender : TROMessage; const aName : string; aTypeInfo : PTypeInfo; const DataRef : pointer; Attributes : TParamAttributes) of object;
  TROReadMessageParameterEvent = procedure(Sender : TROMessage; const aName : string; aTypeInfo : PTypeInfo; const DataRef : pointer; Attributes : TParamAttributes) of object;
  TROWriteExceptionEvent = procedure(Sender : TROMessage; aStream: TStream; E : Exception) of object;


  { TROCustomRODLReader }
  TROReadRODLEvent = procedure(aRODLReader : TROCustomRODLReader; aStream : TStream) of object;

  TROCustomRODLReader = class(TROComponent)
  private
    fOnBeforeReadRODL: TROReadRODLEvent;
    fOnAfterReadRODL: TROReadRODLEvent;

  protected
    procedure DoReadRODLResource(aStream : TStream); virtual; abstract;

  public
    procedure ReadRODLResource(aStream : TStream);

  published
    property OnBeforeReadRODL : TROReadRODLEvent read fOnBeforeReadRODL write fOnBeforeReadRODL;
    property OnAfterReadRODL : TROReadRODLEvent read fOnAfterReadRODL write fOnAfterReadRODL;
  end;

  { TROMessage }
  TROMessage = class(TROComponent, IUnknown, IROMessage, IROMessageCloneable, IROModuleInfo)
  private
    fSerializer : TROSerializer;
    fMessageName,
    fInterfaceName : string;
    fOnReadFromStream: TStreamOperation;
    fOnWriteToStream: TStreamOperation;
    fOnServerException: TROServerExceptionEvent;

    fRefCount:integer;
    fReferenceCounted:boolean;
    fClientID : TGUID;
    fRODLReader: TROCustomRODLReader;
    fOnFinalizeMessage: TROFinalizeMessageEvent;
    fOnInitializeMessage: TROInitializeMessageEvent;
    fOnReadMessageParameter: TROReadMessageParameterEvent;
    fOnWriteMessageParameter: TROWriteMessageParameterEvent;
    fOnWriteException: TROWriteExceptionEvent;
    fAddServerExceptionPrefix: boolean;

    procedure SetRODLReader(const Value: TROCustomRODLReader);
    procedure TriggerOnWriteToStream(aStream: TStream);

  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    constructor CreateRefCountedClone(iMessage:TROMessage); virtual;

    procedure ProcessException;
    function ReadException : Exception; virtual; abstract;
    function CreateException(const aExceptionName, aMessage: string): Exception;

    { Internals }
    procedure InitObject; virtual;
    function CreateSerializer : TROSerializer; virtual; abstract;

    { IROUnknown }

    function _AddRef:integer; stdcall;
    function _Release:integer; stdcall;

    { IROMessage }
    procedure Initialize(const aTransport : IROTransport; const anInterfaceName, aMessageName : string; aType: TMessageType); overload; virtual;
    procedure Initialize(const aTransport : IROTransport; const aLibraryName, anInterfaceName, aMessageName : string; aType: TMessageType); overload; virtual;
    procedure InitializeRead(const aTransport : IROTransport); virtual;

    procedure InitializeRequestMessage(const aTransport : IROTransport; const aLibraryName, anInterfaceName, aMessageName : string);
    procedure InitializeResponseMessage(const aTransport : IROTransport; const aLibraryName, anInterfaceName, aMessageName : string);
    procedure InitializeEventMessage(const aTransport : IROTransport; const aLibraryName, anInterfaceName, aMessageName : string);
    procedure InitializeExceptionMessage(const aTransport : IROTransport; const aLibraryName, anInterfaceName, aMessageName : string); virtual;

    procedure Finalize; virtual;

    {$IFDEF DOTNET}
    {$ELSE}
    procedure Write(const aName : string; aTypeInfo : PTypeInfo; const Ptr; Attributes : TParamAttributes); virtual;
    procedure Read(const aName : string; aTypeInfo : PTypeInfo; var Ptr; Attributes : TParamAttributes); virtual;
    {$ENDIF}

    function GetClientID : TGUID;
    procedure SetClientID(const Value : TGUID);

    function GetMessageName : string;
    function GetInterfaceName : string;

    procedure SetInterfaceName(const aValue : string);
    procedure SetMessageName(const aValue : string);

    procedure WriteToStream(aStream : TStream); virtual;
    procedure ReadFromStream(aStream : TStream); overload; virtual;
    procedure ReadFromStream(aStream : TStream; var aFreeStream: Boolean); overload; virtual;

    procedure WriteException(aStream : TStream; anException : Exception); virtual;

    procedure FreeStream; virtual;
    function GetMessageType: TMessageType; virtual;

    { Writers }
    procedure WriteInteger(const aName : string; anOrdType : TOrdType; const Ref; ArrayElementId : integer = -1);
    procedure WriteInt64(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteEnumerated(const aName : string; anEnumTypeInfo : PTypeInfo; const Ref; ArrayElementId : integer = -1);
    procedure WriteUTF8String(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteWideString(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteDateTime(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteDouble(const aName : string; aFloatType : TFloatType; const Ref; ArrayElementId : integer = -1);
    procedure WriteVariant(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteXml(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteGuid(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteDecimal(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteStruct(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteArray(const aName : string; const Ref; ArrayElementId : integer = -1);
    procedure WriteBinary(const aName : string; const Ref; ArrayElementId : integer = -1);
    { Readers }
    procedure ReadInteger(const aName : string; anOrdType : TOrdType; var Ref; ArrayElementId : integer = -1);
    procedure ReadInt64(const aName : string; var Ref; ArrayElementId : integer = -1);
    procedure ReadEnumerated(const aName : string; anEnumTypeInfo : PTypeInfo; var Ref; ArrayElementId : integer = -1);
    procedure ReadUTF8String(const aName : string; var Ref; ArrayElementId : integer = -1; iMaxLength:integer=-1);
    procedure ReadWideString(const aName : string; var Ref; ArrayElementId : integer = -1; iMaxLength:integer=-1);
    procedure ReadDateTime(const aName : string; var Ref; ArrayElementId : integer = -1);
    procedure ReadDouble(const aName : string; aFloatType : TFloatType; var Ref; ArrayElementId : integer = -1);
    procedure ReadVariant(const aName : string; var Ref; ArrayElementId : integer = -1);
    procedure ReadXml(const aName : string; var Ref; ArrayElementId : integer = -1);
    procedure ReadGuid(const aName : string; var Ref; ArrayElementId : integer = -1);
    procedure ReadDecimal(const aName : string; var Ref; ArrayElementId : integer = -1);
    function ReadStruct(const aName : string; aClass : TClass; var Ref; ArrayElementId : integer = -1): Boolean;
    function ReadArray(const aName : string; aClass : TClass; var Ref; ArrayElementId : integer = -1): Boolean;
    procedure ReadBinary(const aName : string; var Ref; ArrayElementId : integer = -1);
    { IROModuleInfo }

    procedure GetModuleInfo(aStream : TStream; const aTransport : IROTransport; var aFormat : TDataFormat); virtual;
    procedure GetRodlInfo(aStream : TStream; const aTransport : IROTransport; var aFormat : TDataFormat); overload;

    { IROMessageClonable }
    function Clone: IROMessage;
    procedure SetAttributes(aTransport: IROTransport;
      const aNames: array of String; const aValues: array of String); virtual;
    procedure UnsetAttributes(aTransport: IROTransport); virtual;
  public

    constructor Create; reintroduce; overload; virtual;
    constructor Create(aOwner : TComponent); overload; override;
    destructor Destroy; override;

    procedure Assign(iSource:TPersistent); override;

    property Serializer : TROSerializer read fSerializer;

    property MessageName : string read GetMessageName write SetMessageName;
    property InterfaceName : string read GetInterfaceName write SetInterfaceName;

    property ClientID:TGuid read GetClientID write SetClientID;
    function IsValidMessage(aData: PChar; aLength: Integer): boolean; virtual; abstract;
    procedure CheckProperties; virtual;
  published
    property OnWriteToStream : TStreamOperation read fOnWriteToStream Write fOnWriteToStream;
    property OnReadFromStream : TStreamOperation read fOnReadFromStream Write fOnReadFromStream;
    property OnServerException : TROServerExceptionEvent read fOnServerException write fOnServerException;

    property RODLReader : TROCustomRODLReader read fRODLReader write SetRODLReader;
    property AddServerExceptionPrefix: boolean read fAddServerExceptionPrefix write fAddServerExceptionPrefix default true;

    property OnInitializeMessage : TROInitializeMessageEvent read fOnInitializeMessage write fOnInitializeMessage;
    property OnFinalizeMessage : TROFinalizeMessageEvent read fOnFinalizeMessage write fOnFinalizeMessage;
    property OnWriteMessageParameter : TROWriteMessageParameterEvent read fOnWriteMessageParameter write fOnWriteMessageParameter;
    property OnReadMessageParameter : TROReadMessageParameterEvent read fOnReadMessageParameter write fOnReadMessageParameter;
    property OnWriteException: TROWriteExceptionEvent read fOnWriteException write fOnWriteException;

  end;

  TROMessageClass = class of TROMessage;
  ExceptionClass = class of Exception;

  { TROTransportChannel }
  TRODispatchOption = (doFaultTolerant, doLoadBalanced);
  TRODispatchOptions = set of TRODispatchOption;

  TROBeginProbeServersEvent = procedure(Sender : TROTransportChannel) of object;
  TROEndProbeServersEvent = procedure(Sender : TROTransportChannel; ProbedCount, EnabledCount, DisabledCount : integer) of object;

  TROBeginProbeServerEvent = procedure(Sender : TROTransportChannel; aServerLocator : TROServerLocator) of object;
  TROEndProbeServerEvent = procedure(Sender : TROTransportChannel; aServerLocator : TROServerLocator; Failed : boolean) of object;

  TStreamDispatch = procedure(aStream : TStream) of object;

  TServerLocatorAssignment = procedure(Sender : TROTransportChannel;
                                       aLocator : TROServerLocator;
                                       aException : Exception) of object;

  TProgressType = (ptUnknown, ptStart, ptInProgress, ptDone);
  TProgressDirection = (pdUnknown, pdSending, pdReceiving);
  TProgressEvent = procedure(iSender:TObject; iType:TProgressType; iDirection:TProgressDirection; iTransferred,iTotal:integer) of object;

  TROExceptionEvent = procedure(Sender: TROTransportChannel; anException: Exception; var aRetry: Boolean) of object;


  { TROBaseConnection }
  TROBaseConnection = class(TROComponent)
  private
    {$IFDEF RemObjects_UseEncryption}
    fEncryption: TROEncryption;
    procedure SetEncryption(NewValue: TROEncryption);
    {$ENDIF}
  protected
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    {$IFDEF RemObjects_UseEncryption}
    procedure DoEncryption(iPlainText, iCipherText: TStream); virtual;
    procedure DoDecryption(iCipherText, iPlainText: TStream); virtual;
    {$ENDIF}

  published
    {$IFDEF RemObjects_UseEncryption}
    property Encryption: TROEncryption read fEncryption write SetEncryption;
    {$ENDIF}
  end;


  {$ifdef REMOBJECTS_UseEncryption}
  TROTransportChannel = class(TROBaseConnection, IROTransportChannel, IROTransport, IROMetadataReader)
  {$else}
  TROTransportChannel = class(TComponent, IROTransportChannel, IROTransport, IROMetadataReader)
  {$endif}
  private
    fOnReceiveStream : TStreamDispatch;
    fOnSendStream : TStreamDispatch;
    fBusy: boolean;
    fOnProgress: TProgressEvent;
    fServerLocators: TROServerLocatorCollection;
    fOnServerLocatorAssignment : TServerLocatorAssignment;
    fDispatchOptions: TRODispatchOptions;

    fCurrentLocator : TROServerLocator;

    fLoadBalancerLocatorIdx,
    fFaultToleranceLocatorIdx : integer;
    fProbingClone : TROTransportChannel;

    fProbeTimer : TROThreadTimer;
    fLoadedProbeServers,
    fProbeServers: boolean;
    fProbeFrequency: cardinal;
    fOnBeforeProbingServers: TROBeginProbeServersEvent;
    fOnAfterProbingServers: TROEndProbeServersEvent;
    fOnBeforeProbingServer: TROBeginProbeServerEvent;
    fOnAfterProbingServer: TROEndProbeServerEvent;
    fSynchronizedProbing: Boolean;
    fOnLoginNeeded: TROExceptionEvent;
    fOnException: TROExceptionEvent;
    fThreadSafe: Boolean;

    { IROTransportChannel }
    procedure Dispatch(aRequest, aResponse : TStream); reintroduce; overload; 

    procedure SetProbeFrequency(const Value: cardinal);
    procedure SetProbeServers(const Value: boolean);
    procedure SetServerLocators(const Value: TROServerLocatorCollection);
    procedure SetCurrentLocator(const Value: TROServerLocator);
    procedure OnProbeTimerTick(Dummy: Cardinal);
    procedure SetSynchronizedProbing(const Value: Boolean);
  protected
    property ThreadSafe: Boolean read fThreadSafe write fThreadSafe;
    procedure Loaded; override;
    { IROTransport }
    function GetTransportObject : TObject; virtual; abstract;

    { IROTransportChannel }
    procedure Dispatch(aMessage: IROMessage); reintroduce; overload;
    function Probe(aServerLocator : TROServerLocator) : boolean;
    procedure ProbeAll;
    procedure SetServerLocator(aServerLocator : TROServerLocator; anException : Exception = NIL);

    { IROMetadataReader }
    procedure RetrieveMetadata(out Metadata : TStream); virtual;
    procedure RetrieveRODL(out RODLLibrary : TRODLLibrary);

    { TROTransportChannel }
    procedure IntDispatch(aRequest, aResponse : TStream); virtual; abstract;
    procedure IntSetServerLocator(aServerLocator : TROServerLocator); virtual; abstract;

    procedure TriggerProgress(iType:TProgressType; iDirection:TProgressDirection; iTransfered,iTotal:integer);

    procedure BeforeDispatch(aMessage: IROMessage); virtual;
  public
    constructor Create(aOwner : TComponent); override;
    destructor Destroy; override;

    procedure Assign(aSource : TPersistent); override;

    property CurrentLocator : TROServerLocator read fCurrentLocator write SetCurrentLocator;

    property Busy : boolean read fBusy;
    property LoadBalancerLocatorIdx : Integer read fLoadBalancerLocatorIdx write fLoadBalancerLocatorIdx;
    property FaultToleranceLocatorIdx : integer read fFaultToleranceLocatorIdx write fFaultToleranceLocatorIdx;
    procedure CheckProperties; virtual;
  public
    property SynchronizedProbing: Boolean read fSynchronizedProbing write SetSynchronizedProbing default true;
    property OnSendStream : TStreamDispatch read fOnSendStream write fOnSendStream;
    property OnReceiveStream : TStreamDispatch read fOnReceiveStream write fOnReceiveStream;
    property OnServerLocatorAssignment : TServerLocatorAssignment read fOnServerLocatorAssignment write fOnServerLocatorAssignment;
    property ProbeServers : boolean read fProbeServers write SetProbeServers default false;
    property ProbeFrequency : cardinal read fProbeFrequency write SetProbeFrequency default 60000;
    property OnBeforeProbingServers : TROBeginProbeServersEvent read fOnBeforeProbingServers write fOnBeforeProbingServers;
    property OnAfterProbingServers : TROEndProbeServersEvent read fOnAfterProbingServers write fOnAfterProbingServers;
    property OnBeforeProbingServer : TROBeginProbeServerEvent read fOnBeforeProbingServer write fOnBeforeProbingServer;
    property OnAfterProbingServer : TROEndProbeServerEvent read fOnAfterProbingServer write fOnAfterProbingServer;
    property OnLoginNeeded : TROExceptionEvent read fOnLoginNeeded write fOnLoginNeeded;
    property OnProgress:TProgressEvent read fOnProgress write fOnProgress;
    property ServerLocators : TROServerLocatorCollection read fServerLocators write SetServerLocators;
    property DispatchOptions : TRODispatchOptions read fDispatchOptions write fDispatchOptions;
  published
    property OnFailure : TROExceptionEvent read fOnException write fOnException; { deprecated }
    property OnException : TROExceptionEvent read fOnException write fOnException;
  end;

  TROTransportChannelClass = class of TROTransportChannel;

  { IROObjectRetainer }
  IROObjectRetainer = interface
  ['{1DFCCCAB-CD61-415F-ADFB-258C067E9A59}']
    procedure RetainObject(const anObject : TObject);
    procedure ReleaseObject(const anObject : TObject);
    function IsRetained(const anObject : TObject) : boolean;
  end;

  { TROObjectDisposer }
  TROObjectDisposer = class(TList)
  private
    fService : IInterface;

  public
    constructor Create(const aService : IInterface);
    destructor Destroy; override;

    procedure Add(iObject: TObject);
  end;

{ Message class registration routines }
procedure RegisterMessageClass(aROMessageClass : TROMessageClass);
procedure UnregisterMessageClass(aROMessageClass : TROMessageClass);
function GetMessageClass(Index : integer) : TROMessageClass;
function GetMessageClassCount : integer;
function FindMessageClass(const aName : string; Silent : boolean = FALSE) : TROMessageClass;
procedure ListMessageClasses(aList : TStrings);

{ Proxy registration }
procedure RegisterProxyClass(const anInterfaceID : TGUID; aProxyClass : TROProxyClass);
procedure UnregisterProxyClass(const anInterfaceID : TGUID);
function FindProxyClass(const anInterfaceID : TGUID; Silent : boolean = FALSE) : TROProxyClass;
procedure ListProxyClasses(aList : TStrings);

{ Exception registration }
function GetExceptionClass(const anExceptionClassName : string) : ExceptionClass;
procedure RegisterExceptionClass(anExceptionClass : ExceptionClass);
procedure UnregisterExceptionClass(anExceptionClass : ExceptionClass);

{ Transport channels registration }
procedure RegisterTransportChannelClass(aTransportChannelClass : TROTransportChannelClass);
procedure UnregisterTransportChannelClass(aTransportChannelClass : TROTransportChannelClass);
function FindTransportChannelClass(const aName : string; Silent : boolean = FALSE) : TROTransportChannelClass;
procedure ListTransportChannelClasses(aList : TStrings);

procedure GetRodl(aStream: TStream; const aTransport : IROTransport; var aFormat : TDataFormat; ARODLReader: TROCustomRODLReader = nil);
function GetRodlLibrary(ARodlReader: TROCustomRODLReader = nil): TRODLLibrary;

implementation

uses {$IFDEF MSWINDOWS}Windows, {$ENDIF}
     {$IFDEF KYLIX}Types, Libc, {$ENDIF}
     {$IFDEF DEBUG_REMOBJECTS}eDebugServer,{$ENDIF}
     uRORes, uROHTTPTools, uRODLToXML;

var _MessageClasses : TClassList;
    _ExceptionClasses : TClassList;

procedure RegisterMessageClass(aROMessageClass : TROMessageClass);
begin
  _MessageClasses.Add(aROMessageClass);
  Classes.RegisterClass(aROMessageClass);
end;

procedure UnregisterMessageClass(aROMessageClass : TROMessageClass);
begin
  _MessageClasses.Remove(aROMessageClass);
  Classes.UnRegisterClass(aROMessageClass);
end;

function GetMessageClass(Index : integer) : TROMessageClass;
begin
  result := TROMessageClass(_MessageClasses[Index]);
end;

function GetMessageClassCount : integer;
begin
  result := _MessageClasses.Count
end;

function FindMessageClass(const aName : string; Silent : boolean = FALSE) : TROMessageClass;
var i: integer;
begin
  result := NIL;
  for i := 0 to (_MessageClasses.Count-1) do
    if SameText(TROMessageClass(_MessageClasses[i]).ClassName, aName) then begin
      result := TROMessageClass(_MessageClasses[i]);
      Exit;
    end;

  if not Silent
    then RaiseError(err_UnknownMessageClass, [aName]);
end;

procedure ListMessageClasses(aList : TStrings);
var i: integer;
begin
  for i := 0 to (_MessageClasses.Count-1) do
    aList.Add(TROMessageClass(_MessageClasses[i]).ClassName);
end;
var _ProxyClasses,
    _TransportChannels : TStringList;

{ Transport channels registration }
procedure RegisterTransportChannelClass(aTransportChannelClass : TROTransportChannelClass);
begin
  if _TransportChannels.IndexOf(aTransportChannelClass.ClassName)<0 then begin
    _TransportChannels.AddObject(aTransportChannelClass.ClassName, TObject(aTransportChannelClass));
    Classes.RegisterClass(aTransportChannelClass);
  end;
end;

procedure UnregisterTransportChannelClass(aTransportChannelClass : TROTransportChannelClass);
var idx : integer;
begin
  idx := _TransportChannels.IndexOf(aTransportChannelClass.ClassName);
  if idx>=0 then begin
    _TransportChannels.Delete(idx);
    Classes.UnregisterClass(aTransportChannelClass);
  end;
end;

function FindTransportChannelClass(const aName : string; Silent : boolean = FALSE) : TROTransportChannelClass;
var idx : integer;
begin
  result := nil;
  idx := _TransportChannels.IndexOf(aName);
  if (idx>=0)
    then result := TROTransportChannelClass(_TransportChannels.Objects[idx])
  else begin
    if not Silent
      then RaiseError(err_UnknownTransportChannelClass, [aName])
  end;
end;

procedure ListTransportChannelClasses(aList : TStrings);
begin
  aList.Assign(_TransportChannels);
end;

{ Proxy registration }
procedure RegisterProxyClass(const anInterfaceID : TGUID; aProxyClass : TROProxyClass);
var s : string;
begin
  s := GUIDToString(anInterfaceID);
  if _ProxyClasses.IndexOf(s)<0
    then _ProxyClasses.AddObject(GUIDToString(anInterfaceID), TObject(aProxyClass))
end;

procedure UnregisterProxyClass(const anInterfaceID : TGUID);
var idx : integer;
    s : string;
begin
  s := GUIDToString(anInterfaceID);
  idx := _ProxyClasses.IndexOf(s);
  if (idx>=0)
    then _ProxyClasses.Delete(idx)
end;

function FindProxyClass(const anInterfaceID : TGUID; Silent : boolean = FALSE) : TROProxyClass;
var idx : integer;
    s : string;
begin
  result := NIL;
  s := GUIDToString(anInterfaceID);
  idx := _ProxyClasses.IndexOf(s);
  if (idx>=0)
    then result := TROProxyClass(_ProxyClasses.Objects[idx])
  else begin
    if not Silent
      then RaiseError(err_UnknownProxyInterface, [s])
  end;
end;

procedure ListProxyClasses(aList : TStrings);
begin
  aList.Assign(_ProxyClasses);
end;

{ Exceptions registration }
function GetExceptionClass(const anExceptionClassName : string) : ExceptionClass;
var i : integer;
begin
  result := EROUnregisteredServerException;

  for i := 0 to (_ExceptionClasses.Count-1) do
    {$IFDEF DOTNET}
    if (ExceptionClass(_ExceptionClasses[i]).ClassName = anExceptionClassName) then begin
    {$ELSE}
    if (CompareText(ExceptionClass(_ExceptionClasses[i]).ClassName, anExceptionClassName)=0) then begin
    {$ENDIF DOTNET}
      result := ExceptionClass(_ExceptionClasses[i]);
      Exit;
    end;
end;

procedure RegisterExceptionClass(anExceptionClass : ExceptionClass);
begin
  _ExceptionClasses.Add(anExceptionClass)
end;

procedure UnregisterExceptionClass(anExceptionClass : ExceptionClass);
begin
  _ExceptionClasses.Remove(anExceptionClass)
end;

{ TROProxy }

constructor TROProxy.Create(const aMessage: IROMessage;
  const aTransportChannel: IROTransportChannel);
begin
  inherited Create;
  fMessage := pointer(aMessage);
  fTransportChannel := pointer(aTransportChannel);
end;

constructor TROProxy.Create(const anInterfaceName: string;
  const aMessage: IROMessage;
  const aTransportChannel: IROTransportChannel);
begin
  Create(aMessage, aTransportChannel);

  fInterfaceName := anInterfaceName;
end;

function TROProxy.GetInterfaceName: string;
begin
  if (fInterfaceName<>'')
    then result := fInterfaceName // If the proxy has been created specifiing one then that is the strongest
    else result := __GetInterfaceName;
end;

function TROProxy._GetMessage: IROMessage;
begin
  result := IROMessage(fMessage);
end;

function TROProxy.GetTransportChannel: IROTransportChannel;
begin
  result := IROTransportChannel(fTransportChannel);
end;

{ TROMessageAwareComponent }

procedure TROMessageAwareComponent.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;

  if (Operation<>opRemove) then Exit;

  if (AComponent=fMessage) then fMessage := NIL;
end;

procedure TROMessageAwareComponent.SetMessage(const Value: TROMessage);
begin
  if (fMessage=Value) then Exit;

  fMessage := Value;
  if (fMessage<>NIL) then fMessage.FreeNotification(Self);
end;

{ TROMessage }
constructor TROMessage.Create(aOwner : TComponent);
begin
  inherited Create(aOwner);
  InitObject;
end;

constructor TROMessage.Create;
begin
  inherited Create(NIL);
  InitObject;
end;

function TROMessage.CreateException(const aExceptionName, aMessage: string): Exception;
var
  lExceptionClass: ExceptionClass;
begin
  lExceptionClass := GetExceptionClass(aExceptionName);

  if Assigned(lExceptionClass) then begin
    // The exception was registered so we can reraise the right type
    if AddServerExceptionPrefix then
      result := lExceptionClass.Create(Format(str_ExceptionReraisedFromServer,[aMessage]))
    else
      result := lExceptionClass.Create(aMessage);

  end
  else begin
    // Un-registered exception. We fire a EROUnregisteredServerException
    if AddServerExceptionPrefix then
      result := EROUnregisteredServerException.CreateFmt(str_ExceptionOnServer, [aExceptionName, aMessage])
    else
      result := EROUnregisteredServerException.Create(aMessage);
  end;
end;

destructor TROMessage.Destroy;
begin
  if Assigned(fSerializer)
    then FreeAndNIL(fSerializer);

  inherited;
end;

procedure TROMessage.InitObject;
begin
  fAddServerExceptionPrefix := true;
  fSerializer := CreateSerializer;
  fClientID := NewGuid();
  //CreateGUID(fClientID);
end;

procedure TROMessage.Initialize(const aTransport : IROTransport; const anInterfaceName, aMessageName: string; aType: TMessageType);
begin
  if Assigned(fOnInitializeMessage) then fOnInitializeMessage(Self, aTransport, anInterfaceName, aMessageName);

  fInterfaceName := anInterfaceName;
  fMessageName := aMessageName;
end;

procedure TROMessage.Initialize(const aTransport: IROTransport; const aLibraryName, anInterfaceName, aMessageName: string; aType: TMessageType);
begin
  Initialize(aTransport, anInterfaceName, aMessageName, aType);
end;

procedure TROMessage.Finalize;
begin
  //FreeAndNIL(fSerializer);
  if Assigned(fOnFinalizeMessage) then fOnFinalizeMessage(Self);
end;

function TROMessage.GetInterfaceName: string;
begin
  result := fInterfaceName
end;

function TROMessage.GetMessageName: string;
begin
  result := fMessageName
end;

procedure TROMessage.SetInterfaceName(const aValue: string);
begin
  fInterfaceName := aValue
end;

procedure TROMessage.SetMessageName(const aValue: string);
begin
  fMessageName := aValue
end;

procedure TROMessage.GetModuleInfo(aStream : TStream; const aTransport : IROTransport; var aFormat : TDataFormat);
begin
  GetRodlInfo(aStream, aTransport, aFormat);
end;

procedure TROMessage.GetRodlInfo(aStream : TStream; const aTransport : IROTransport; var aFormat : TDataFormat);
begin
  GetRodl(aStream, aTransport, aFormat, fRODLReader);
end;

procedure GetRodl(aStream: TStream; const aTransport : IROTransport; var aFormat : TDataFormat; ARODLReader: TROCustomRODLReader);
var rs : TResourceStream;
    instance : cardinal;
begin
  { ToDo: investigate if we should maybe use hMainInstance instead? the current one
          breaks with Packages, hMainInstance wouldn't work with DLLs. Since packages
          are currently not supported, i suggest we keep this the way it is? mh.

    Alef: the following "IF" seems to nicely solve the problem... }
  if Assigned(ARODLReader) then
    ARODLReader.ReadRODLResource(aStream)
  else begin
  {$IFNDEF FPC}
    if ModuleIsPackage then
      instance := MainInstance
    else
  {$ENDIF}
     instance := hInstance;

    rs := TResourceStream.Create(instance, res_RODLFile, RT_RCDATA);
    try
      rs.SaveToStream(aStream);
    finally
      rs.Free;
    end;
  end;

  if aTransport <> nil then
    SetHTTPInfo(aTransport, DataFormatXml);
  aFormat := DataFormatXml;
end;

function GetRodlLibrary(ARodlReader: TROCustomRODLReader): TRODLLibrary;
var
  lStream: TMemoryStream;
  lDummy: TDataFormat;
  lXmlToRodl: TXMLToRODL;
begin
  lStream := TMemoryStream.Create;
  lXmlToRodl := TXMLToRODL.Create;
  try
    GetRodl(lStream, nil, lDummy, ARodlReader);
    lStream.Position := 0;
    result := lXmlToRodl.Read(lStream);
  finally
    lXmlToRodl.Free;
    lStream.Free;
  end;
end;


procedure TROMessage.ReadFromStream(aStream: TStream);
begin
  if Assigned(fOnReadFromStream) then fOnReadFromStream(aStream);
  aStream.Position := 0; // Just in case
end;

procedure TROMessage.WriteToStream(aStream: TStream);
begin
  TriggerOnWriteToStream(aStream);
end;

procedure TROMessage.TriggerOnWriteToStream(aStream: TStream);
begin
  if Assigned(fOnWriteToStream) then begin
    aStream.Position := 0; // Just in case
    fOnWriteToStream(aStream);
  end;
  aStream.Position := 0; // Just in case
end;

{$IFDEF DOTNET}
{$ELSE}
procedure TROMessage.Read(const aName: string; aTypeInfo: PTypeInfo;
  var Ptr; Attributes: TParamAttributes);
begin
  Serializer.Read(aName, aTypeInfo, Ptr);
  if Assigned(fOnReadMessageParameter) then fOnReadMessageParameter(Self, aName, aTypeInfo, pointer(Ptr), Attributes);  
end;

procedure TROMessage.Write(const aName: string; aTypeInfo: PTypeInfo;
  const Ptr; Attributes: TParamAttributes);
begin
  if Assigned(fOnWriteMessageParameter) then fOnWriteMessageParameter(Self, aName, aTypeInfo, pointer(Ptr), Attributes);
  Serializer.Write(aName, aTypeInfo, Ptr);
end;
{$ENDIF DOTNET}

procedure TROMessage.ProcessException;
var E: Exception;
    raiseException: boolean;
begin
  E := ReadException;
  raiseException := TRUE;
  if Assigned(E) then begin
    if Assigned(fOnServerException) then fOnServerException(E, raiseException);

    if raiseException then raise E;
  end;
end;

function TROMessage.Clone: IROMessage;
begin
  result := TROMessageClass(ClassType).CreateRefCountedClone(self) as IROMessage;
end;

constructor TROMessage.CreateRefCountedClone(iMessage: TROMessage);
begin
  Create();
  Assign(iMessage);
  fReferenceCounted := true;

  //Todo: implement reference counting;
end;

procedure TROMessage.Assign(iSource: TPersistent);
var lSource:TROMessage;
begin
  if Assigned(iSource) then begin

    // might very well be a descendand, too
    if not (iSource is ClassType)
      then RaiseError('Cannot Assign a %s t a %s', [ClassName,iSource.ClassName]);

    lSource := TROMessage(iSource);

    Self.RODLReader := lSource.RODLReader;    
    Self.OnWriteToStream := lSource.OnWriteToStream;
    Self.OnReadFromStream := lSource.OnReadFromStream;
    Self.OnServerException := lSource.OnServerException;
    Self.OnWriteException := lSource.OnWriteException;

    Self.OnInitializeMessage     := lSource.OnInitializeMessage;
    Self.OnFinalizeMessage       := lSource.OnFinalizeMessage;
    Self.OnWriteMessageParameter := lSource.OnWriteMessageParameter;
    Self.OnReadMessageParameter  := lSource.OnReadMessageParameter;
  end;
end;

function TROMessage._AddRef: integer;
begin
  result := InterlockedIncrement(fRefCount);
end;

function TROMessage._Release: integer;
begin
  result := InterlockedDecrement(fRefCount);

  if (fRefCount = 0) and fReferenceCounted then Free();
end;

function TROMessage.GetClientID: TGUID;
begin
  result := fClientID;
end;

procedure TROMessage.SetClientID(const Value: TGUID);
begin
  fClientID := Value
end;

procedure TROMessage.SetRODLReader(const Value: TROCustomRODLReader);
begin
  fRODLReader := Value;
  if Assigned(fRODLReader) then fRODLReader.FreeNotification(Self);
end;

procedure TROMessage.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;

  if (Operation=opRemove) and (aComponent=fRODLReader)
    then fRODLReader := NIL;
end;

procedure TROMessage.WriteException(aStream: TStream;
  anException: Exception);
begin
  if Assigned(fOnWriteException) then begin
    fOnWriteException(Self, aStream, anException);
  end;
  TriggerOnWriteToStream(aStream);
end;

procedure TROMessage.InitializeRequestMessage(
  const aTransport: IROTransport; const aLibraryName, anInterfaceName,
  aMessageName: string);
begin
  Initialize(aTransport, aLibraryName, anInterfaceName,aMessageName, mtRequest);
end;

procedure TROMessage.InitializeResponseMessage(
  const aTransport: IROTransport; const aLibraryName, anInterfaceName,
  aMessageName: string);
begin
  Initialize(aTransport, aLibraryName, anInterfaceName,aMessageName, mtResponse);
end;

procedure TROMessage.InitializeEventMessage(const aTransport: IROTransport;
  const aLibraryName, anInterfaceName, aMessageName: string);
begin
  Initialize(aTransport, aLibraryName, anInterfaceName,aMessageName, mtEvent);
end;

procedure TROMessage.ReadFromStream(aStream: TStream;
  var aFreeStream: Boolean);
begin
  aFreeStream := True;
  ReadFromStream(aStream);
end;

procedure TROMessage.FreeStream;
begin
  
end;

function TROMessage.GetMessageType: TMessageType;
begin
  Result := mtRequest;
end;

procedure TROMessage.InitializeExceptionMessage(
  const aTransport: IROTransport; const aLibraryName, anInterfaceName,
  aMessageName: string);
begin
  // do nothing here; descendents can override this to set the types
end;

procedure TROMessage.SetAttributes(aTransport: IROTransport; const aNames,
  aValues: array of String);
begin
  // overridable
end;

procedure TROMessage.UnsetAttributes(aTransport: IROTransport);
begin
  // overridable
end;

procedure TROMessage.InitializeRead(const aTransport: IROTransport);
begin
  // do nothing.
end;

procedure TROMessage.CheckProperties;
begin
// nothing
end;

procedure TROMessage.ReadDateTime(const aName: string; var Ref;
  ArrayElementId: integer);
begin
  fSerializer.ReadDateTime(aName, Ref, ArrayElementId);
end;

procedure TROMessage.ReadDecimal(const aName: string; var Ref;
  ArrayElementId: integer);
begin
  fSerializer.ReadDecimal(aName, Ref, ArrayElementId);
end;

procedure TROMessage.ReadEnumerated(const aName: string;
  anEnumTypeInfo: PTypeInfo; var Ref; ArrayElementId: integer);
begin
  fSerializer.ReadEnumerated(aName, anEnumTypeInfo, Ref, ArrayElementId);
end;

procedure TROMessage.ReadDouble(const aName: string; aFloatType: TFloatType;
  var Ref; ArrayElementId: integer);
begin
  fSerializer.ReadDouble(aName, aFloatType, Ref, ArrayElementId);
end;

procedure TROMessage.ReadGuid(const aName: string; var Ref;
  ArrayElementId: integer);
begin
  fSerializer.ReadGuid(aName, Ref, ArrayElementId);
end;

procedure TROMessage.ReadInt64(const aName: string; var Ref;
  ArrayElementId: integer);
begin
  fSerializer.ReadInt64(aName, Ref, ArrayElementId);
end;

procedure TROMessage.ReadInteger(const aName: string; anOrdType: TOrdType;
  var Ref; ArrayElementId: integer);
begin
  fSerializer.ReadInteger(aName, anOrdType, Ref, ArrayElementId);
end;

procedure TROMessage.ReadUTF8String(const aName: string; var Ref;
  ArrayElementId, iMaxLength: integer);
begin
  fSerializer.ReadUTF8String(aName, Ref, ArrayElementId, iMaxLength);
end;

procedure TROMessage.ReadVariant(const aName: string; var Ref;
  ArrayElementId: integer);
begin
  fSerializer.ReadVariant(aName, Ref, ArrayElementId);
end;

procedure TROMessage.ReadWideString(const aName: string; var Ref;
  ArrayElementId, iMaxLength: integer);
begin
  fSerializer.ReadWideString(aName, Ref, ArrayElementId, iMaxLength);
end;

procedure TROMessage.ReadXml(const aName: string; var Ref;
  ArrayElementId: integer);
begin
  fSerializer.ReadXml(aName, Ref, ArrayElementId);
end;

procedure TROMessage.WriteDateTime(const aName: string; const Ref;
  ArrayElementId: integer);
begin
  fSerializer.WriteDateTime(aName, Ref, ArrayElementId);
end;

procedure TROMessage.WriteDecimal(const aName: string; const Ref;
  ArrayElementId: integer);
begin
  fSerializer.WriteDecimal(aName, Ref, ArrayElementId);
end;

procedure TROMessage.WriteEnumerated(const aName: string;
  anEnumTypeInfo: PTypeInfo; const Ref; ArrayElementId: integer);
begin
  fSerializer.WriteEnumerated(aName, anEnumTypeInfo, Ref, ArrayElementId);
end;

procedure TROMessage.WriteDouble(const aName: string;
  aFloatType: TFloatType; const Ref; ArrayElementId: integer);
begin
  fSerializer.WriteDouble(aName, aFloatType, Ref, ArrayElementId);
end;

procedure TROMessage.WriteGuid(const aName: string; const Ref;
  ArrayElementId: integer);
begin
  fSerializer.WriteGuid(aName, Ref, ArrayElementId);
end;

procedure TROMessage.WriteInt64(const aName: string; const Ref;
  ArrayElementId: integer);
begin
  fSerializer.WriteInt64(aName, Ref, ArrayElementId);
end;

procedure TROMessage.WriteInteger(const aName: string; anOrdType: TOrdType;
  const Ref; ArrayElementId: integer);
begin
  fSerializer.WriteInteger(aName, anOrdType, Ref, ArrayElementId);
end;

procedure TROMessage.WriteUTF8String(const aName: string; const Ref;
  ArrayElementId: integer);
begin
  fSerializer.WriteUTF8String(aName, Ref, ArrayElementId);
end;

procedure TROMessage.WriteVariant(const aName: string; const Ref;
  ArrayElementId: integer);
begin
  fSerializer.WriteVariant(aName, Ref, ArrayElementId);
end;

procedure TROMessage.WriteWideString(const aName: string; const Ref;
  ArrayElementId: integer);
begin
  fSerializer.WriteWideString(aName, Ref, ArrayElementId);
end;

procedure TROMessage.WriteXml(const aName: string; const Ref;
  ArrayElementId: integer);
begin
  fSerializer.WriteXml(aName, Ref, ArrayElementId);
end;

function TROMessage.ReadArray(const aName: string; aClass : TClass; var Ref;
  ArrayElementId: integer): Boolean;
begin
  Result:= fSerializer.ReadArray(aName, aClass, Ref, ArrayElementId);
end;

function TROMessage.ReadStruct(const aName: string; aClass : TClass; var Ref;
  ArrayElementId: integer): Boolean;
begin
  Result:= fSerializer.ReadStruct(aName, aClass, Ref, ArrayElementId);
end;

procedure TROMessage.WriteArray(const aName: string; const Ref;
  ArrayElementId: integer);
begin
  fSerializer.WriteArray(aName, Ref, ArrayElementId);
end;

procedure TROMessage.WriteStruct(const aName: string; const Ref;
  ArrayElementId: integer);
begin
  fSerializer.WriteStruct(aName, Ref, ArrayElementId);
end;

procedure TROMessage.ReadBinary(const aName: string; var Ref;
  ArrayElementId: integer);
begin
  fSerializer.ReadBinary(aName, Ref, ArrayElementId);
end;

procedure TROMessage.WriteBinary(const aName: string; const Ref;
  ArrayElementId: integer);
begin
  fSerializer.WriteBinary(aName, Ref, ArrayElementId);
end;

{ TROChannelAwareComponent }

procedure TROChannelAwareComponent.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;

  if (Operation<>opRemove) then Exit;

  if (AComponent=fChannel) then fChannel := NIL;
end;

procedure TROChannelAwareComponent.SetChannel(const Value: TROTransportChannel);
begin
  if (fChannel=Value) then Exit;

  fChannel := Value;
  if (fChannel<>NIL) then fChannel.FreeNotification(Self);  
end;

{ TROCustomRODLReader }

procedure TROCustomRODLReader.ReadRODLResource(aStream: TStream);
begin
  if Assigned(fOnBeforeReadRODL) then fOnBeforeReadRODL(Self, aStream);
  DoReadRODLResource(aStream);
  if Assigned(fOnAfterReadRODL) then fOnAfterReadRODL(Self, aStream);
end;

constructor TROBaseConnection.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  {$IFDEF RemObjects_UseEncryption}
  fEncryption := TROEncryption.Create();//(nil);
  {$ENDIF}
end;

{$IFDEF RemObjects_UseEncryption}
procedure TROBaseConnection.DoEncryption(iPlainText, iCipherText: TStream); { public }
begin
  iPlainText.Seek(0,soFromBeginning);
  if Assigned(Encryption) then
    Encryption.Encrypt(iPlainText, iCipherText)
  else
    if iPlainText.Size > 0 then
      iCipherText.CopyFrom(iPlainText, iPlainText.Size);
  iCipherText.Seek(0,soFromBeginning);      
end;

procedure TROBaseConnection.DoDecryption(iCipherText, iPlainText: TStream); { public }
begin
  {ToDo: we should find a solution where if no encryption is used, we don't need to copy the stream AT ALL. }
  iCipherText.Seek(0,soFromBeginning);
  if Assigned(Encryption) then
    Encryption.Decrypt(iCipherText, iPlainText)
  else
    if iCipherText.Size > 0 then
      iPlainText.CopyFrom(iCipherText, iCipherText.Size);
end;

procedure TROBaseConnection.SetEncryption(NewValue: TROEncryption);
begin
  fEncryption.Assign(NewValue);
end;
{$ENDIF}

destructor TROBaseConnection.Destroy;
begin
  inherited Destroy;

  {$IFDEF RemObjects_UseEncryption}
  FreeAndNil(fEncryption);
  {$ENDIF}
end;

{ TROTransportChannel }
procedure TROTransportChannel.Assign(aSource: TPersistent);
var lSource:TROTransportChannel;
begin
  if Assigned(aSource) then begin
    if not (aSource is Self.ClassType) then RaiseError('Cannot Assign a %s t a %s',[ClassName,aSource.ClassName]);
    lSource := TROTransportChannel(aSource);
    self.OnProgress := lSource.OnProgress;
    self.OnReceiveStream := lSource.OnReceiveStream;
    self.OnSendStream := lSource.OnSendStream;
    self.OnFailure := lSource.OnFailure;

    self.ServerLocators.Assign(lSource.ServerLocators);
    self.DispatchOptions := lSource.DispatchOptions;
{$IFDEF RemObjects_UseEncryption}
    self.Encryption.Assign(lSource.Encryption);
{$ENDIF}
  end 
  else
    inherited;
end;

constructor TROTransportChannel.Create(aOwner: TComponent);
begin
  inherited;
  fSynchronizedProbing := true;
  fProbeFrequency := 60000; // Every minute
  fLoadBalancerLocatorIdx := -1;
  fFaultToleranceLocatorIdx := -1;
  fServerLocators := TROServerLocatorCollection.Create(Self);
end;

destructor TROTransportChannel.Destroy;
begin
  FreeAndNIL(fServerLocators);

  inherited;
end;

procedure TROTransportChannel.Dispatch(aRequest, aResponse : TStream);
var retry : boolean;
    {$ifdef REMOBJECTS_UseEncryption}
    EncRequest,EncResponse : TMemoryStream;
    {$endif}
    faultstartlocatoridx : integer;
    templocator : TROServerLocator;
begin
  retry := TRUE;
  if not fThreadsafe then
  begin
    if Busy then raise EROChannelBusy.Create(err_ChannelBusy);

    fBusy := TRUE;
  end;
//removed because of a warning faultstartlocatoridx :=  -1;

  templocator := NIL;
  faultstartlocatoridx := fFaultToleranceLocatorIdx;

  // Performs load balacing by changing the target host
  if (doLoadBalanced in fDispatchOptions) then begin
    if fServerLocators.GetNextLocator(templocator, fLoadBalancerLocatorIdx, fLoadBalancerLocatorIdx, TRUE) then begin
      SetServerLocator(templocator, NIL);
      fCurrentLocator := templocator;

      faultstartlocatoridx := fLoadBalancerLocatorIdx;
      fFaultToleranceLocatorIdx := faultstartlocatoridx;
    end;
  end;

  try
    if Assigned(fOnSendStream)
      then fOnSendStream(aRequest);

    repeat
      try
        aRequest.Position := 0;

        {$IFDEF REMOBJECTS_UseEncryption}
        if Encryption.EncryptionMethod <> tetNone then begin
          EncRequest:= TMemoryStream.Create;
          EncResponse := TMemoryStream.Create;
          try
            DoEncryption(aRequest,EncRequest);
            IntDispatch(encRequest, encResponse);
            DoDecryption(EncResponse,aResponse);
          finally
            EncRequest.Free;
            EncResponse.free;
          end;
        end
        else
        {$ENDIF}
        begin
          IntDispatch(aRequest, aResponse);
        end;

        aResponse.Position := 0;
        if Assigned(fOnReceiveStream) then begin
          fOnReceiveStream(aResponse);
          aResponse.Position := 0;
        end;

        Exit;
      except
        on E:Exception do begin
          retry := FALSE;

          if (doFaultTolerant in fDispatchOptions) then begin
            // This can improve speed during the next requests
            if (fCurrentLocator<>NIL) and fCurrentLocator.DisableOnFailure
              then fCurrentLocator.Enabled := FALSE;

            // Fail-over support: checks using all server locators
            if fServerLocators.GetNextLocator(templocator, fFaultToleranceLocatorIdx, faultstartlocatoridx, FALSE) then begin
              retry := TRUE;
              
              SetServerLocator(templocator{fCurrentLocator}, E);
              fCurrentLocator := templocator;
            end
          end;

          //if not retry then begin
            //if Assigned(fOnException) then fOnException(Self, E, retry);
            if not retry then raise
          //end;
        end;
      end;
    until not retry;
  finally
    if not fThreadSafe then
      fBusy := FALSE;
  end;
end;

procedure TROTransportChannel.Loaded;
begin
  inherited;
  ProbeServers := fLoadedProbeServers;
end;

procedure TROTransportChannel.ProbeAll;
var i : integer;
    probedcount,
    disabledcount,
    enabledcount : integer;
    locator : TROServerLocator;
    proberes : boolean;
begin
  probedcount := 0;
  enabledcount := 0;
  disabledcount := 0;
//removed because of a warning   proberes := FALSE;

  if (fServerLocators.Count=0) then Exit;

  if Assigned(fOnBeforeProbingServers) then fOnBeforeProbingServers(Self);

  for i := 0 to (fServerLocators.Count-1) do begin
    locator := fServerLocators[i];

    if (locator.ProbingOptions=[]) then Continue; // Not subject to probing

    Inc(probedcount);

    // Probe
    if locator.Enabled and (poProbeWhenEnabled in locator.ProbingOptions) then begin
      proberes := Probe(locator);
      if not proberes then Inc(disabledcount);
    end

    else if not locator.Enabled and (poProbeWhenDisabled in locator.ProbingOptions) then begin
      proberes := Probe(locator);
      if proberes then Inc(enabledcount);
    end;
  end;

  if Assigned(fOnAfterProbingServers) then fOnAfterProbingServers(Self, probedcount, enabledcount, disabledcount);
end;

function TROTransportChannel.Probe(aServerLocator : TROServerLocator): boolean;
var req, resp : TStringStream;
begin
  result := FALSE;
  
  if (fProbingClone=NIL) then begin
    // Creates a transport of the same type that will be used during probing operations
    fProbingClone := TROTransportChannelClass(ClassType).Create(Self);
    {$ifdef REMOBJECTS_UseEncryption}
      fProbingClone.Encryption.Assign(Encryption);
    {$endif}
    //Probably there is needed Clone infrastructure for channels, the same as for messages.
    //Because assigning only encryption is not enough here. Proxy setting is required too - but it is channel dependent.
    //When it will be ready - change code here.

  end;
  fProbingClone.SetServerLocator(aServerLocator);

  req := TStringStream.Create(ProbeRequestID);
  resp := TStringStream.Create('');

  try
    // Before probing server
    if Assigned(fOnBeforeProbingServer) then fOnBeforeProbingServer(Self, aServerLocator);

    try
      fProbingClone.BeforeDispatch(nil);
      fProbingClone.Dispatch(req, resp);
      result := (resp.DataString=ProbeResponseID);

      if result and (poEnableIfProbeSucceeded in aServerLocator.ProbingOptions)
        then aServerLocator.Enabled := TRUE

      else if not result then SysUtils.Abort;

    except
      if (poDisableIfProbeFailed in aServerLocator.ProbingOptions)
        then aServerLocator.Enabled := FALSE;

      // We can ignore exceptions. This actually means the method failed.
    end;
  finally
    req.Free;
    resp.Free;

    // After probing server
    if Assigned(fOnAfterProbingServer) then fOnAfterProbingServer(Self, aServerLocator, not result);
  end;
end;

procedure TROTransportChannel.RetrieveMetadata(out Metadata: TStream);
var req : TStringStream;
begin
  BeforeDispatch(nil);
  req := TStringStream.Create(MetadataRequestID);
  Metadata := TStringStream.Create('');

  try
    try
      Dispatch(req, Metadata);
    except
      FreeAndNIL(Metadata);
      raise;
    end;
  finally
    req.Free;
  end;
end;

procedure TROTransportChannel.RetrieveRODL(out RODLLibrary : TRODLLibrary);
var
  resp : TStream;
  XmlToRodl: TXMLToRODL;
begin
  RODLLibrary := NIL;

  RetrieveMetadata(resp);

  XmltoRodl := TXMLToRODL.Create(nil);
  try
    RODLLibrary := XmltoRodl.Read(resp,'');
  except
  end;
  resp.Free;
  XmlToRodl.Free;
end;

procedure TROTransportChannel.SetProbeFrequency(
  const Value: cardinal);
begin
  fProbeFrequency := Value;
  if Assigned(fProbeTimer)
    then fProbeTimer.Timeout := Value;
end;

procedure TROTransportChannel.OnProbeTimerTick(Dummy: Cardinal);
begin
  ProbeAll;
end;

procedure TROTransportChannel.SetProbeServers(const Value: boolean);
begin
  if (csLoading in ComponentState) then fLoadedProbeServers := Value
  else if (fProbeServers<>Value) then begin
    fProbeServers := Value;

    if (csDesigning in ComponentState) then Exit;
      
    if fProbeServers then begin
      fProbeTimer := TROThreadTimer.Create(OnProbeTimerTick, fProbeFrequency, fSynchronizedProbing);
    end
    else begin
      fProbeTimer.Free;
      fProbeTimer := nil;
    end;
  end;
end;

procedure TROTransportChannel.SetServerLocator(
  aServerLocator: TROServerLocator; anException : Exception = NIL);
begin
  if Assigned(fOnServerLocatorAssignment)
    then fOnServerLocatorAssignment(Self, aServerLocator, anException);

  IntSetServerLocator(aServerLocator);
end;

procedure TROTransportChannel.SetServerLocators(
  const Value: TROServerLocatorCollection);
begin
  fServerLocators.Assign(Value);
end;

procedure TROTransportChannel.TriggerProgress(iType:TProgressType; iDirection: TProgressDirection; iTransfered, iTotal: integer);
begin
  if Assigned(OnProgress) then OnProgress(self, iType, iDirection, iTransfered, iTotal);
end;

procedure TROTransportChannel.SetSynchronizedProbing(const Value: Boolean);
begin
  fSynchronizedProbing := Value;
  if fProbeTimer <> nil then
    fProbeTimer.Synchronized := fSynchronizedProbing;
end;

procedure TROTransportChannel.Dispatch(aMessage: IROMessage);
var
  lRequest, lResponse: TMemoryStream;
  aFreeStream: Boolean;
  lRetry: boolean;
begin
  try
    BeforeDispatch(aMessage);
  except
    on E: Exception do begin
      lRetry:=False;
      if assigned(OnException) then OnException(self, e, lRetry);
      if not lRetry then raise;
    end;
  end;
//  if aMessage.ClientID = EmptyGUID then
//    aMessage.ClientID := NewGuid;

  lRequest := TMemoryStream.Create;
  try

    aMessage.WriteToStream(lRequest);
    repeat
      lRetry := false;

      try
        aFreeStream := true;
        lResponse := TMemoryStream.Create;
        try
          Dispatch(lRequest, lResponse);

          aMessage.InitializeRead(Self);
          try
            aMessage.ReadFromStream(lResponse, aFreeStream);
          except
            aFreeStream:= True;
            raise;
          end;
        finally
          if aFreeStream then FreeAndNil(lResponse);
        end;
      except
        on E: EROSessionNotFound do
        begin
          if assigned(fOnLoginNeeded) then
            OnLoginNeeded(self, e, lRetry);
          if not lRetry then
            raise;
        end;
        on E: Exception do
        begin
          if assigned(OnException) then
            OnException(self, e, lRetry);
          if not lRetry then
            raise;
        end;
      end;
    until not lRetry;
  finally
    lRequest.Free;
  end;
end;

procedure TROTransportChannel.SetCurrentLocator(const Value: TROServerLocator);
begin
  if (fCurrentLocator <> Value) and (ServerLocators.IndexOf(Value) > -1) then
    fCurrentLocator := Value;
end;

procedure TROTransportChannel.BeforeDispatch(aMessage: IROMessage);
begin
 //
end;

procedure TROTransportChannel.CheckProperties;
begin
// nothing
end;

{ TROObjectDisposer }

procedure TROObjectDisposer.Add(iObject: TObject);
begin
  if IndexOf(iObject) = -1 then inherited Add(iObject);
end;

constructor TROObjectDisposer.Create(const aService: IInterface);
begin
  inherited Create;

  fService := aService;
end;

destructor TROObjectDisposer.Destroy;
var i: integer;
    objretainer : IROObjectRetainer;
begin
  if Supports(fService, IROObjectRetainer, objretainer) then begin
    // Only destroyes the var and out params the service is not retaining
    for i := (Count-1) downto 0 do
      if not objretainer.IsRetained(Items[i])
        then TObject(Items[i]).Free();
  end

  else begin
    for i := 0 to (Count-1) do
      TObject(Items[i]).Free();
  end;

  fService := NIL;

  inherited;
end;

initialization
  _MessageClasses := TClassList.Create;
  _ExceptionClasses := TClassList.Create;

  _ProxyClasses := TStringList.Create;
  _ProxyClasses.Duplicates := dupError;
  _ProxyClasses.Sorted := TRUE;

  _TransportChannels := TStringList.Create;
  _TransportChannels.Duplicates := dupError;
  _TransportChannels.Sorted := TRUE;

  RegisterExceptionClass(EROUnknownType);
  RegisterExceptionClass(EROMessageTooLarge);
  RegisterExceptionClass(EROSessionNotFound);
  RegisterExceptionClass(EROSessionExpired);
  RegisterExceptionClass(SessionNotFoundException);

finalization
  UnregisterExceptionClass(EROUnknownType);
  UnregisterExceptionClass(EROMessageTooLarge);
  UnregisterExceptionClass(SessionNotFoundException);
  UnregisterExceptionClass(EROSessionExpired);
  UnregisterExceptionClass(EROSessionNotFound);

  _MessageClasses.Free;
  _ExceptionClasses.Free;

  FreeAndNil(_ProxyClasses);
  FreeAndNil(_TransportChannels);

end.