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
1773 lines
58 KiB
ObjectPascal
1773 lines
58 KiB
ObjectPascal
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.
|