david
d99a44999f
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@7 b6239004-a887-0f4b-9937-50029ccdca16
523 lines
18 KiB
ObjectPascal
523 lines
18 KiB
ObjectPascal
unit uROClientIntf;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ 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}
|
|
Classes, SysUtils, TypInfo, uRODL, uRORes, uROTypes;
|
|
|
|
const
|
|
MESSAGE_TYPE_MESSAGE = 0;
|
|
MESSAGE_TYPE_EXCEPTION = 1;
|
|
MESSAGE_TYPE_EVENT = 2;
|
|
|
|
MAX_ITEM_NAME = $100; { max name length for interface, function etc. }
|
|
MAX_EXCEPTION_TEXT = $10000; { max exception text }
|
|
|
|
type
|
|
{ Misc }
|
|
TROURIType = (utHTTP, utTCP, utUDP, utPipes, utSMTP, utPOP3);
|
|
TROProbingOption = (poProbeWhenEnabled, poProbeWhenDisabled, poEnableIfProbeSucceeded, poDisableIfProbeFailed);
|
|
TROProbingOptions = set of TROProbingOption;
|
|
|
|
const
|
|
URITypeIdentifiers : array[TROURIType] of string =
|
|
('HTTP', 'TCP', 'UDP', 'PIPE', 'SMTP', 'POP3');
|
|
|
|
type
|
|
TMessageType = (mtRequest,
|
|
mtResponse,
|
|
mtException,
|
|
mtQueryServiceInfo,
|
|
mtEvent,
|
|
mtPoll);
|
|
|
|
{ for Delphi 5 know we can reply on the correct value-assignment 0,1,2 }
|
|
|
|
{ Forward declarations }
|
|
IROMessage = interface;
|
|
TROServerLocator = class;
|
|
|
|
{ Misc }
|
|
|
|
DateTime = TDateTime; { Alias for the type TDateTime }
|
|
|
|
{ IROMessage }
|
|
TParamAttribute = (paIsDateTime, paIsArrayElement);
|
|
TParamAttributes = set of TParamAttribute; { Set of TParamAttribute }
|
|
|
|
IROTransport = interface;
|
|
|
|
{ IROMessage }
|
|
IROMessage = interface
|
|
['{092FB8BE-5FC4-48CB-BB50-623465168B98}']
|
|
procedure Initialize(const aTransport : IROTransport; const anInterfaceName, aMessageName : string; aType: TMessageType); overload;
|
|
procedure Initialize(const aTransport : IROTransport; const aLibraryName, anInterfaceName, aMessageName : string; aType: TMessageType); overload;
|
|
|
|
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);
|
|
|
|
procedure Finalize;
|
|
|
|
function GetClientID : TGUID;
|
|
procedure SetClientID(const Value : TGUID);
|
|
|
|
{$IFDEF DOTNET}
|
|
{$ELSE}
|
|
procedure Write(const aName : string; aTypeInfo : PTypeInfo; const Ptr; ExtraAttributes : TParamAttributes);
|
|
{$ENDIF}
|
|
{$IFDEF DOTNET}
|
|
{$ELSE}
|
|
procedure Read(const aName : string; aTypeInfo : PTypeInfo; var Ptr; ExtraAttributes : TParamAttributes);
|
|
{$ENDIF}
|
|
|
|
function GetInterfaceName : string;
|
|
function GetMessageName : string;
|
|
procedure SetInterfaceName(const aValue : string);
|
|
procedure SetMessageName(const aValue : string);
|
|
procedure WriteToStream(aStream : TStream);
|
|
procedure ReadFromStream(aStream : TStream); overload;
|
|
procedure ReadFromStream(aStream : TStream; var aFreeStream: Boolean); overload;
|
|
procedure WriteException(aStream : TStream; anException : Exception);
|
|
function GetMessageType: TMessageType;
|
|
|
|
procedure FreeStream;
|
|
|
|
procedure SetAttributes(aTransport: IROTransport; const aNames: array of string; const aValues: array of string);
|
|
procedure UnsetAttributes(aTransport: IROTransport);
|
|
|
|
procedure InitializeRead(const aTransport : IROTransport);
|
|
|
|
property MessageName : string read GetMessageName write SetMessageName;
|
|
property InterfaceName : string read GetInterfaceName write SetInterfaceName;
|
|
property ClientID : TGUID read GetClientID write SetClientID;
|
|
property MessageType : TMessageType read GetMessageType;
|
|
//
|
|
{ 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);
|
|
end;
|
|
|
|
IROMessageCloneable = interface
|
|
['{4AA33660-25B7-4794-A978-CB791640475D}']
|
|
function Clone:IROMessage;
|
|
end;
|
|
|
|
IROStreamAccess = interface
|
|
['{DF3D000F-7EB3-4981-AA01-921553CAFF52}']
|
|
function GetStream : TStream;
|
|
|
|
property Stream : TStream read GetStream;
|
|
end;
|
|
|
|
{ IROTransport }
|
|
IROTransport = interface
|
|
['{56FA09B9-FFC8-4432-80E3-BF78E5E7DF33}']
|
|
function GetTransportObject : TObject;
|
|
end;
|
|
|
|
{ IROTransportChannel }
|
|
IROTransportChannel = interface(IROTransport)
|
|
['{EDFA0CF3-3265-46C9-AC5C-14C3CACF2721}']
|
|
procedure SetServerLocator(aServerLocator : TROServerLocator; anException : Exception = NIL);
|
|
function Probe(aServerLocator : TROServerLocator) : boolean;
|
|
procedure ProbeAll;
|
|
|
|
procedure Dispatch(aRequest, aResponse : TStream); overload;
|
|
procedure Dispatch(aMessage: IROMessage); overload;
|
|
procedure BeforeDispatch(aMessage: IROMessage);
|
|
end;
|
|
|
|
{ IROMetadataReader }
|
|
IROMetadataReader = interface
|
|
['{526269B5-FAB2-45A2-A2E6-8CBFF317BC98}']
|
|
procedure RetrieveMetadata(out Metadata : TStream);
|
|
procedure RetrieveRODL(out RODLLibrary : TRODLLibrary);
|
|
end;
|
|
|
|
{ IROTCPTransport }
|
|
IROTCPTransport = interface(IROTransport)
|
|
['{C80E773D-B8A8-4E0D-9B49-2668EFC1E27F}']
|
|
function GetClientAddress : string;
|
|
|
|
property ClientAddress : string read GetClientAddress;
|
|
end;
|
|
|
|
{ IROHTTPTransport }
|
|
IROHTTPTransport = interface(IROTCPTransport)
|
|
['{AD51DB69-993F-49C1-9F3B-4C678A95007D}']
|
|
procedure SetHeaders(const aName, aValue : string);
|
|
function GetHeaders(const aName : string) : string;
|
|
|
|
function GetContentType : string;
|
|
procedure SetContentType(const aValue : string);
|
|
|
|
function GetUserAgent : string;
|
|
procedure SetUserAgent(const aValue : string);
|
|
|
|
function GetTargetURL : string;
|
|
procedure SetTargetURL(const aValue : string);
|
|
|
|
procedure SetPathInfo (const aValue : string);
|
|
function GetPathInfo : string;
|
|
function GetQueryString : string;
|
|
function GetLocation : string;
|
|
|
|
property ContentType : string read GetContentType write SetContentType;
|
|
property UserAgent : string read GetUserAgent write SetUserAgent;
|
|
property TargetURL : string read GetTargetURL write SetTargetURL;
|
|
property Headers[const aName : string] : string read GetHeaders write SetHeaders;
|
|
|
|
property PathInfo : string read GetPathInfo write SetPathInfo;
|
|
property QueryString : string read GetQueryString;
|
|
|
|
property Location : string read GetLocation;
|
|
end;
|
|
|
|
{ IROEventWriter }
|
|
IROEventWriter = interface
|
|
['{501A01A8-0663-488A-BB29-3C0FBA7F43B5}']
|
|
function GetSessionList: TStrings;
|
|
function GetExcludeSender: boolean;
|
|
function GetExcludeSessionList: boolean;
|
|
procedure SetExcludeSender(const Value: boolean);
|
|
procedure SetExcludeSessionList(const Value: boolean);
|
|
|
|
property ExcludeSender : boolean read GetExcludeSender write SetExcludeSender;
|
|
property ExcludeSessionList : boolean read GetExcludeSessionList write SetExcludeSessionList;
|
|
property SessionList : TStrings read GetSessionList;
|
|
end;
|
|
|
|
IROEventsWriter = IROEventWriter {$IFDEF DELPHI10UP}deprecated{$ENDIF};
|
|
|
|
{ IROModuleInfo }
|
|
TDataFormat = string;
|
|
IROModuleInfo = interface
|
|
['{83ED3A44-DA4B-4F4E-884A-DDF5E726A2C1}']
|
|
procedure GetModuleInfo(aStream : TStream; const aTransport : IROTransport; var aFormat : TDataFormat);
|
|
procedure GetRodlInfo(aStream : TStream; const aTransport : IROTransport; var aFormat : TDataFormat);
|
|
end;
|
|
|
|
IRONamedModuleInfo = interface(IROModuleInfo)
|
|
['{C7D24186-D600-465C-9B09-4E1E2CF835BE}']
|
|
function ModuleInfoName: string;
|
|
end;
|
|
|
|
{ TROServerLocator }
|
|
TROServerLocatorNotifyEvent = procedure(Sender : TROServerLocator) of object;
|
|
TROServerLocator = class(TCollectionItem)
|
|
private
|
|
fEnabled: boolean;
|
|
fPort: integer;
|
|
fHost: string;
|
|
fDisableOnFailure: boolean;
|
|
fLoadBalancingServer: boolean;
|
|
fProbingOptions: TROProbingOptions;
|
|
fOnEnabledChanged: TROServerLocatorNotifyEvent;
|
|
fName: string;
|
|
|
|
procedure SetHost(const Value: string);
|
|
procedure SetPort(const Value: integer);
|
|
function GetEnabled: boolean;
|
|
procedure SetEnabled(const Value: boolean);
|
|
|
|
protected
|
|
function GetDisplayName: string; override;
|
|
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
destructor Destroy; override;
|
|
|
|
function GetNamePath: string; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
|
|
published
|
|
property Name : string read fName write fName;
|
|
property Enabled : boolean read GetEnabled write SetEnabled;
|
|
property Host : string read fHost write SetHost;
|
|
property Port : integer read fPort write SetPort;
|
|
property DisableOnFailure : boolean read fDisableOnFailure write fDisableOnFailure;
|
|
property LoadBalancingServer : boolean read fLoadBalancingServer write fLoadBalancingServer;
|
|
property ProbingOptions : TROProbingOptions read fProbingOptions write fProbingOptions;
|
|
|
|
property OnEnabledChanged : TROServerLocatorNotifyEvent read fOnEnabledChanged write fOnEnabledChanged;
|
|
end;
|
|
|
|
{ IROMultiThreadAwareChannel }
|
|
IROMultiThreadAwareChannel = interface
|
|
['{0C2FD6DE-DEC1-4B1D-851C-F55C36869920}']
|
|
end;
|
|
|
|
{ TROServerLocatorCollection }
|
|
TROServerLocatorCollection = class(TCollection)
|
|
private
|
|
fOwner : TComponent;
|
|
|
|
protected
|
|
function GetItems(aIndex: integer): TROServerLocator;
|
|
procedure SetItems(aIndex: integer; aNewItem: TROServerLocator);
|
|
function GetOwner: TPersistent; override;
|
|
public
|
|
constructor Create(aOwner : TComponent);
|
|
destructor Destroy; override;
|
|
|
|
function Add: TROServerLocator;
|
|
function Insert(aIndex: integer): TROServerLocator;
|
|
function IndexOf(aItem: TROServerLocator): integer;
|
|
|
|
function GetNextLocator(out aLocator : TROServerLocator;
|
|
var CurrentIndex : integer;
|
|
InitialIndex : integer;
|
|
ForLoadBalancing : boolean) : boolean;
|
|
|
|
procedure EnableAll;
|
|
procedure DisableAll;
|
|
|
|
property Items[Index: integer]: TROServerLocator read GetItems write SetItems; default;
|
|
end;
|
|
|
|
IROEventReceiver = interface
|
|
['{A3320CBC-2E62-41C8-9C3D-FB7ADCBF6920}']
|
|
procedure Dispatch(aStream: TStream; aCaller: TThread);
|
|
function GetObject: TObject;
|
|
end;
|
|
|
|
IROActiveEventChannel = interface
|
|
['{BFDD73B9-3C6A-4E78-AFFA-7B9A182A5CC4}']
|
|
procedure RegisterEventReceiver(aReceiver: IROEventReceiver);
|
|
procedure UnregisterEventReceiver(aReceiver: IROEventReceiver);
|
|
end;
|
|
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
uROClasses;
|
|
|
|
{ TROServerLocator }
|
|
constructor TROServerLocator.Create(Collection: TCollection);
|
|
begin
|
|
inherited;
|
|
|
|
fProbingOptions := [poProbeWhenEnabled, poProbeWhenDisabled, poEnableIfProbeSucceeded, poDisableIfProbeFailed];
|
|
fLoadBalancingServer := TRUE;
|
|
fEnabled := TRUE;
|
|
fDisableOnFailure := TRUE;
|
|
end;
|
|
|
|
destructor TROServerLocator.Destroy;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
function TROServerLocator.GetDisplayName: string;
|
|
var options : string;
|
|
begin
|
|
if (Trim(fHost)='')
|
|
then result := '!!Empty!!'
|
|
else result := fHost;
|
|
|
|
if (fPort>0) then result := result+':'+IntToStr(fPort);
|
|
|
|
if not Enabled then result := '(Disabled) '+result;
|
|
|
|
if LoadBalancingServer then options := 'LBS' else options := 'non-LBS';
|
|
if DisableOnFailure then options := options+', Disable On Failure' else options := options+',';
|
|
options := options+', '+GetPropValue(Self, 'ProbingOptions');
|
|
|
|
result := result+' '+options;
|
|
end;
|
|
|
|
function TROServerLocator.GetEnabled: boolean;
|
|
begin
|
|
result := fEnabled and (Length(fHost)>0);
|
|
end;
|
|
|
|
procedure TROServerLocator.SetEnabled(const Value: boolean);
|
|
begin
|
|
if (fEnabled=Value) then Exit;
|
|
|
|
fEnabled := Value;
|
|
if Assigned(fOnEnabledChanged) then fOnEnabledChanged(Self);
|
|
end;
|
|
|
|
procedure TROServerLocator.SetHost(const Value: string);
|
|
begin
|
|
fHost := Trim(Value);
|
|
end;
|
|
|
|
procedure TROServerLocator.SetPort(const Value: integer);
|
|
begin
|
|
if (fPort<>Value) and (Value>=0)
|
|
then fPort := Value;
|
|
end;
|
|
|
|
function TROServerLocator.GetNamePath: string;
|
|
begin
|
|
if (Collection <> nil) and (Collection.Owner <> nil) then
|
|
result := TComponent(Collection.Owner).Name + '.' + FName
|
|
else
|
|
result := inherited GetNamePath
|
|
end;
|
|
|
|
procedure TROServerLocator.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TROServerLocator then begin
|
|
Name := TROServerLocator(Source).Name;
|
|
Enabled := TROServerLocator(Source).Enabled;
|
|
Host := TROServerLocator(Source).Host;
|
|
Port := TROServerLocator(Source).Port;
|
|
DisableOnFailure := TROServerLocator(Source).DisableOnFailure;
|
|
LoadBalancingServer := TROServerLocator(Source).LoadBalancingServer;
|
|
ProbingOptions := TROServerLocator(Source).ProbingOptions;
|
|
OnEnabledChanged := TROServerLocator(Source).OnEnabledChanged;
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
{ TROServerLocatorCollection }
|
|
constructor TROServerLocatorCollection.Create(aOwner : TComponent);
|
|
begin
|
|
inherited Create(TROServerLocator);
|
|
|
|
fOwner := aOwner;
|
|
end;
|
|
|
|
destructor TROServerLocatorCollection.Destroy;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
function TROServerLocatorCollection.Add: TROServerLocator;
|
|
begin
|
|
result := TROServerLocator(inherited Add);
|
|
end;
|
|
|
|
function TROServerLocatorCollection.Insert(aIndex: integer): TROServerLocator;
|
|
begin
|
|
result := TROServerLocator(inherited Insert(aIndex));
|
|
end;
|
|
|
|
function TROServerLocatorCollection.GetItems(aIndex: integer): TROServerLocator;
|
|
begin
|
|
result := TROServerLocator(inherited Items[aIndex]);
|
|
end;
|
|
|
|
function TROServerLocatorCollection.IndexOf(aItem: TROServerLocator): integer;
|
|
var i: integer;
|
|
begin
|
|
result := - 1;
|
|
for i := 0 to (Count - 1) do
|
|
if (aItem = Items[i]) then begin
|
|
result := i;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TROServerLocatorCollection.SetItems(aIndex: integer; aNewItem: TROServerLocator);
|
|
begin
|
|
inherited Items[aIndex].Assign(aNewItem);
|
|
end;
|
|
|
|
|
|
function TROServerLocatorCollection.GetNextLocator(out aLocator : TROServerLocator;
|
|
var CurrentIndex : integer; InitialIndex : integer; ForLoadBalancing : boolean) : boolean;
|
|
var idx : integer;
|
|
begin
|
|
aLocator := NIL;
|
|
result := FALSE;
|
|
if Count=0 then Exit;
|
|
|
|
idx := CurrentIndex;
|
|
repeat
|
|
try
|
|
idx := IncID(idx, Count-1);
|
|
|
|
if (idx=InitialIndex)
|
|
then Exit // We ended up to the first one.
|
|
|
|
else if Items[idx].Enabled then begin
|
|
if ForLoadBalancing and not Items[idx].LoadBalancingServer
|
|
then Continue;
|
|
|
|
result := TRUE;
|
|
aLocator := Items[idx];
|
|
CurrentIndex := idx;
|
|
Exit;
|
|
end;
|
|
finally
|
|
if InitialIndex = -1 then
|
|
InitialIndex := 0;
|
|
end;
|
|
until FALSE;
|
|
end;
|
|
|
|
procedure TROServerLocatorCollection.DisableAll;
|
|
var i: Integer;
|
|
begin
|
|
for i := 0 to (Count - 1) do begin
|
|
Items[i].Enabled := FALSE;
|
|
end;
|
|
end;
|
|
|
|
procedure TROServerLocatorCollection.EnableAll;
|
|
var i: Integer;
|
|
begin
|
|
for i := 0 to (Count - 1) do begin
|
|
Items[i].Enabled := TRUE;
|
|
end;
|
|
end;
|
|
|
|
function TROServerLocatorCollection.GetOwner: TPersistent;
|
|
begin
|
|
result := fOwner;
|
|
end;
|
|
|
|
end.
|