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
1425 lines
43 KiB
ObjectPascal
1425 lines
43 KiB
ObjectPascal
unit uRODynamicRequest;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 5 and up, Kylix 2 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the RemObjects SDK }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
{$I RemObjects.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, uROClient, uROTypes, uRORemoteService, uRODL, uROClasses;
|
|
|
|
const
|
|
RODLParamFlagStr : array[TRODLParamFlag] of string = ('In', 'Out', 'InOut', 'Result');
|
|
|
|
err_UnknownComplexType = 'Complex type %s was not found. The type is not registered or the package containing it is not loaded.';
|
|
|
|
type
|
|
{ Misc }
|
|
TRODynamicRequest = class;
|
|
TRORequestParamCollection = class;
|
|
TRORequestParam = class;
|
|
|
|
TRODynamicRequestNotifyEvent = procedure(Sender : TRODynamicRequest) of object;
|
|
TRODynamicRequestErrorEvent = procedure(Sender : TRODynamicRequest; Error : Exception; var Ignore : boolean) of object;
|
|
TROStringPropertyChangeEvent = procedure(Sender : TRODynamicRequest; const OldValue, NewValue : string) of object;
|
|
TROFindCustomTypeImplementationEvent = procedure(Sender: TRODynamicRequest; const aTypeName:string; aParameter: TRORequestParam; out aImplementor: TROComplexType) of object;
|
|
|
|
{ TRORequestParam }
|
|
TRORequestParam = class(TCollectionItem)
|
|
private
|
|
fName: string;
|
|
fDataType: TRODataType;
|
|
fFlag: TRODLParamFlag;
|
|
fTypeName: string;
|
|
|
|
fOwnsBinary, fOwnsComplexType: boolean;
|
|
fBinaryValue: Binary;
|
|
fComplexTypeValue: TROComplexType;
|
|
fSimpleValue: Variant;
|
|
procedure SetFlag(const Value: TRODLParamFlag);
|
|
procedure SetName(const Value: string);
|
|
|
|
procedure SetDataType(const Value: TRODataType);
|
|
procedure SetTypeName(const Value: string);
|
|
function GetAsBoolean: boolean;
|
|
function GetAsCurrency: currency;
|
|
function GetAsDateTime: TDateTime;
|
|
function GetAsFloat: double;
|
|
function GetAsInteger: integer;
|
|
function GetAsComplexType: TROComplexType;
|
|
function GetAsString: string;
|
|
function GetAsVariant: variant;
|
|
procedure SetAsBoolean(const Value: boolean);
|
|
procedure SetAsCurrency(const Value: currency);
|
|
procedure SetAsDateTime(const Value: TDateTime);
|
|
procedure SetAsFloat(const Value: double);
|
|
procedure SetAsInteger(const Value: integer);
|
|
procedure SetAsComplexType(const Value: TROComplexType);
|
|
procedure SetAsString(const Value: string);
|
|
procedure SetAsVariant(const Value: variant);
|
|
function GetAsWideString: string;
|
|
procedure SetAsWideString(const Value: string);
|
|
function GetAsInt64: Int64;
|
|
procedure SetAsInt64(const Value: Int64);
|
|
function GetAsBinary: Binary;
|
|
procedure SetAsBinary(const Value: Binary);
|
|
function GetIsNull: boolean;
|
|
|
|
{$IFDEF FPC}
|
|
procedure FPC_ReadVariant(Reader: TReader);
|
|
procedure FPC_WriteVariant(Writer: TWriter);
|
|
{$ENDIF FPC}
|
|
protected
|
|
function GetDisplayName: string; override;
|
|
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
destructor Destroy; override;
|
|
|
|
function GetSimpleValueReference: PVariant;
|
|
procedure CopyRODLParam(aSourceParam: TRODLOperationParam; aPersistValues: boolean=true; aOldParams: TRORequestParamCollection=nil);
|
|
|
|
procedure ReadSimpleValue(Reader: TReader);
|
|
procedure WriteSimpleValue(Writer: TWriter);
|
|
procedure ReadComplexTypeValue(Reader: TReader);
|
|
procedure WriteComplexTypeValue(Writer: TWriter);
|
|
procedure ReadBinaryValue(Stream: TStream);
|
|
procedure WriteBinaryValue(Stream: TStream);
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
|
|
procedure Assign(Source: TPersistent); override;
|
|
|
|
procedure ClearValue;
|
|
procedure Check; // check if param has values adequate to its datatype
|
|
|
|
property IsNull : boolean read GetIsNull;
|
|
|
|
property AsBoolean: boolean read GetAsBoolean write SetAsBoolean;
|
|
property AsCurrency: currency read GetAsCurrency write SetAsCurrency;
|
|
property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
|
|
property AsFloat: double read GetAsFloat write SetAsFloat;
|
|
property AsInteger: integer read GetAsInteger write SetAsInteger;
|
|
property AsString: string read GetAsString write SetAsString;
|
|
property AsWideString: string read GetAsWideString write SetAsWideString;
|
|
property AsInt64 : Int64 read GetAsInt64 write SetAsInt64;
|
|
property AsVariant: variant read GetAsVariant write SetAsVariant;
|
|
|
|
property AsComplexType: TROComplexType read GetAsComplexType write SetAsComplexType;
|
|
property AsBinary : Binary read GetAsBinary write SetAsBinary;
|
|
|
|
property OwnsBinary: boolean read fOwnsBinary write fOwnsBinary;
|
|
property OwnsComplexType: boolean read fOwnsComplexType write fOwnsComplexType;
|
|
|
|
published
|
|
property Name : string read fName write SetName;
|
|
property DataType : TRODataType read fDataType write SetDataType;
|
|
property Flag : TRODLParamFlag read fFlag write SetFlag;
|
|
property TypeName : string read fTypeName write SetTypeName;
|
|
property Value: variant read GetAsVariant write SetAsVariant;
|
|
end;
|
|
|
|
{ TRORequestParamCollection }
|
|
TRORequestParamCollection = class(TCollection)
|
|
private
|
|
fRequest : TRODynamicRequest;
|
|
function GetHasResultParam: boolean;
|
|
function GetResultParam: TRORequestParam;
|
|
|
|
protected
|
|
function GetItems(aIndex: integer): TRORequestParam;
|
|
procedure SetItems(aIndex: integer; aNewItem: TRORequestParam);
|
|
|
|
public
|
|
constructor Create(aDynamicRequest : TRODynamicRequest);
|
|
destructor Destroy; override;
|
|
|
|
function Add: TRORequestParam; overload;
|
|
function Add(const aName: string; aDataType: TRODataType; aParamFlag: TRODLParamFlag; const aTypeName: string=''): TRORequestParam; overload;
|
|
function Insert(aIndex: integer): TRORequestParam;
|
|
|
|
function FindParam(const aParamName: string): TRORequestParam;
|
|
function ParamByName(const aParamName: string): TRORequestParam;
|
|
|
|
procedure CopyRODLOperation(anOperation : TRODLOperation);
|
|
|
|
procedure Refresh;
|
|
|
|
procedure ClearValues;
|
|
procedure ClearInputValues;
|
|
procedure ClearOutputValues;
|
|
procedure Clone(Source : TRORequestParamCollection);
|
|
|
|
function IndexOf(aItem: TRORequestParam): integer;
|
|
|
|
property ResultParam : TRORequestParam read GetResultParam;
|
|
property HasResultParam: boolean read GetHasResultParam;
|
|
property Items[Index: integer]: TRORequestParam read GetItems write SetItems; default;
|
|
end;
|
|
|
|
{ TRODynamicRequest }
|
|
TRODynamicRequest = class(TROComponent)
|
|
private
|
|
fMethodName: string;
|
|
fParams: TRORequestParamCollection;
|
|
fOnExecuteError: TRODynamicRequestErrorEvent;
|
|
fOnAfterExecute: TRODynamicRequestNotifyEvent;
|
|
fOnBeforeExecute: TRODynamicRequestNotifyEvent;
|
|
fOnChangeMethodName: TROStringPropertyChangeEvent;
|
|
fOnChangeServiceName: TROStringPropertyChangeEvent;
|
|
fOnFindCustomTypeImplementation: TROFindCustomTypeImplementationEvent;
|
|
fRemoteService: TRORemoteService;
|
|
function GetRODLLibrary: TRODLLibrary;
|
|
protected
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure SetRemoteService(const Value: TRORemoteService);
|
|
|
|
procedure SetMethodName(const Value: string);
|
|
function GetParams: TRORequestParamCollection;
|
|
procedure SetParams(const Value: TRORequestParamCollection);
|
|
function GetIsFunction: boolean;
|
|
|
|
protected
|
|
procedure DoExecute(aParams: TRORequestParamCollection=nil); virtual;
|
|
procedure MethodNameChanged; virtual;
|
|
public
|
|
constructor Create(aOwner : TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure CreateInputComplexTypes(SkipIfAssigned : boolean);
|
|
|
|
procedure Execute(aParams: TRORequestParamCollection=nil);
|
|
|
|
procedure RefreshParams(aPersistValues: boolean = false); overload;
|
|
procedure RefreshParams(aOperation: TRODLOperation; aPersistValues: boolean = false); overload;
|
|
|
|
function FindParam(const aParamName: string): TRORequestParam;
|
|
function ParamByName(const aParamName: string): TRORequestParam;
|
|
|
|
procedure ListServiceOperations(const aServiceName : string; aList : TStrings);
|
|
procedure CheckProperties;
|
|
property RODLLibrary : TRODLLibrary read GetRODLLibrary;
|
|
property IsFunction : boolean read GetIsFunction;
|
|
|
|
|
|
published
|
|
property OnBeforeExecute : TRODynamicRequestNotifyEvent read fOnBeforeExecute write fOnBeforeExecute;
|
|
property OnAfterExecute : TRODynamicRequestNotifyEvent read fOnAfterExecute write fOnAfterExecute;
|
|
property OnExecuteError : TRODynamicRequestErrorEvent read fOnExecuteError write fOnExecuteError;
|
|
property OnFindCustomTypeImplementation: TROFindCustomTypeImplementationEvent read fOnFindCustomTypeImplementation write fOnFindCustomTypeImplementation;
|
|
|
|
property OnChangeServiceName : TROStringPropertyChangeEvent read fOnChangeServiceName write fOnChangeServiceName;
|
|
property OnChangeMethodName : TROStringPropertyChangeEvent read fOnChangeMethodName write fOnChangeMethodName;
|
|
|
|
property RemoteService: TRORemoteService read fRemoteService write SetRemoteService;
|
|
{$WARNINGS OFF}
|
|
property MethodName : string read fMethodName write SetMethodName;
|
|
{$WARNINGS ON}
|
|
property Params : TRORequestParamCollection read GetParams write SetParams;
|
|
end;
|
|
|
|
{ Cloning functions }
|
|
function CloneObject(Proto : TPersistent) : TPersistent;
|
|
function CloneComplexType(Proto : TROComplexType) : TROComplexType;
|
|
function CloneBinary(Proto : Binary) : Binary;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF DEBUG_REMOBJECTS_DYNAMICREQUEST}eDebugServer,{$ENDIF}
|
|
Variants, TypInfo, IniFiles,
|
|
uROClientIntf, uRORes;
|
|
|
|
var CloneNumber : Integer = 0;
|
|
|
|
{ Copy Event handlers from one component to another. }
|
|
procedure CopyEvents( S, D : TPersistent );
|
|
var
|
|
I : Integer;
|
|
PProps : PPropList;
|
|
PCount : Integer;
|
|
M : TMethod;
|
|
begin
|
|
{ Scan through all published properties... }
|
|
PCount := GetTypeData( S.ClassInfo ).PropCount;
|
|
GetMem( PProps, PCount * sizeof(PPropInfo));
|
|
try
|
|
GetPropInfos( S.ClassInfo, PProps );
|
|
for I := 0 to PCount - 1 do
|
|
begin
|
|
if PProps[I].PropType^.Kind = tkMethod then
|
|
begin
|
|
M := GetMethodProp( S, PProps[I] );
|
|
SetMethodProp( D, PProps[I], M );
|
|
end;
|
|
end;
|
|
finally
|
|
FreeMem( PProps, PCount * sizeof(PPropInfo));
|
|
end;
|
|
end;
|
|
|
|
function CloneObject(Proto : TPersistent) : TPersistent;
|
|
var
|
|
M : TMemoryStream;
|
|
T : TComponent;
|
|
begin
|
|
if Proto=NIL then begin
|
|
result := NIL;
|
|
Exit;
|
|
end
|
|
|
|
else if (Proto is TROComplexType) then begin
|
|
result := TPersistent(TROComplexTypeClass(Proto.ClassType).Create);
|
|
result.Assign(Proto);
|
|
Exit;
|
|
end;
|
|
|
|
RegisterClass( TPersistentClass(Proto.ClassType) );
|
|
|
|
M := TMemoryStream.Create;
|
|
try
|
|
{ Write prototype to stream & create a new item by reading it back. }
|
|
M.WriteComponent(TComponent(Proto));
|
|
M.Seek( 0, soFromBeginning );
|
|
T := M.ReadComponent( nil );
|
|
|
|
{ Set owner and parent as required. }
|
|
if T.Owner <> nil then T.Owner.RemoveComponent( T );
|
|
T.Name := format( 'Clone%d', [CloneNumber] );
|
|
CloneNumber := CloneNumber+1;
|
|
|
|
{ The above will lose event handlers for some reason so we must }
|
|
{ copy these using some black magic... }
|
|
CopyEvents( Proto, T );
|
|
finally
|
|
M.Free;
|
|
end;
|
|
Result := T;
|
|
end;
|
|
|
|
function CloneComplexType(Proto : TROComplexType) : TROComplexType;
|
|
begin
|
|
result := TROComplexType(CloneObject(Proto));
|
|
end;
|
|
|
|
function CloneBinary(Proto : Binary) : Binary;
|
|
begin
|
|
if Proto=NIL then result := NIL
|
|
else begin
|
|
result := Binary.Create;
|
|
result.LoadFromStream(Proto);
|
|
result.Position := 0;
|
|
end;
|
|
end;
|
|
|
|
{ TRORequestParam }
|
|
|
|
constructor TRORequestParam.Create(Collection: TCollection);
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
destructor TRORequestParam.Destroy;
|
|
begin
|
|
if fOwnsComplexType then FreeAndNil(fComplexTypeValue);
|
|
if fOwnsBinary then FreeAndNil(fBinaryValue);
|
|
inherited;
|
|
end;
|
|
|
|
function TRORequestParam.GetDisplayName: string;
|
|
begin
|
|
if (Trim(Name)='') then
|
|
result := inherited GetDisplayName
|
|
else
|
|
result := Name+': '+GetEnumName(TypeInfo(TRODataType), Ord(DataType));
|
|
end;
|
|
|
|
procedure TRORequestParam.SetTypeName(const Value: string);
|
|
begin
|
|
fTypeName := Value;
|
|
if fTypeName <> '' then
|
|
DataType := rtUserDefined;
|
|
end;
|
|
|
|
procedure TRORequestParam.SetDataType(const Value: TRODataType);
|
|
begin
|
|
fDataType := Value;
|
|
|
|
if (Value = rtBinary) then begin
|
|
if not assigned(fBinaryValue) then begin
|
|
fBinaryValue := Binary.Create();
|
|
fOwnsBinary := true;
|
|
end;
|
|
end
|
|
else begin
|
|
if fOwnsBinary then FreeAndNil(fBinaryValue);
|
|
fBinaryValue := nil;
|
|
fOwnsBinary := false;
|
|
end;
|
|
|
|
if Value <> rtUserDefined then
|
|
fTypeName := '';
|
|
end;
|
|
|
|
procedure TRORequestParam.SetFlag(const Value: TRODLParamFlag);
|
|
begin
|
|
fFlag := Value;
|
|
end;
|
|
|
|
procedure TRORequestParam.SetName(const Value: string);
|
|
begin
|
|
fName := Value;
|
|
end;
|
|
|
|
function TRORequestParam.GetAsBoolean: boolean;
|
|
begin
|
|
if VarIsNull(fSimpleValue) then
|
|
result := false
|
|
else
|
|
result := fSimpleValue
|
|
end;
|
|
|
|
function TRORequestParam.GetAsCurrency: currency;
|
|
begin
|
|
if VarIsNull(fSimpleValue) then
|
|
result := 0
|
|
else
|
|
result := fSimpleValue
|
|
end;
|
|
|
|
function TRORequestParam.GetAsDateTime: TDateTime;
|
|
begin
|
|
if VarIsNull(fSimpleValue) then
|
|
result := 0
|
|
else
|
|
result := fSimpleValue;
|
|
end;
|
|
|
|
function TRORequestParam.GetAsFloat: double;
|
|
begin
|
|
if VarIsNull(fSimpleValue) then
|
|
result := 0
|
|
else
|
|
result := fSimpleValue
|
|
end;
|
|
|
|
function TRORequestParam.GetAsInteger: integer;
|
|
begin
|
|
if VarIsNull(fSimpleValue) then
|
|
result := 0
|
|
else
|
|
result := fSimpleValue
|
|
end;
|
|
|
|
function TRORequestParam.GetAsString: string;
|
|
begin
|
|
if VarIsNull(fSimpleValue) then
|
|
result := ''
|
|
else
|
|
result := fSimpleValue
|
|
end;
|
|
|
|
function TRORequestParam.GetAsVariant: variant;
|
|
begin
|
|
result := fSimpleValue
|
|
end;
|
|
|
|
procedure TRORequestParam.SetAsBoolean(const Value: boolean);
|
|
begin
|
|
fSimpleValue := Value
|
|
end;
|
|
|
|
procedure TRORequestParam.SetAsCurrency(const Value: currency);
|
|
begin
|
|
fSimpleValue := Value
|
|
end;
|
|
|
|
procedure TRORequestParam.SetAsDateTime(const Value: TDateTime);
|
|
begin
|
|
fSimpleValue := Value
|
|
end;
|
|
|
|
procedure TRORequestParam.SetAsFloat(const Value: double);
|
|
begin
|
|
fSimpleValue := Value
|
|
end;
|
|
|
|
procedure TRORequestParam.SetAsInteger(const Value: integer);
|
|
begin
|
|
fSimpleValue := Value
|
|
end;
|
|
|
|
procedure TRORequestParam.SetAsString(const Value: string);
|
|
begin
|
|
fSimpleValue := Value
|
|
end;
|
|
|
|
procedure TRORequestParam.SetAsVariant(const Value: variant);
|
|
begin
|
|
fSimpleValue := Value
|
|
end;
|
|
|
|
procedure TRORequestParam.ClearValue;
|
|
begin
|
|
if fOwnsComplexType then fComplexTypeValue.Free;
|
|
if fOwnsBinary then fBinaryValue.Free;
|
|
fComplexTypeValue := nil;
|
|
fBinaryValue := nil;
|
|
fSimpleValue := Null;
|
|
fOwnsComplexType := false;
|
|
fOwnsBinary := false;
|
|
DataType := DataType; // recreates Binary if needed
|
|
end;
|
|
|
|
function TRORequestParam.GetAsWideString: string;
|
|
begin
|
|
result := fSimpleValue
|
|
end;
|
|
|
|
procedure TRORequestParam.SetAsWideString(const Value: string);
|
|
begin
|
|
fSimpleValue := Value
|
|
end;
|
|
|
|
function TRORequestParam.GetAsInt64: Int64;
|
|
begin
|
|
result := fSimpleValue
|
|
end;
|
|
|
|
procedure TRORequestParam.SetAsInt64(const Value: Int64);
|
|
begin
|
|
fSimpleValue := Value
|
|
end;
|
|
|
|
function TRORequestParam.GetAsBinary: Binary;
|
|
begin
|
|
result := fBinaryValue;
|
|
end;
|
|
|
|
procedure TRORequestParam.SetAsBinary(const Value: Binary);
|
|
begin
|
|
if Value <> fBinaryValue then begin
|
|
if fOwnsBinary then FreeAndNil(fBinaryValue);
|
|
fOwnsBinary := false;
|
|
fBinaryValue := Value;
|
|
end;
|
|
end;
|
|
|
|
function TRORequestParam.GetAsComplexType: TROComplexType;
|
|
begin
|
|
result := fComplexTypeValue;
|
|
end;
|
|
|
|
procedure TRORequestParam.SetAsComplexType(const Value: TROComplexType);
|
|
begin
|
|
if Value <> fComplexTypeValue then begin
|
|
if fOwnsComplexType then
|
|
FreeAndNil(fComplexTypeValue);
|
|
fOwnsComplexType := false;
|
|
fComplexTypeValue := Value;
|
|
end;
|
|
end;
|
|
|
|
function TRORequestParam.GetIsNull: boolean;
|
|
begin
|
|
result := ((fDataType = rtBinary) and (fBinaryValue = nil)) or
|
|
((fDataType = rtUserDefined) and (fComplexTypeValue = nil)) or
|
|
(fSimpleValue = Null);
|
|
|
|
end;
|
|
|
|
function TRORequestParam.GetSimpleValueReference: PVariant;
|
|
begin
|
|
result := @fSimpleValue
|
|
end;
|
|
|
|
procedure TRORequestParam.Assign(Source: TPersistent);
|
|
begin
|
|
if (Source is TRORequestParam) then begin
|
|
Name := TRORequestParam(Source).Name;
|
|
DataType := TRORequestParam(Source).DataType;
|
|
Flag := TRORequestParam(Source).Flag;
|
|
TypeName := TRORequestParam(Source).TypeName;
|
|
case DataType of
|
|
rtBinary: AsBinary := TRORequestParam(Source).AsBinary;
|
|
rtUserDefined: AsComplexType := TRORequestParam(Source).AsComplexType;
|
|
else AsVariant := AsVariant;
|
|
end;
|
|
end
|
|
else inherited;
|
|
end;
|
|
|
|
procedure TRORequestParam.Check;
|
|
begin
|
|
case DataType of
|
|
rtInteger: AsInteger;
|
|
rtDateTime: AsDateTime;
|
|
rtDouble: AsFloat;
|
|
rtCurrency: AsCurrency;
|
|
rtWidestring: AsWideString;
|
|
rtString: AsString;
|
|
rtInt64: AsInt64;
|
|
rtBoolean: AsBoolean;
|
|
rtVariant: AsVariant;
|
|
rtBinary: AsBinary;
|
|
rtUserDefined: AsComplexType;
|
|
else Assert(False, 'unsupported data type encountered in TRORequestParam '+Name);
|
|
end;
|
|
end;
|
|
|
|
procedure TRORequestParam.CopyRODLParam(aSourceParam: TRODLOperationParam; aPersistValues: boolean; aOldParams: TRORequestParamCollection);
|
|
var oldparam : TRORequestParam;
|
|
begin
|
|
Name := aSourceParam.Name;
|
|
Flag := aSourceParam.Flag;
|
|
DataType := StrToDataType(aSourceParam.DataType);
|
|
|
|
fSimpleValue := Null;
|
|
if DataType = rtUserDefined then
|
|
TypeName := aSourceParam.DataType
|
|
else
|
|
TypeName := '';
|
|
|
|
if aPersistValues and Assigned(aOldParams) then begin
|
|
oldparam := aOldParams.FindParam(Name);
|
|
if Assigned(oldparam) then begin
|
|
case DataType of
|
|
rtUserDefined: AsComplexType := oldparam.AsComplexType;
|
|
rtBinary: AsBinary := oldParam.AsBinary;
|
|
else AsVariant := oldparam.AsVariant;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TRORequestParamCollection }
|
|
|
|
constructor TRORequestParamCollection.Create(aDynamicRequest : TRODynamicRequest);
|
|
begin
|
|
inherited Create(TRORequestParam);
|
|
|
|
fRequest := aDynamicRequest;
|
|
end;
|
|
|
|
destructor TRORequestParamCollection.Destroy;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
function TRORequestParamCollection.Add: TRORequestParam;
|
|
begin
|
|
result := TRORequestParam(inherited Add);
|
|
end;
|
|
|
|
function TRORequestParamCollection.Add(const aName: string; aDataType: TRODataType; aParamFlag: TRODLParamFlag; const aTypeName: string=''): TRORequestParam;
|
|
begin
|
|
result := Add();
|
|
with result do begin
|
|
Name := aName;
|
|
DataType := aDataType;
|
|
Flag :=aParamFlag;
|
|
if DataType = rtUserDefined then
|
|
TypeName := aTypeName;
|
|
end;
|
|
end;
|
|
|
|
function TRORequestParamCollection.Insert(aIndex: integer): TRORequestParam;
|
|
begin
|
|
result := TRORequestParam(inherited Insert(aIndex));
|
|
end;
|
|
|
|
function TRORequestParamCollection.GetItems(aIndex: integer): TRORequestParam;
|
|
begin
|
|
result := TRORequestParam(inherited Items[aIndex]);
|
|
end;
|
|
|
|
function TRORequestParamCollection.IndexOf(aItem: TRORequestParam): 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 TRORequestParamCollection.SetItems(aIndex: integer; aNewItem: TRORequestParam);
|
|
begin
|
|
inherited Items[aIndex].Assign(aNewItem);
|
|
end;
|
|
|
|
procedure TRORequestParamCollection.Refresh;
|
|
var
|
|
svc : TRODLService;
|
|
oper : TRODLOperation;
|
|
begin
|
|
svc := TRODLService(fRequest.RODLLibrary.GetService(fRequest.RemoteService.ServiceName));
|
|
oper := TRODLOperation(svc.Default.GetOperation(fRequest.MethodName, TRUE));
|
|
|
|
CopyRODLOperation(oper);
|
|
end;
|
|
|
|
procedure TRORequestParamCollection.CopyRODLOperation(anOperation: TRODLOperation);
|
|
var i : integer;
|
|
param : TRORequestParam;
|
|
begin
|
|
Clear;
|
|
|
|
{$IFDEF DEBUG_REMOBJECTS_DYNAMICREQUEST}
|
|
DebugServer.EnterMethod('TRORequestParamCollection.CopyRODLOperation');
|
|
try
|
|
{$ENDIF}
|
|
|
|
for i := 0 to (anOperation.Count-1) do begin
|
|
{$IFDEF DEBUG_REMOBJECTS_DYNAMICREQUEST}
|
|
DebugServer.Write('Adding Parameter %s',[anOperation.Items[i].Name]);
|
|
{$ENDIF}
|
|
param := Add;
|
|
param.Name := anOperation.Items[i].Name;
|
|
param.DataType := StrToDataType(anOperation.Items[i].DataType);
|
|
param.Flag := anOperation.Items[i].Flag;
|
|
|
|
if (param.DataType=rtUserDefined)
|
|
then param.TypeName := anOperation.Items[i].DataType
|
|
else param.TypeName := '';
|
|
end;
|
|
|
|
if (anOperation.Result<>NIL) then begin
|
|
{$IFDEF DEBUG_REMOBJECTS_DYNAMICREQUEST}
|
|
DebugServer.Write('Adding Result');
|
|
{$ENDIF}
|
|
|
|
param := Insert(0);
|
|
|
|
param.Name := anOperation.Result.Name;
|
|
param.DataType := StrToDataType(anOperation.Result.DataType);
|
|
param.Flag := anOperation.Result.Flag;
|
|
|
|
if (param.DataType=rtUserDefined)
|
|
then param.TypeName := anOperation.Result.DataType
|
|
else param.TypeName := '';
|
|
end;
|
|
|
|
{$IFDEF DEBUG_REMOBJECTS_DYNAMICREQUEST}
|
|
finally
|
|
DebugServer.ExitMethod('TRORequestParamCollection.CopyRODLOperation');
|
|
end;
|
|
{$ENDIF}
|
|
|
|
end;
|
|
|
|
function TRORequestParamCollection.FindParam(const aParamName: string): TRORequestParam;
|
|
var i: Integer;
|
|
begin
|
|
result := NIL;
|
|
for i := 0 to (Count - 1) do
|
|
if SameText(Items[i].Name, aParamName) then begin
|
|
result := Items[i];
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
function TRORequestParamCollection.ParamByName(const aParamName: string): TRORequestParam;
|
|
begin
|
|
result := FindParam(aParamName);
|
|
if not assigned(result) then raise Exception.CreateFmt(err_CannotFindParameter, [aParamName]);
|
|
end;
|
|
|
|
procedure TRORequestParamCollection.ClearValues;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to (Count - 1) do
|
|
Items[i].ClearValue;
|
|
end;
|
|
|
|
procedure TRORequestParamCollection.ClearInputValues;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to (Count - 1) do
|
|
if (Items[i].Flag in [fIn, fInOut]) then // do not remove fInOut
|
|
Items[i].ClearValue;
|
|
end;
|
|
|
|
procedure TRORequestParamCollection.ClearOutputValues;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to (Count - 1) do
|
|
if (Items[i].Flag in [fOut, fResult]) then // do not add fInOut
|
|
Items[i].ClearValue;
|
|
end;
|
|
|
|
procedure TRORequestParamCollection.Clone(Source: TRORequestParamCollection);
|
|
var i: integer;
|
|
v: Variant;
|
|
begin
|
|
ClearValues;
|
|
Clear;
|
|
|
|
Assign(Source);
|
|
|
|
for i := 0 to (Source.Count - 1) do begin
|
|
case Source[i].DataType of
|
|
rtUserDefined : Items[i].AsComplexType := CloneObject(Source.Items[i].AsComplexType) as TROComplexType;
|
|
rtBinary : Items[i].AsBinary := CloneBinary(Source.Items[i].AsBinary);
|
|
else begin
|
|
v := Source.Items[i].AsVariant;
|
|
Items[i].AsVariant := v;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRORequestParamCollection.GetResultParam: TRORequestParam;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to (Count - 1) do begin
|
|
if (Items[i].Flag in [fResult]) then begin
|
|
result := Items[i];
|
|
exit;
|
|
end;
|
|
end;
|
|
result := nil;
|
|
end;
|
|
|
|
function TRORequestParamCollection.GetHasResultParam: boolean;
|
|
begin
|
|
result := GetResultParam() <> nil;
|
|
end;
|
|
|
|
{ TRODynamicRequest }
|
|
|
|
constructor TRODynamicRequest.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
fParams := TRORequestParamCollection.Create(Self);
|
|
end;
|
|
|
|
destructor TRODynamicRequest.Destroy;
|
|
begin
|
|
fParams.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TRODynamicRequest.DoExecute(aParams: TRORequestParamCollection=nil);
|
|
var
|
|
// Temporary buffers
|
|
vint: integer;
|
|
vdatetime: TDateTime;
|
|
vdouble: double;
|
|
vcurrency: currency;
|
|
vwidestring: widestring;
|
|
vstring: string;
|
|
vint64: int64;
|
|
vboolean: boolean;
|
|
vcls : TROComplexTypeClass;
|
|
vobj : TROComplexType;
|
|
vbinary : Binary;
|
|
vvariant: Variant;
|
|
|
|
lParamName : string;
|
|
lComplexTypeClass : TClass;
|
|
lMessage: IROMessage;
|
|
|
|
procedure WriteParam(aParam: TRORequestParam);
|
|
begin
|
|
if not Assigned(aParam) then exit; // allow passing of nil for ease of use
|
|
lParamName := aParam.Name;
|
|
|
|
case aParam.DataType of
|
|
rtInteger: begin
|
|
vint := aParam.AsInteger;
|
|
lMessage.Write(lParamName, TypeInfo(integer), vint, []);
|
|
end;
|
|
rtDateTime: begin
|
|
vdatetime := aParam.AsDateTime;
|
|
lMessage.Write(lParamName, TypeInfo(TDateTime), vdatetime, []);
|
|
end;
|
|
rtDouble: begin
|
|
vdouble := aParam.AsFloat;
|
|
lMessage.Write(lParamName, TypeInfo(TDateTime), vdouble, []);
|
|
end;
|
|
rtCurrency: begin
|
|
vcurrency := aParam.AsCurrency;
|
|
lMessage.Write(lParamName, TypeInfo(currency), vcurrency, []);
|
|
end;
|
|
rtWidestring: begin
|
|
vwidestring := aParam.AsWideString;
|
|
lMessage.Write(lParamName, TypeInfo(widestring), vwidestring, []);
|
|
end;
|
|
rtString: begin
|
|
vstring := aParam.AsString;
|
|
lMessage.Write(lParamName, TypeInfo(string), vstring, []);
|
|
end;
|
|
rtInt64: begin
|
|
vint64 := aParam.AsInt64;
|
|
lMessage.Write(lParamName, TypeInfo(int64), vint64, []);
|
|
end;
|
|
rtBoolean: begin
|
|
vboolean := aParam.AsBoolean;
|
|
lMessage.Write(lParamName, TypeInfo(boolean), vboolean, []);
|
|
end;
|
|
rtVariant: begin
|
|
vvariant := aParam.AsVariant;
|
|
lMessage.Write(aParam.Name, TypeInfo(variant), vvariant, []);
|
|
end;
|
|
rtBinary: begin
|
|
vbinary := aParam.AsBinary;
|
|
if Assigned(vbinary) then begin
|
|
lMessage.Write(lParamName, vbinary.ClassInfo, vbinary, []);
|
|
end
|
|
else begin
|
|
lMessage.Write(lParamName, TypeInfo(binary), vbinary, []);
|
|
end;
|
|
end;
|
|
rtUserDefined : begin
|
|
vobj := aParam.AsComplexType;
|
|
if assigned(vobj) then
|
|
lMessage.Write(lParamName, vobj.ClassInfo, vobj, [])
|
|
else begin
|
|
lComplexTypeClass := FindROClass(aParam.TypeName);
|
|
if not assigned(lComplexTypeClass) then
|
|
raise Exception.CreateFmt('Unknown class %s', [aParam.TypeName]);
|
|
lMessage.Write(lParamName, lComplexTypeClass.ClassInfo, vobj, []);
|
|
end;
|
|
end;
|
|
else
|
|
NotSupported;
|
|
end; { case }
|
|
end;
|
|
|
|
procedure ReadParam(aParam: TRORequestParam);
|
|
begin
|
|
if not Assigned(aParam) then exit; // allow passing of nil for ease of use
|
|
lParamName := aParam.Name;
|
|
|
|
{$IFDEF DEBUG_REMOBJECTS_DYNAMICREQUEST}
|
|
DebugServer.Write('Reading Parameter %s.',[lParamName]);
|
|
{$ENDIF}
|
|
|
|
case aParam.DataType of
|
|
rtInteger: begin
|
|
lMessage.Read(lParamName, TypeInfo(integer), vint, []);
|
|
aParam.AsInteger := vint;
|
|
end;
|
|
rtDateTime: begin
|
|
lMessage.Read(lParamName, TypeInfo(TDateTime), vdatetime, []);
|
|
aParam.AsDateTime := vdatetime;
|
|
end;
|
|
rtDouble: begin
|
|
lMessage.Read(lParamName, TypeInfo(TDateTime), vdouble, []);
|
|
aParam.AsFloat := vdouble;
|
|
end;
|
|
rtCurrency: begin
|
|
lMessage.Read(lParamName, TypeInfo(currency), vcurrency, []);
|
|
aParam.AsCurrency := vcurrency;
|
|
end;
|
|
rtWidestring: begin
|
|
lMessage.Read(lParamName, TypeInfo(widestring), vwidestring, []);
|
|
aParam.AsWideString := vwidestring;
|
|
end;
|
|
rtString: begin
|
|
lMessage.Read(lParamName, TypeInfo(string), vstring, []);
|
|
aParam.AsString := vstring;
|
|
end;
|
|
rtInt64: begin
|
|
lMessage.Read(lParamName, TypeInfo(int64), vint64, []);
|
|
aParam.AsInt64 := vint64;
|
|
end;
|
|
rtBoolean: begin
|
|
lMessage.Read(lParamName, TypeInfo(boolean), vboolean, []);
|
|
aParam.AsBoolean := vboolean;
|
|
end;
|
|
rtBinary: begin
|
|
vbinary := aParam.AsBinary;
|
|
if Assigned(vbinary) then begin
|
|
lMessage.Read(lParamName, vbinary.ClassInfo, vbinary, []);
|
|
end
|
|
else begin
|
|
lMessage.Read(lParamName, TypeInfo(binary), vbinary, []);
|
|
end;
|
|
aParam.AsBinary := vbinary;
|
|
end;
|
|
rtUserDefined : begin
|
|
{ ToDo -omh: I'm not particulaty happy with this approach yet (both here AND in the general
|
|
streaming code. We should add a better hook to create the proper class for reading
|
|
complex/array types. See also commenst in uROStreamSerializer. }
|
|
if Assigned(aParam.AsComplexType) then begin
|
|
vobj := aParam.AsComplexType;
|
|
lMessage.Read(lParamName, vobj.ClassInfo, vobj, []);
|
|
end
|
|
else begin
|
|
vobj := nil;
|
|
vcls := FindROClass(aParam.TypeName);
|
|
if Assigned(vcls) then begin
|
|
lMessage.Read(lParamName, vcls.ClassInfo, vobj, []);
|
|
end
|
|
else begin
|
|
if Assigned(OnFindCustomTypeImplementation) then
|
|
OnFindCustomTypeImplementation(self, aParam.TypeName, aParam, vobj);
|
|
|
|
if not Assigned(vobj) then
|
|
raise EROUnknownType.CreateFmt(err_UnknownClass, [aParam.TypeName]);
|
|
|
|
lMessage.Read(lParamName, vobj.ClassInfo, vobj, []);
|
|
end;
|
|
|
|
end;
|
|
aParam.AsComplexType := vobj;
|
|
end;
|
|
else
|
|
NotSupported;
|
|
end; { case }
|
|
end;
|
|
|
|
var
|
|
lChannel: IROTransportChannel;
|
|
i: integer;
|
|
|
|
begin
|
|
CheckProperties;
|
|
|
|
if not assigned(aParams) then aParams := Params; // use own params, if none are passed in.
|
|
|
|
try
|
|
lMessage := RemoteService.Message as IROMessage;
|
|
lChannel := RemoteService.Channel as IROTransportChannel;
|
|
|
|
lMessage.InitializeRequestMessage(lChannel, '', fRemoteService.ServiceName, MethodName);
|
|
for i := 0 to (aParams.Count-1) do
|
|
if (aParams[i].Flag in [fIn, fInOut]) then
|
|
WriteParam(aParams[i]);
|
|
lMessage.Finalize;
|
|
|
|
(RemoteService.Channel as IROTransportChannel).Dispatch(lMessage);
|
|
|
|
ReadParam(aParams.ResultParam); // important: Result must be read before any of the other out or var parameters
|
|
for i := 0 to (aParams.Count - 1) do
|
|
if (aParams[i].Flag in [fOut, fInOut]) then
|
|
ReadParam(aParams[i]);
|
|
|
|
finally
|
|
lMessage.FreeStream;
|
|
end;
|
|
end;
|
|
|
|
procedure TRODynamicRequest.Execute(aParams: TRORequestParamCollection=nil);
|
|
var
|
|
lIgnoreException : boolean;
|
|
begin
|
|
if Assigned(fOnBeforeExecute) then
|
|
fOnBeforeExecute(Self);
|
|
try
|
|
try
|
|
DoExecute(aParams);
|
|
except
|
|
on E:Exception do begin
|
|
lIgnoreException := FALSE;
|
|
if Assigned(fOnExecuteError) then
|
|
fOnExecuteError(Self, E, lIgnoreException);
|
|
if not lIgnoreException then raise;
|
|
end;
|
|
end;
|
|
finally
|
|
if Assigned(fOnAfterExecute) then
|
|
fOnAfterExecute(Self);
|
|
end;
|
|
end;
|
|
|
|
function TRODynamicRequest.GetParams: TRORequestParamCollection;
|
|
begin
|
|
result := fParams
|
|
end;
|
|
|
|
function TRODynamicRequest.GetRODLLibrary: TRODLLibrary;
|
|
begin
|
|
result := RemoteService.GetRODLLibrary();
|
|
end;
|
|
|
|
function TRODynamicRequest.FindParam(const aParamName: string): TRORequestParam;
|
|
begin
|
|
result := fParams.FindParam(aParamName);
|
|
end;
|
|
|
|
function TRODynamicRequest.ParamByName(const aParamName: string): TRORequestParam;
|
|
begin
|
|
result := fParams.ParamByName(aParamName);
|
|
end;
|
|
|
|
procedure TRODynamicRequest.RefreshParams(aPersistValues: boolean);
|
|
var
|
|
lLibrary: TRODLLibrary;
|
|
lService: TRODLService;
|
|
lOperation: TRODLOperation;
|
|
begin
|
|
CheckProperties;
|
|
|
|
lLibrary := RemoteService.GetRODLLibrary();
|
|
lService := lLibrary.FindService(RemoteService.ServiceName);
|
|
if not Assigned(lService) then RaiseError('Undefined service "' + RemoteService.ServiceName + '"');
|
|
|
|
repeat
|
|
lOperation := lService.Default.FindOperation(MethodName);
|
|
if not Assigned(lOperation) then begin
|
|
if lService.Ancestor <> '' then begin
|
|
lService := lLibrary.FindService(lService.Ancestor);
|
|
end
|
|
else
|
|
lService := nil;
|
|
end;
|
|
until Assigned(lOperation) or not Assigned(lService);
|
|
|
|
if not Assigned(lOperation) then RaiseError('Method "' + MethodName + '" not found in service ' + RemoteService.ServiceName + ' or its anchestors');
|
|
RefreshParams(lOperation, aPersistValues);
|
|
end;
|
|
|
|
procedure TRODynamicRequest.RefreshParams(aOperation: TRODLOperation; aPersistValues: boolean);
|
|
var
|
|
i: integer;
|
|
lOldParams: TRORequestParamCollection;
|
|
lNewParam: TRORequestParam;
|
|
begin
|
|
lOldParams := nil;
|
|
try
|
|
|
|
if aPersistValues then begin
|
|
lOldParams := TRORequestParamCollection.Create(nil);
|
|
for i := 0 to (Params.Count - 1) do begin
|
|
with lOldParams.Add do begin
|
|
Assign(Params[i]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Params.Clear();
|
|
|
|
if Assigned(aOperation.Result) then begin
|
|
lNewParam := Params.Add();
|
|
lNewParam.CopyRODLParam(aOperation.Result, true, lOldParams);
|
|
end;
|
|
|
|
for i := 0 to (aOperation.Count - 1) do begin
|
|
lNewParam := Params.Add();
|
|
lNewParam.CopyRODLParam(aOperation.Items[i], true, lOldParams);
|
|
end;
|
|
finally
|
|
FreeAndNil(lOldParams);
|
|
end;
|
|
end;
|
|
|
|
procedure TRODynamicRequest.SetMethodName(const Value: string);
|
|
var
|
|
lOldValue: string;
|
|
begin
|
|
if Value <> fMethodName then begin
|
|
lOldValue := fMethodName;
|
|
fMethodName := Value;
|
|
MethodNameChanged();
|
|
if Assigned(fOnChangeMethodName) then fOnChangeMethodName(Self, lOldValue, fMethodName);
|
|
end;
|
|
end;
|
|
|
|
procedure TRODynamicRequest.SetParams(
|
|
const Value: TRORequestParamCollection);
|
|
begin
|
|
fParams.Assign(Value);
|
|
end;
|
|
|
|
procedure TRODynamicRequest.SetRemoteService(const Value: TRORemoteService);
|
|
begin
|
|
if Value <> fRemoteService then begin
|
|
fRemoteService := Value;
|
|
if assigned(fRemoteService) then fRemoteService.FreeNotification(self);
|
|
end;
|
|
end;
|
|
|
|
procedure TRODynamicRequest.ListServiceOperations(
|
|
const aServiceName: string; aList: TStrings);
|
|
var service : TRODLService;
|
|
i: Integer;
|
|
begin
|
|
service := TRODLService(RODLLibrary.FindService(aServiceName));
|
|
Check(service=NIL, err_CannotFindService, [aServiceName]);
|
|
|
|
while service<>NIL do begin
|
|
for i := 0 to (service.Default.Count - 1) do begin
|
|
aList.Add(service.Default.Items[i].Name)
|
|
end;
|
|
|
|
if service.Ancestor<>''
|
|
then service := RODLLibrary.FindService(service.Ancestor)
|
|
else Break;
|
|
end;
|
|
end;
|
|
|
|
procedure TRODynamicRequest.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited;
|
|
if Operation = opRemove then begin
|
|
if AComponent = RemoteService then RemoteService := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TRODynamicRequest.CreateInputComplexTypes(SkipIfAssigned : boolean);
|
|
var
|
|
i: Integer;
|
|
cls: TROComplexTypeClass;
|
|
vobj: TROComplexType;
|
|
begin
|
|
for i := 0 to (fParams.Count - 1) do
|
|
if (fParams[i].Flag=fIn) then begin
|
|
case fParams[i].DataType of
|
|
rtUserDefined: begin
|
|
if Assigned(fParams[i].AsComplexType) then begin
|
|
if SkipIfAssigned then
|
|
Continue
|
|
else
|
|
fParams[i].ClearValue;
|
|
end;
|
|
|
|
cls := FindROClass(fParams[i].TypeName);
|
|
if assigned(cls) then
|
|
vObj := cls.Create;
|
|
if not assigned(vObj) and Assigned(OnFindCustomTypeImplementation) then
|
|
OnFindCustomTypeImplementation(self, fParams[i].TypeName, fParams[i], vobj);
|
|
Assert(Assigned(vobj), Format(err_UnknownComplexType, [fParams[i].TypeName]));
|
|
fParams[i].AsComplexType := vobj;
|
|
end;
|
|
rtBinary: begin
|
|
if Assigned(fParams[i].AsBinary) then begin
|
|
if SkipIfAssigned then
|
|
Continue
|
|
else
|
|
fParams[i].ClearValue;
|
|
end;
|
|
|
|
fParams[i].AsBinary := Binary.Create;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRODynamicRequest.GetIsFunction: boolean;
|
|
begin
|
|
result := fParams.ResultParam<>NIL
|
|
end;
|
|
|
|
procedure TRORequestParam.DefineProperties(Filer: TFiler);
|
|
{$IFNDEF DESIGNTIME}
|
|
var
|
|
cls: TROComplexTypeClass;
|
|
{$ENDIF DESIGNTIME}
|
|
begin
|
|
inherited;
|
|
|
|
{$IFNDEF DESIGNTIME}
|
|
if Assigned(Collection) and (Collection.Owner <> nil) and
|
|
(Collection.Owner is TComponent) and (csDesigning in TComponent(Collection.Owner).ComponentState) then
|
|
exit;
|
|
|
|
if (DataType = rtUserDefined) and not Assigned(fComplexTypeValue) and
|
|
(Flag in [fIn, fInOut]) then
|
|
begin
|
|
cls := FindROClass(TypeName);
|
|
if assigned(cls) then
|
|
fComplexTypeValue := cls.Create;
|
|
if not assigned(fComplexTypeValue) and Assigned(TRORequestParamCollection(Collection).fRequest.OnFindCustomTypeImplementation) then
|
|
TRORequestParamCollection(Collection).fRequest.OnFindCustomTypeImplementation(TRORequestParamCollection(Collection).fRequest, TypeName, self, fComplexTypeValue);
|
|
Assert(Assigned(fComplexTypeValue), Format(err_UnknownComplexType, [TypeName]));
|
|
end;
|
|
|
|
Filer.DefineProperty('SimpleValue', ReadSimpleValue, WriteSimpleValue,
|
|
not (fDataType in [rtBinary, rtUserDefined]));
|
|
Filer.DefineProperty('ComplexTypeValue', ReadComplexTypeValue, WriteComplexTypeValue,
|
|
(fDataType = rtUserDefined) and Assigned(fComplexTypeValue));
|
|
Filer.DefineBinaryProperty('BinaryValue', ReadBinaryValue, WriteBinaryValue,
|
|
(fDataType = rtBinary) and Assigned(fBinaryValue));
|
|
{$ENDIF DESIGNTIME}
|
|
end;
|
|
|
|
procedure TRORequestParam.ReadBinaryValue(Stream: TStream);
|
|
begin
|
|
if not Assigned(fBinaryValue) then
|
|
begin
|
|
fBinaryValue := Binary.Create;
|
|
end;
|
|
|
|
fBinaryValue.LoadFromStream(Stream);
|
|
end;
|
|
|
|
procedure TRORequestParam.WriteBinaryValue(Stream: TStream);
|
|
begin
|
|
fBinaryValue.SaveToStream(Stream);
|
|
end;
|
|
|
|
type
|
|
TReader2 = class(TReader)
|
|
private
|
|
protected
|
|
public
|
|
procedure ReadProperty2(Instance: TPersistent);
|
|
end;
|
|
|
|
procedure TReader2.ReadProperty2(Instance: TPersistent);
|
|
begin
|
|
ReadProperty(Instance);
|
|
end;
|
|
|
|
procedure TRORequestParam.ReadComplexTypeValue(Reader: TReader);
|
|
var
|
|
cls: TROComplexTypeClass;
|
|
begin
|
|
if not Assigned(fComplexTypeValue) then
|
|
begin
|
|
cls := FindROClass(TypeName);
|
|
if assigned(cls) then
|
|
fComplexTypeValue := cls.Create;
|
|
if not assigned(fComplexTypeValue) and Assigned(TRORequestParamCollection(Collection).fRequest.OnFindCustomTypeImplementation) then
|
|
TRORequestParamCollection(Collection).fRequest.OnFindCustomTypeImplementation(TRORequestParamCollection(Collection).fRequest, TypeName, self, fComplexTypeValue);
|
|
Assert(Assigned(fComplexTypeValue), Format(err_UnknownComplexType, [TypeName]));
|
|
end;
|
|
|
|
Reader.ReadListBegin;
|
|
while not Reader.EndOfList do TReader2(Reader).ReadProperty(fComplexTypeValue);
|
|
Reader.ReadListEnd;
|
|
end;
|
|
|
|
type
|
|
TWriter2 = class(TWriter)
|
|
private
|
|
protected
|
|
public
|
|
procedure WriteProperties2(Instance: TPersistent);
|
|
end;
|
|
|
|
procedure TWriter2.WriteProperties2(Instance: TPersistent);
|
|
begin
|
|
WriteProperties(Instance);
|
|
end;
|
|
|
|
procedure TRORequestParam.WriteComplexTypeValue(Writer: TWriter);
|
|
begin
|
|
Assert(Assigned(fComplexTypeValue));
|
|
|
|
Writer.WriteListBegin;
|
|
TWriter2(Writer).WriteProperties2(fComplexTypeValue);
|
|
Writer.WriteListEnd;
|
|
end;
|
|
|
|
procedure TRORequestParam.ReadSimpleValue(Reader: TReader);
|
|
begin
|
|
{$IFDEF FPC}
|
|
FPC_ReadVariant(Reader);
|
|
{$ELSE}
|
|
fSimpleValue := Reader.ReadVariant;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TRORequestParam.WriteSimpleValue(Writer: TWriter);
|
|
begin
|
|
{$IFDEF FPC}
|
|
FPC_WriteVariant(Writer);
|
|
{$ELSE}
|
|
Writer.WriteVariant(fSimpleValue);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
procedure TRORequestParam.FPC_ReadVariant(Reader: TReader);
|
|
begin
|
|
VarClear(fSimpleValue);
|
|
case Reader.NextValue of
|
|
vaNil, vaNull:
|
|
if Reader.ReadValue <> vaNil then
|
|
fSimpleValue := Variants.Null;
|
|
vaInt8: fSimpleValue := Shortint(Reader.ReadInteger);
|
|
vaInt16: fSimpleValue := Smallint(Reader.ReadInteger);
|
|
vaInt32: fSimpleValue := Reader.ReadInteger;
|
|
vaExtended: fSimpleValue := Reader.ReadFloat;
|
|
vaSingle: fSimpleValue := Reader.ReadSingle;
|
|
vaCurrency: fSimpleValue := Reader.ReadCurrency;
|
|
vaDate: fSimpleValue := Reader.ReadDate;
|
|
vaString, vaLString: fSimpleValue := Reader.ReadString;
|
|
vaWString,
|
|
vaUTF8String: fSimpleValue := Reader.ReadWideString;
|
|
vaFalse, vaTrue: fSimpleValue := (Reader.ReadValue = vaTrue);
|
|
vaInt64: fSimpleValue := Reader.ReadInt64;
|
|
else
|
|
raise Exception.Create('Error reading ...');
|
|
end;
|
|
end;
|
|
|
|
procedure TRORequestParam.FPC_WriteVariant(Writer: TWriter);
|
|
var
|
|
CustomType: TCustomVariantType;
|
|
OuterStream, InnerStream: TMemoryStream;
|
|
OuterWriter: TWriter;
|
|
StreamSize: Integer;
|
|
LInt64: Int64;
|
|
begin
|
|
if VarIsArray(fSimpleValue) then
|
|
raise Exception.Create('Error writing ...');
|
|
case VarType(fSimpleValue) and varTypeMask of
|
|
{varEmpty:
|
|
Writer.WriteValue(vaNil);
|
|
varNull:
|
|
Writer.WriteValue(vaNull);}
|
|
varOleStr:
|
|
Writer.WriteWideString(fSimpleValue);
|
|
varString:
|
|
Writer.WriteString(fSimpleValue);
|
|
varByte, varShortInt, varWord, varSmallInt, varInteger:
|
|
Writer.WriteInteger(TVarData(fSimpleValue).vInteger);
|
|
varSingle:
|
|
Writer.WriteSingle(TVarData(fSimpleValue).vSingle);
|
|
varDouble:
|
|
Writer.WriteFloat(TVarData(fSimpleValue).vDouble);
|
|
varCurrency:
|
|
Writer.WriteCurrency(fSimpleValue);
|
|
varDate:
|
|
Writer.WriteDate(fSimpleValue);
|
|
varBoolean:
|
|
begin
|
|
if fSimpleValue then
|
|
Writer.WriteBoolean(True)
|
|
else
|
|
Writer.WriteBoolean(False);
|
|
{ varLongWord, varInt64:
|
|
begin
|
|
LInt64 := fSimpleValue;
|
|
WriteInteger(LInt64);
|
|
end; }
|
|
end;
|
|
else
|
|
raise Exception.Create('Error writing ...');
|
|
end;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
procedure TRODynamicRequest.MethodNameChanged;
|
|
begin
|
|
end;
|
|
|
|
procedure TRODynamicRequest.CheckProperties;
|
|
begin
|
|
Check(RemoteService = nil, Name + '.RemoteService must be assigned.');
|
|
RemoteService.CheckProperties;
|
|
Check(MethodName = '', Name + '.MethodName must be set.');
|
|
end;
|
|
|
|
end.
|