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.