Serialiers : exceptions are no longer used internally to signal missing optional properties.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@875 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2009-06-29 01:57:44 +00:00
parent 20eecc5ecc
commit 73d1b45eb8
8 changed files with 1129 additions and 796 deletions

View File

@ -303,76 +303,79 @@ type
const AData : Pointer const AData : Pointer
);{$IFDEF USE_INLINE}inline;{$ENDIF} );{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetDataBuffer(var AName : String):PDataBuffer;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetDataBuffer(
procedure GetEnum( var AName : string;
out AResultBuffer : PDataBuffer
) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetEnum(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : TEnumData Var AData : TEnumData
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetBool( function GetBool(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : Boolean Var AData : Boolean
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetAnsiChar( function GetAnsiChar(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : AnsiChar Var AData : AnsiChar
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetWideChar( function GetWideChar(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : WideChar Var AData : WideChar
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetFloat( function GetFloat(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : TFloat_Extended_10 Var AData : TFloat_Extended_10
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetInt( function GetInt(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : TInt64S Var AData : TInt64S
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetInt64( function GetInt64(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : Int64 Var AData : Int64
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
procedure GetUInt64( function GetUInt64(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : QWord Var AData : QWord
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF} {$ENDIF}
procedure GetAnsiStr( function GetAnsiStr(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : AnsiString Var AData : AnsiString
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetWideStr( function GetWideStr(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : WideString var AData : WideString
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
procedure GetUnicodeStr( function GetUnicodeStr(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : UnicodeString var AData : UnicodeString
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
procedure GetObj( function GetObj(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : TObject Var AData : TObject
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetRecord( function GetRecord(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : Pointer var AData : Pointer
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
public public
constructor Create();override; constructor Create();override;
destructor Destroy();override; destructor Destroy();override;
@ -429,22 +432,22 @@ type
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const AData const AData
); );
procedure Get( function Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : string; var AName : string;
var AData var AData
);overload; ) : Boolean;overload;
procedure Get( function Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
var AName : string; var AName : string;
var AData var AData
);overload; ) : Boolean; overload;
procedure GetScopeInnerValue( procedure GetScopeInnerValue(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AData var AData
); );
function ReadBuffer(const AName : string) : string; function ReadBuffer(const AName : string; out AResBuffer : string) : Boolean;
procedure WriteBuffer(const AValue : string); procedure WriteBuffer(const AValue : string);
procedure SaveToStream(AStream : TStream); procedure SaveToStream(AStream : TStream);
@ -1162,154 +1165,200 @@ begin
TRemotableRecordEncoder.Save(AData,Self,AName,ATypeInfo); TRemotableRecordEncoder.Save(AData,Self,AName,ATypeInfo);
end; end;
function TBaseBinaryFormatter.GetDataBuffer(var AName: String): PDataBuffer; function TBaseBinaryFormatter.GetDataBuffer(
var AName: string;
out AResultBuffer : PDataBuffer
) : Boolean;
begin begin
Result := StackTop().Find(AName); AResultBuffer := StackTop().Find(AName);
If Not Assigned(Result) Then Result := ( AResultBuffer <> nil );
Error('Param not found : "%s"',[AName]);
end; end;
procedure TBaseBinaryFormatter.GetEnum( function TBaseBinaryFormatter.GetEnum(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: TEnumData var AData: TEnumData
); ) : Boolean;
var
locBuffer : PDataBuffer;
begin begin
AData := GetDataBuffer(AName)^.EnumData; Result := GetDataBuffer(AName,locBuffer);
if Result then
AData := locBuffer^.EnumData;
end; end;
procedure TBaseBinaryFormatter.GetBool( function TBaseBinaryFormatter.GetBool(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: Boolean var AData: Boolean
); ) : Boolean;
var
locBuffer : PDataBuffer;
begin begin
AData := GetDataBuffer(AName)^.BoolData; Result := GetDataBuffer(AName,locBuffer);
if Result then
AData := locBuffer^.BoolData;
end; end;
procedure TBaseBinaryFormatter.GetAnsiChar( function TBaseBinaryFormatter.GetAnsiChar(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: AnsiChar var AData: AnsiChar
); ) : Boolean;
var
locBuffer : PDataBuffer;
begin begin
AData := GetDataBuffer(AName)^.AnsiCharData; Result := GetDataBuffer(AName,locBuffer);
if Result then
AData := locBuffer^.AnsiCharData;
end; end;
procedure TBaseBinaryFormatter.GetWideChar( function TBaseBinaryFormatter.GetWideChar(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: WideChar var AData: WideChar
); ) : Boolean;
var
locBuffer : PDataBuffer;
begin begin
AData := GetDataBuffer(AName)^.WideCharData; Result := GetDataBuffer(AName,locBuffer);
if Result then
AData := locBuffer^.WideCharData;
end; end;
procedure TBaseBinaryFormatter.GetFloat( function TBaseBinaryFormatter.GetFloat(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : TFloat_Extended_10 var AData : TFloat_Extended_10
); ) : Boolean;
Var var
t : PDataBuffer; locBuffer : PDataBuffer;
begin begin
t := GetDataBuffer(AName); Result := GetDataBuffer(AName,locBuffer);
Case GetTypeData(ATypeInfo)^.FloatType Of if Result then begin
ftSingle : AData := t^.SingleData; case GetTypeData(ATypeInfo)^.FloatType Of
ftDouble : AData := t^.DoubleData; ftSingle : AData := locBuffer^.SingleData;
ftExtended : AData := t^.ExtendedData; ftDouble : AData := locBuffer^.DoubleData;
ftCurr : AData := t^.CurrencyData; ftExtended : AData := locBuffer^.ExtendedData;
Else ftCurr : AData := locBuffer^.CurrencyData;
AData := t^.ExtendedData; else
End; AData := locBuffer^.ExtendedData;
end;
end;
end; end;
procedure TBaseBinaryFormatter.GetInt( function TBaseBinaryFormatter.GetInt(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: TInt64S var AData: TInt64S
); ) : Boolean;
Var var
t : PDataBuffer; locBuffer : PDataBuffer;
begin begin
t := GetDataBuffer(AName); Result := GetDataBuffer(AName,locBuffer);
Case GetTypeData(ATypeInfo)^.OrdType Of if Result then begin
otSByte : AData := t^.Int8S; case GetTypeData(ATypeInfo)^.OrdType of
otUByte : AData := t^.Int8U; otSByte : AData := locBuffer^.Int8S;
otSWord : AData := t^.Int16S; otUByte : AData := locBuffer^.Int8U;
otUWord : AData := t^.Int16U; otSWord : AData := locBuffer^.Int16S;
otSLong : AData := t^.Int32S; otUWord : AData := locBuffer^.Int16U;
otULong : AData := t^.Int32U; otSLong : AData := locBuffer^.Int32S;
Else otULong : AData := locBuffer^.Int32U;
Assert(False); Else
End; Assert(False);
end;
end;
end; end;
procedure TBaseBinaryFormatter.GetInt64( function TBaseBinaryFormatter.GetInt64(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: Int64 var AData: Int64
); ) : Boolean;
var
locBuffer : PDataBuffer;
begin begin
AData := GetDataBuffer(AName)^.Int64S; Result := GetDataBuffer(AName,locBuffer);
if Result then
AData := locBuffer^.Int64S;
end; end;
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
procedure TBaseBinaryFormatter.GetUInt64( function TBaseBinaryFormatter.GetUInt64(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: QWord var AData: QWord
); ) : Boolean;
var
locBuffer : PDataBuffer;
begin begin
AData := GetDataBuffer(AName)^.Int64U; Result := GetDataBuffer(AName,locBuffer);
if Result then
AData := locBuffer^.Int64U;
end; end;
{$ENDIF HAS_QWORD} {$ENDIF HAS_QWORD}
procedure TBaseBinaryFormatter.GetAnsiStr( function TBaseBinaryFormatter.GetAnsiStr(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: AnsiString var AData: AnsiString
); ) : Boolean;
var
locBuffer : PDataBuffer;
begin begin
AData := GetDataBuffer(AName)^.AnsiStrData^.Data; Result := GetDataBuffer(AName,locBuffer);
if Result then
AData := locBuffer^.AnsiStrData^.Data;
end; end;
procedure TBaseBinaryFormatter.GetWideStr( function TBaseBinaryFormatter.GetWideStr(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: WideString var AData: WideString
); ) : Boolean;
var
locBuffer : PDataBuffer;
begin begin
AData := GetDataBuffer(AName)^.WideStrData^.Data; Result := GetDataBuffer(AName,locBuffer);
if Result then
AData := locBuffer^.WideStrData^.Data;
end; end;
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
procedure TBaseBinaryFormatter.GetUnicodeStr( function TBaseBinaryFormatter.GetUnicodeStr(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: UnicodeString var AData: UnicodeString
); ) : Boolean;
var
locBuffer : PDataBuffer;
begin begin
AData := GetDataBuffer(AName)^.UnicodeStrData^.Data; Result := GetDataBuffer(AName,locBuffer);
if Result then
AData := locBuffer^.UnicodeStrData^.Data;
end; end;
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
procedure TBaseBinaryFormatter.GetObj( function TBaseBinaryFormatter.GetObj(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: TObject var AData: TObject
); ) : Boolean;
begin begin
{ TODO -cEXCEPTION_SAFE : Load() should be a function ! }
TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Load(AData, Self,AName,ATypeInfo); TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Load(AData, Self,AName,ATypeInfo);
Result := True;
end; end;
procedure TBaseBinaryFormatter.GetRecord( function TBaseBinaryFormatter.GetRecord(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : Pointer var AData : Pointer
); ) : Boolean;
begin begin
{ TODO -cEXCEPTION_SAFE : Load() should be a function ! }
TRemotableRecordEncoder.Load(AData, Self,AName,ATypeInfo); TRemotableRecordEncoder.Load(AData, Self,AName,ATypeInfo);
Result := True;
end; end;
procedure TBaseBinaryFormatter.Clear(); procedure TBaseBinaryFormatter.Clear();
@ -1731,11 +1780,11 @@ begin
end; end;
end; end;
procedure TBaseBinaryFormatter.Get( function TBaseBinaryFormatter.Get(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData var AData
); ) : Boolean;
Var Var
int64Data : Int64; int64Data : Int64;
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
@ -1758,67 +1807,76 @@ begin
tkInt64 : tkInt64 :
Begin Begin
int64Data := 0; int64Data := 0;
GetInt64(ATypeInfo,AName,int64Data); Result := GetInt64(ATypeInfo,AName,int64Data);
Int64(AData) := int64Data; if Result then
Int64(AData) := int64Data;
End; End;
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
tkQWord : tkQWord :
Begin Begin
uint64Data := 0; uint64Data := 0;
GetUInt64(ATypeInfo,AName,uint64Data); Result := GetUInt64(ATypeInfo,AName,uint64Data);
QWord(AData) := uint64Data; if Result then
QWord(AData) := uint64Data;
End; End;
{$ENDIF HAS_QWORD} {$ENDIF HAS_QWORD}
tkLString{$IFDEF FPC},tkAString{$ENDIF} : tkLString{$IFDEF FPC},tkAString{$ENDIF} :
Begin Begin
strData := ''; strData := '';
GetAnsiStr(ATypeInfo,AName,strData); Result := GetAnsiStr(ATypeInfo,AName,strData);
String(AData) := strData; if Result then
String(AData) := strData;
End; End;
tkWString : tkWString :
begin begin
wideStrData := ''; wideStrData := '';
GetWideStr(ATypeInfo,AName,wideStrData); Result := GetWideStr(ATypeInfo,AName,wideStrData);
WideString(AData) := wideStrData; if Result then
WideString(AData) := wideStrData;
end; end;
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
tkUString : tkUString :
begin begin
unicodeStrData := ''; unicodeStrData := '';
GetUnicodeStr(ATypeInfo,AName,unicodeStrData); Result := GetUnicodeStr(ATypeInfo,AName,unicodeStrData);
UnicodeString(AData) := unicodeStrData; if Result then
UnicodeString(AData) := unicodeStrData;
end; end;
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
tkClass : tkClass :
Begin Begin
objData := TObject(AData); objData := TObject(AData);
GetObj(ATypeInfo,AName,objData); Result := GetObj(ATypeInfo,AName,objData);
TObject(AData) := objData; if Result then
TObject(AData) := objData;
End; End;
tkRecord : tkRecord :
begin begin
recObject := Pointer(@AData); recObject := Pointer(@AData);
GetRecord(ATypeInfo,AName,recObject); Result := GetRecord(ATypeInfo,AName,recObject);
end; end;
{$IFDEF FPC} {$IFDEF FPC}
tkBool : tkBool :
Begin Begin
boolData := False; boolData := False;
GetBool(ATypeInfo,AName,boolData); Result := GetBool(ATypeInfo,AName,boolData);
Boolean(AData) := boolData; if Result then
Boolean(AData) := boolData;
End; End;
{$ENDIF} {$ENDIF}
tkChar : tkChar :
begin begin
ansiCharData := #0; ansiCharData := #0;
GetAnsiChar(ATypeInfo,AName,ansiCharData); Result := GetAnsiChar(ATypeInfo,AName,ansiCharData);
AnsiChar(AData) := ansiCharData; if Result then
AnsiChar(AData) := ansiCharData;
end; end;
tkWChar : tkWChar :
begin begin
wideCharData := #0; wideCharData := #0;
GetWideChar(ATypeInfo,AName,wideCharData); Result := GetWideChar(ATypeInfo,AName,wideCharData);
WideChar(AData) := wideCharData; if Result then
WideChar(AData) := wideCharData;
end; end;
tkInteger, tkEnumeration : tkInteger, tkEnumeration :
Begin Begin
@ -1827,23 +1885,26 @@ begin
( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) ) ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) )
then begin then begin
boolData := False; boolData := False;
GetBool(ATypeInfo,AName,boolData); Result := GetBool(ATypeInfo,AName,boolData);
Boolean(AData) := boolData; if Result then
Boolean(AData) := boolData;
end else begin end else begin
{$ENDIF} {$ENDIF}
enumData := 0; enumData := 0;
If ( ATypeInfo^.Kind = tkInteger ) Then If ( ATypeInfo^.Kind = tkInteger ) Then
GetInt(ATypeInfo,AName,enumData) Result := GetInt(ATypeInfo,AName,enumData)
Else Else
GetEnum(ATypeInfo,AName,enumData); Result := GetEnum(ATypeInfo,AName,enumData);
Case GetTypeData(ATypeInfo)^.OrdType Of if Result then begin
otSByte : ShortInt(AData) := enumData; Case GetTypeData(ATypeInfo)^.OrdType Of
otUByte : Byte(AData) := enumData; otSByte : ShortInt(AData) := enumData;
otSWord : SmallInt(AData) := enumData; otUByte : Byte(AData) := enumData;
otUWord : Word(AData) := enumData; otSWord : SmallInt(AData) := enumData;
otSLong : LongInt(AData) := enumData; otUWord : Word(AData) := enumData;
otULong : LongWord(AData) := enumData; otSLong : LongInt(AData) := enumData;
End; otULong : LongWord(AData) := enumData;
End;
end;
{$IFNDEF FPC} {$IFNDEF FPC}
end; end;
{$ENDIF} {$ENDIF}
@ -1851,28 +1912,32 @@ begin
tkFloat : tkFloat :
Begin Begin
floatDt := 0; floatDt := 0;
GetFloat(ATypeInfo,AName,floatDt); Result := GetFloat(ATypeInfo,AName,floatDt);
Case GetTypeData(ATypeInfo)^.FloatType Of if Result then begin
ftSingle : Single(AData) := floatDt; Case GetTypeData(ATypeInfo)^.FloatType Of
ftDouble : Double(AData) := floatDt; ftSingle : Single(AData) := floatDt;
ftExtended : Extended(AData) := floatDt; ftDouble : Double(AData) := floatDt;
ftCurr : Currency(AData) := floatDt; ftExtended : Extended(AData) := floatDt;
ftCurr : Currency(AData) := floatDt;
{$IFDEF HAS_COMP} {$IFDEF HAS_COMP}
ftComp : Comp(AData) := floatDt; ftComp : Comp(AData) := floatDt;
{$ENDIF} {$ENDIF}
End; End;
End; end
End; end;
else
Result := False;
end;
end; end;
procedure TBaseBinaryFormatter.Get( function TBaseBinaryFormatter.Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
var AName : string; var AName : string;
var AData var AData
); ) : Boolean;
begin begin
Get(ATypeInfo,AName,AData); Result := Get(ATypeInfo,AName,AData);
end; end;
procedure TBaseBinaryFormatter.GetScopeInnerValue( procedure TBaseBinaryFormatter.GetScopeInnerValue(
@ -1953,7 +2018,7 @@ begin
end; end;
end; end;
function TBaseBinaryFormatter.ReadBuffer (const AName : string ) : string; function TBaseBinaryFormatter.ReadBuffer (const AName : string; out AResBuffer : string) : Boolean;
Var Var
locStore : IDataStore; locStore : IDataStore;
bffr : PDataBuffer; bffr : PDataBuffer;
@ -1961,14 +2026,16 @@ Var
locStream : TStringStream; locStream : TStringStream;
begin begin
locName := AName; locName := AName;
bffr := GetDataBuffer(locName); Result := GetDataBuffer(locName,bffr);
locStream := TStringStream.Create(''); if Result then begin
try locStream := TStringStream.Create('');
locStore := CreateBinaryWriter(locStream); try
SaveObjectToStream(bffr,locStore); locStore := CreateBinaryWriter(locStream);
Result := locStream.DataString; SaveObjectToStream(bffr,locStore);
finally AResBuffer := locStream.DataString;
locStream.Free(); finally
locStream.Free();
end;
end; end;
end; end;

View File

@ -269,78 +269,81 @@ type
const AData : Pointer const AData : Pointer
);{$IFDEF USE_INLINE}inline;{$ENDIF} );{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetDataBuffer(var AName : String):TJSONData;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetDataBuffer(
procedure GetEnum( var AName : string;
out AResBuffer : TJSONData
) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetEnum(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : TEnumIntType Var AData : TEnumIntType
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetBool( function GetBool(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : Boolean Var AData : Boolean
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF FPC} {$IFDEF FPC}
procedure GetAnsiChar( function GetAnsiChar(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : AnsiChar Var AData : AnsiChar
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetWideChar( function GetWideChar(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : WideChar Var AData : WideChar
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetInt( function GetInt(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : Integer Var AData : Integer
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF} {$ENDIF}
procedure GetInt64( function GetInt64(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : Int64 Var AData : Int64
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
procedure GetUInt64( function GetUInt64(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : QWord Var AData : QWord
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF HAS_QWORD} {$ENDIF HAS_QWORD}
procedure GetFloat( function GetFloat(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : Extended Var AData : Extended
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetStr( function GetStr(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : String Var AData : String
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
procedure GetUnicodeStr( function GetUnicodeStr(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : UnicodeString Var AData : UnicodeString
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
procedure GetWideStr( function GetWideStr(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : WideString Var AData : WideString
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetObj( function GetObj(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : TObject Var AData : TObject
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetRecord( function GetRecord(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : Pointer var AData : Pointer
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
public public
procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle); procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle);
function GetSerializationStyle():TSerializationStyle; function GetSerializationStyle():TSerializationStyle;
@ -395,22 +398,22 @@ type
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const AData const AData
); );
procedure Get( function Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : string; var AName : string;
var AData var AData
);overload; ) : Boolean;overload;
procedure Get( function Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
var AName : string; var AName : string;
var AData var AData
);overload; ) : Boolean;overload;
procedure GetScopeInnerValue( procedure GetScopeInnerValue(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AData var AData
); );
function ReadBuffer(const AName : string) : string; function ReadBuffer(const AName : string; out AResBuffer : string) : Boolean;
procedure WriteBuffer(const AValue : string); procedure WriteBuffer(const AValue : string);
procedure SaveToStream(AStream : TStream); procedure SaveToStream(AStream : TStream);
@ -593,167 +596,213 @@ begin
TRemotableRecordEncoder.Save(AData,Self,AName,ATypeInfo); TRemotableRecordEncoder.Save(AData,Self,AName,ATypeInfo);
end; end;
function TJsonRpcBaseFormatter.GetDataBuffer(var AName : String) : TJSONData; function TJsonRpcBaseFormatter.GetDataBuffer(
var AName : string;
out AResBuffer : TJSONData
) : Boolean;
begin begin
Result := StackTop().FindNode(AName); AResBuffer := StackTop().FindNode(AName);
if not Assigned(Result) then Result := ( AResBuffer <> nil );
Error('Param not found : "%s"',[AName]);
end; end;
procedure TJsonRpcBaseFormatter.GetEnum( function TJsonRpcBaseFormatter.GetEnum(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : TEnumIntType var AData : TEnumIntType
); ) : Boolean;
begin
AData := GetDataBuffer(AName).AsInteger;
end;
procedure TJsonRpcBaseFormatter.GetBool(
const ATypeInfo : PTypeInfo;
var AName : String;
var AData : Boolean
);
begin
AData := GetDataBuffer(AName).AsBoolean;
end;
procedure TJsonRpcBaseFormatter.GetAnsiChar(
const ATypeInfo: PTypeInfo;
var AName: String;
var AData: AnsiChar
);
var
tmpString : TJSONStringType;
begin
tmpString := GetDataBuffer(AName).AsString;
if ( Length(tmpString) > 0 ) then
AData := tmpString[1]
else
AData := #0;
end;
procedure TJsonRpcBaseFormatter.GetWideChar(
const ATypeInfo: PTypeInfo;
var AName: String;
var AData: WideChar
);
var
tmpString : TJSONStringType;
begin
tmpString := GetDataBuffer(AName).AsString;
if ( Length(tmpString) > 0 ) then
AData := tmpString[1]
else
AData := #0;
end;
procedure TJsonRpcBaseFormatter.GetInt(
const ATypeInfo : PTypeInfo;
var AName : String;
var AData : Integer
);
begin
AData := GetDataBuffer(AName).AsInteger;
end;
procedure TJsonRpcBaseFormatter.GetInt64(
const ATypeInfo : PTypeInfo;
var AName : String;
var AData : Int64
);
var var
locBuffer : TJSONData; locBuffer : TJSONData;
begin begin
locBuffer := GetDataBuffer(AName); Result := GetDataBuffer(AName,locBuffer);
if ( locBuffer.JSONType = jtNumber ) and ( TJSONNumber(locBuffer).NumberType = ntInteger ) then if Result then
AData := locBuffer.AsInteger AData := locBuffer.AsInteger;
else end;
AData := Round(locBuffer.AsFloat);
function TJsonRpcBaseFormatter.GetBool(
const ATypeInfo : PTypeInfo;
var AName : String;
var AData : Boolean
) : Boolean;
var
locBuffer : TJSONData;
begin
Result := GetDataBuffer(AName,locBuffer);
if Result then
AData := locBuffer.AsBoolean;
end;
function TJsonRpcBaseFormatter.GetAnsiChar(
const ATypeInfo: PTypeInfo;
var AName: String;
var AData: AnsiChar
) : Boolean;
var
tmpString : TJSONStringType;
locBuffer : TJSONData;
begin
Result := GetDataBuffer(AName,locBuffer);
if Result then begin
tmpString := locBuffer.AsString;
if ( Length(tmpString) > 0 ) then
AData := tmpString[1]
else
AData := #0;
end;
end;
function TJsonRpcBaseFormatter.GetWideChar(
const ATypeInfo: PTypeInfo;
var AName: String;
var AData: WideChar
) : Boolean;
var
tmpString : TJSONStringType;
locBuffer : TJSONData;
begin
Result := GetDataBuffer(AName,locBuffer);
if Result then begin
tmpString := locBuffer.AsString;
if ( Length(tmpString) > 0 ) then
AData := tmpString[1]
else
AData := #0;
end;
end;
function TJsonRpcBaseFormatter.GetInt(
const ATypeInfo : PTypeInfo;
var AName : String;
var AData : Integer
) : Boolean;
var
locBuffer : TJSONData;
begin
Result := GetDataBuffer(AName,locBuffer);
if Result then
AData := locBuffer.AsInteger;
end;
function TJsonRpcBaseFormatter.GetInt64(
const ATypeInfo : PTypeInfo;
var AName : String;
var AData : Int64
) : Boolean;
var
locBuffer : TJSONData;
begin
Result := GetDataBuffer(AName,locBuffer);
if Result then begin
if ( locBuffer.JSONType = jtNumber ) and ( TJSONNumber(locBuffer).NumberType = ntInteger ) then
AData := locBuffer.AsInteger
else
AData := Round(locBuffer.AsFloat);
end;
end; end;
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
procedure TJsonRpcBaseFormatter.GetUInt64( function TJsonRpcBaseFormatter.GetUInt64(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : QWord var AData : QWord
); ) : Boolean;
var var
locBuffer : TJSONData; locBuffer : TJSONData;
locExtData : TJSONFloat; locExtData : TJSONFloat;
tmp : QWord; tmp : QWord;
begin begin
locBuffer := GetDataBuffer(AName); Result := GetDataBuffer(AName,locBuffer);
if ( locBuffer.JSONType = jtNumber ) and ( TJSONNumber(locBuffer).NumberType = ntInteger ) then begin if Result then begin
AData := locBuffer.AsInteger if ( locBuffer.JSONType = jtNumber ) and ( TJSONNumber(locBuffer).NumberType = ntInteger ) then begin
end else begin AData := locBuffer.AsInteger
locExtData := locBuffer.AsFloat;
if ( locExtData > High(Int64) ) then begin
locExtData := locExtData - High(Int64);
AData := High(Int64);
tmp := Round(locExtData);
AData := AData + tmp;
end else begin end else begin
AData := Round(locExtData); locExtData := locBuffer.AsFloat;
if ( locExtData > High(Int64) ) then begin
locExtData := locExtData - High(Int64);
AData := High(Int64);
tmp := Round(locExtData);
AData := AData + tmp;
end else begin
AData := Round(locExtData);
end;
end; end;
end; end;
end; end;
{$ENDIF HAS_QWORD} {$ENDIF HAS_QWORD}
procedure TJsonRpcBaseFormatter.GetFloat( function TJsonRpcBaseFormatter.GetFloat(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : Extended var AData : Extended
); ) : Boolean;
var
locBuffer : TJSONData;
begin begin
AData := GetDataBuffer(AName).AsFloat; Result := GetDataBuffer(AName,locBuffer);
if Result then
AData := locBuffer.AsFloat;
end; end;
procedure TJsonRpcBaseFormatter.GetStr( function TJsonRpcBaseFormatter.GetStr(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : String var AData : String
); ) : Boolean;
var
locBuffer : TJSONData;
begin begin
AData := GetDataBuffer(AName).AsString; Result := GetDataBuffer(AName,locBuffer);
if Result then
AData := locBuffer.AsString;
end; end;
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
procedure TJsonRpcBaseFormatter.GetUnicodeStr( function TJsonRpcBaseFormatter.GetUnicodeStr(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: UnicodeString var AData: UnicodeString
); ) : Boolean;
var
locBuffer : TJSONData;
begin begin
AData := GetDataBuffer(AName).AsString; Result := GetDataBuffer(AName,locBuffer);
if Result then
AData := locBuffer.AsString;
end; end;
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
procedure TJsonRpcBaseFormatter.GetWideStr( function TJsonRpcBaseFormatter.GetWideStr(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: WideString var AData: WideString
); ) : Boolean;
var
locBuffer : TJSONData;
begin begin
AData := GetDataBuffer(AName).AsString; Result := GetDataBuffer(AName,locBuffer);
if Result then
AData := locBuffer.AsString;
end; end;
procedure TJsonRpcBaseFormatter.GetObj( function TJsonRpcBaseFormatter.GetObj(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : TObject var AData : TObject
); ) : Boolean;
begin begin
{ TODO -cEXCEPTION_SAFE : Load() should be a function ! }
TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Load(AData, Self,AName,ATypeInfo); TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Load(AData, Self,AName,ATypeInfo);
Result := True;
end; end;
procedure TJsonRpcBaseFormatter.GetRecord( function TJsonRpcBaseFormatter.GetRecord(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : Pointer var AData : Pointer
); ) : Boolean;
begin begin
{ TODO -cEXCEPTION_SAFE : Load() should be a function ! }
TRemotableRecordEncoder.Load(AData, Self,AName,ATypeInfo); TRemotableRecordEncoder.Load(AData, Self,AName,ATypeInfo);
Result := True;
end; end;
procedure TJsonRpcBaseFormatter.SetSerializationStyle(const ASerializationStyle : TSerializationStyle); procedure TJsonRpcBaseFormatter.SetSerializationStyle(const ASerializationStyle : TSerializationStyle);
@ -1168,11 +1217,11 @@ begin
End; End;
end; end;
procedure TJsonRpcBaseFormatter.Get( function TJsonRpcBaseFormatter.Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData var AData
); ) : Boolean;
Var Var
int64Data : Int64; int64Data : Int64;
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
@ -1195,66 +1244,75 @@ begin
tkChar : tkChar :
begin begin
ansiCharData := #0; ansiCharData := #0;
GetAnsiChar(ATypeInfo,AName,ansiCharData); Result := GetAnsiChar(ATypeInfo,AName,ansiCharData);
AnsiChar(AData) := ansiCharData; if Result then
AnsiChar(AData) := ansiCharData;
end; end;
tkWChar : tkWChar :
begin begin
wideCharData := #0; wideCharData := #0;
GetWideChar(ATypeInfo,AName,wideCharData); Result := GetWideChar(ATypeInfo,AName,wideCharData);
WideChar(AData) := wideCharData; if Result then
WideChar(AData) := wideCharData;
end; end;
tkInt64 : tkInt64 :
Begin Begin
int64Data := 0; int64Data := 0;
GetInt64(ATypeInfo,AName,int64Data); Result := GetInt64(ATypeInfo,AName,int64Data);
Int64(AData) := int64Data; if Result then
Int64(AData) := int64Data;
End; End;
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
tkQWord : tkQWord :
Begin Begin
uint64Data := 0; uint64Data := 0;
GetUInt64(ATypeInfo,AName,uint64Data); Result := GetUInt64(ATypeInfo,AName,uint64Data);
QWord(AData) := uint64Data; if Result then
QWord(AData) := uint64Data;
End; End;
{$ENDIF HAS_QWORD} {$ENDIF HAS_QWORD}
tkLString{$IFDEF FPC},tkAString{$ENDIF} : tkLString{$IFDEF FPC},tkAString{$ENDIF} :
Begin Begin
strData := ''; strData := '';
GetStr(ATypeInfo,AName,strData); Result := GetStr(ATypeInfo,AName,strData);
String(AData) := strData; if Result then
String(AData) := strData;
End; End;
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
tkUString : tkUString :
Begin Begin
unicodeStrData := ''; unicodeStrData := '';
GetUnicodeStr(ATypeInfo,AName,unicodeStrData); Result := GetUnicodeStr(ATypeInfo,AName,unicodeStrData);
UnicodeString(AData) := unicodeStrData; if Result then
UnicodeString(AData) := unicodeStrData;
End; End;
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
tkWString : tkWString :
Begin Begin
WideStrData := ''; WideStrData := '';
GetWideStr(ATypeInfo,AName,WideStrData); Result := GetWideStr(ATypeInfo,AName,WideStrData);
WideString(AData) := WideStrData; if Result then
WideString(AData) := WideStrData;
End; End;
tkClass : tkClass :
Begin Begin
objData := TObject(AData); objData := TObject(AData);
GetObj(ATypeInfo,AName,objData); Result := GetObj(ATypeInfo,AName,objData);
TObject(AData) := objData; if Result then
TObject(AData) := objData;
End; End;
tkRecord : tkRecord :
begin begin
recObject := Pointer(@AData); recObject := Pointer(@AData);
GetRecord(ATypeInfo,AName,recObject); Result := GetRecord(ATypeInfo,AName,recObject);
end; end;
{$IFDEF FPC} {$IFDEF FPC}
tkBool : tkBool :
Begin Begin
boolData := False; boolData := False;
GetBool(ATypeInfo,AName,boolData); Result := GetBool(ATypeInfo,AName,boolData);
Boolean(AData) := boolData; if Result then
Boolean(AData) := boolData;
End; End;
{$ENDIF} {$ENDIF}
tkInteger, tkEnumeration : tkInteger, tkEnumeration :
@ -1264,23 +1322,26 @@ begin
( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) ) ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) )
then begin then begin
boolData := False; boolData := False;
GetBool(ATypeInfo,AName,boolData); Result := GetBool(ATypeInfo,AName,boolData);
Boolean(AData) := boolData; if Result then
Boolean(AData) := boolData;
end else begin end else begin
{$ENDIF} {$ENDIF}
enumData := 0; enumData := 0;
If ( ATypeInfo^.Kind = tkInteger ) Then if ( ATypeInfo^.Kind = tkInteger ) then
GetInt64(ATypeInfo,AName,enumData) Result := GetInt64(ATypeInfo,AName,enumData)
Else else
GetEnum(ATypeInfo,AName,enumData); Result := GetEnum(ATypeInfo,AName,enumData);
Case GetTypeData(ATypeInfo)^.OrdType Of if Result then begin
otSByte : ShortInt(AData) := enumData; case GetTypeData(ATypeInfo)^.OrdType of
otUByte : Byte(AData) := enumData; otSByte : ShortInt(AData) := enumData;
otSWord : SmallInt(AData) := enumData; otUByte : Byte(AData) := enumData;
otUWord : Word(AData) := enumData; otSWord : SmallInt(AData) := enumData;
otSLong : LongInt(AData) := enumData; otUWord : Word(AData) := enumData;
otULong : LongWord(AData) := enumData; otSLong : LongInt(AData) := enumData;
End; otULong : LongWord(AData) := enumData;
end;
end;
{$IFDEF WST_DELPHI} {$IFDEF WST_DELPHI}
end; end;
{$ENDIF} {$ENDIF}
@ -1288,28 +1349,30 @@ begin
tkFloat : tkFloat :
Begin Begin
floatDt := 0; floatDt := 0;
GetFloat(ATypeInfo,AName,floatDt); Result := GetFloat(ATypeInfo,AName,floatDt);
Case GetTypeData(ATypeInfo)^.FloatType Of if Result then begin
ftSingle : Single(AData) := floatDt; case GetTypeData(ATypeInfo)^.FloatType of
ftDouble : Double(AData) := floatDt; ftSingle : Single(AData) := floatDt;
ftExtended : Extended(AData) := floatDt; ftDouble : Double(AData) := floatDt;
ftCurr : Currency(AData) := floatDt; ftExtended : Extended(AData) := floatDt;
ftCurr : Currency(AData) := floatDt;
{$IFDEF HAS_COMP} {$IFDEF HAS_COMP}
ftComp : Comp(AData) := floatDt; ftComp : Comp(AData) := floatDt;
{$ENDIF} {$ENDIF}
End; end;
end;
End; End;
End; End;
end; end;
procedure TJsonRpcBaseFormatter.Get( function TJsonRpcBaseFormatter.Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
var AName : string; var AName : string;
var AData var AData
); ) : Boolean;
begin begin
Get(ATypeInfo,AName,AData); Result := Get(ATypeInfo,AName,AData);
end; end;
procedure TJsonRpcBaseFormatter.GetScopeInnerValue(const ATypeInfo : PTypeInfo; var AData); procedure TJsonRpcBaseFormatter.GetScopeInnerValue(const ATypeInfo : PTypeInfo; var AData);
@ -1435,12 +1498,18 @@ begin
End; End;
end; end;
function TJsonRpcBaseFormatter.ReadBuffer(const AName : string) : string; function TJsonRpcBaseFormatter.ReadBuffer(
const AName : string;
out AResBuffer : string
) : Boolean;
var var
locName : string; locName : string;
locBuffer : TJSONData;
begin begin
locName := AName; locName := AName;
Result := GetDataBuffer(locName).AsJSON; Result := GetDataBuffer(locName,locBuffer);
if Result then
AResBuffer := locBuffer.AsJSON;
end; end;
procedure TJsonRpcBaseFormatter.WriteBuffer(const AValue: string); procedure TJsonRpcBaseFormatter.WriteBuffer(const AValue: string);

View File

@ -195,22 +195,22 @@ type
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const AData const AData
); );
procedure Get( function Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : string; var AName : string;
var AData var AData
);overload; ) : Boolean; overload;
procedure Get( function Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
var AName : string; var AName : string;
var AData var AData
);overload; ) : Boolean; overload;
procedure GetScopeInnerValue( procedure GetScopeInnerValue(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AData var AData
); );
function ReadBuffer(const AName : string) : string; function ReadBuffer(const AName : string; out AResBuffer : string) : Boolean;
//Please use this method if and _only_ if you do not have another way achieve your aim! //Please use this method if and _only_ if you do not have another way achieve your aim!
procedure WriteBuffer(const AValue : string); procedure WriteBuffer(const AValue : string);
@ -6078,7 +6078,7 @@ var
buffer : string; buffer : string;
locObj : TStringBufferRemotable; locObj : TStringBufferRemotable;
begin begin
buffer := AStore.ReadBuffer(AName); AStore.ReadBuffer(AName,buffer);
if ( AObject = nil ) then if ( AObject = nil ) then
AObject := Create(); AObject := Create();
locObj := AObject as TStringBufferRemotable;; locObj := AObject as TStringBufferRemotable;;

View File

@ -231,89 +231,93 @@ type
const AData : Pointer const AData : Pointer
);{$IFDEF USE_INLINE}inline;{$ENDIF} );{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetNodeValue(const ANameSpace : string; var AName : String):DOMString; function GetNodeValue(
procedure GetEnum( const ANameSpace : string;
var AName : string;
out AResBuffer : DOMString
) : Boolean;
function GetEnum(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
Var AName : String; Var AName : String;
Var AData : TEnumIntType Var AData : TEnumIntType
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetBool( function GetBool(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
Var AName : String; Var AName : String;
Var AData : Boolean Var AData : Boolean
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetAnsiChar( function GetAnsiChar(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
Var AName : String; Var AName : String;
Var AData : AnsiChar Var AData : AnsiChar
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetWideChar( function GetWideChar(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
Var AName : String; Var AName : String;
Var AData : WideChar Var AData : WideChar
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF FPC} {$IFDEF FPC}
procedure GetInt( function GetInt(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
Var AName : String; Var AName : String;
Var AData : Integer Var AData : Integer
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF} {$ENDIF}
procedure GetInt64( function GetInt64(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
Var AName : String; Var AName : String;
Var AData : Int64 Var AData : Int64
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
procedure GetUInt64( function GetUInt64(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
Var AName : String; Var AName : String;
Var AData : QWord Var AData : QWord
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF HAS_QWORD} {$ENDIF HAS_QWORD}
procedure GetFloat( function GetFloat(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
Var AName : String; Var AName : String;
Var AData : Extended Var AData : Extended
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetStr( function GetStr(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
Var AName : String; Var AName : String;
Var AData : String Var AData : String
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
procedure GetUnicodeStr( function GetUnicodeStr(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
Var AName : String; Var AName : String;
Var AData : UnicodeString Var AData : UnicodeString
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
procedure GetWideStr( function GetWideStr(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
Var AName : String; Var AName : String;
Var AData : WideString Var AData : WideString
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetObj( function GetObj(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : TObject Var AData : TObject
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetRecord( function GetRecord(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : Pointer var AData : Pointer
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
protected protected
function GetXmlDoc():TwstXMLDocument;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetXmlDoc():TwstXMLDocument;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PushStack(AScopeObject : TDOMNode):TStackItem;overload;{$IFDEF USE_INLINE}inline;{$ENDIF} function PushStack(AScopeObject : TDOMNode):TStackItem;overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
@ -422,22 +426,22 @@ type
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const AData const AData
); );
procedure Get( function Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : string; var AName : string;
var AData var AData
);overload; ) : Boolean; overload;
procedure Get( function Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
var AName : string; var AName : string;
var AData var AData
);overload; ) : Boolean;overload;
procedure GetScopeInnerValue( procedure GetScopeInnerValue(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AData var AData
); );
function ReadBuffer(const AName : string) : string; function ReadBuffer(const AName : string; out AResBuffer : string) : Boolean;
procedure WriteBuffer(const AValue : string); procedure WriteBuffer(const AValue : string);
procedure SaveToStream(AStream : TStream); procedure SaveToStream(AStream : TStream);
@ -1006,7 +1010,11 @@ begin
Result := InternalPutData(ANameSpace,AName,ATypeInfo,wst_FormatFloat(ATypeInfo,AData)); Result := InternalPutData(ANameSpace,AName,ATypeInfo,wst_FormatFloat(ATypeInfo,AData));
end; end;
function TSOAPBaseFormatter.GetNodeValue(const ANameSpace : string; var AName: String): DOMString; function TSOAPBaseFormatter.GetNodeValue(
const ANameSpace : string;
var AName : string;
out AResBuffer : DOMString
): Boolean;
var var
locElt : TDOMNode; locElt : TDOMNode;
namespaceShortName, strNodeName, s : string; namespaceShortName, strNodeName, s : string;
@ -1031,176 +1039,220 @@ begin
locElt := GetCurrentScopeObject().GetAttributeNode(strNodeName); locElt := GetCurrentScopeObject().GetAttributeNode(strNodeName);
end; end;
if Assigned(locElt) then begin Result := ( locElt <> nil );
if Result then begin
if locElt.HasChildNodes then if locElt.HasChildNodes then
Result := locElt.FirstChild.NodeValue AResBuffer := locElt.FirstChild.NodeValue
else else
Result := locElt.NodeValue; AResBuffer := locElt.NodeValue;
end else begin
Error('Param or Attribute not found : "%s"',[AName]);
end; end;
end; end;
procedure TSOAPBaseFormatter.GetEnum( function TSOAPBaseFormatter.GetEnum(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
var AName: String; var AName: String;
var AData: TEnumIntType var AData: TEnumIntType
); ) : Boolean;
Var Var
locBuffer : String; locBuffer : DOMString;
locStrBuffer : String;
begin begin
locBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(GetNodeValue(ANameSpace,AName)); Result := GetNodeValue(ANameSpace,AName,locBuffer);
If IsStrEmpty(locBuffer) Then if Result then begin
AData := 0 locStrBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(locBuffer);
Else If IsStrEmpty(locStrBuffer) Then
AData := GetEnumValue(ATypeInfo,locBuffer) AData := 0
Else
AData := GetEnumValue(ATypeInfo,locStrBuffer)
end;
End; End;
procedure TSOAPBaseFormatter.GetBool( function TSOAPBaseFormatter.GetBool(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
var AName : String; var AName : String;
var AData : Boolean var AData : Boolean
); ) : Boolean;
Var Var
locBuffer : String; locBuffer : DOMString;
locStrBuffer : String;
begin begin
locBuffer := LowerCase(Trim(GetNodeValue(ANameSpace,AName))); Result := GetNodeValue(ANameSpace,AName,locBuffer);
If IsStrEmpty(locBuffer) Then if Result then begin
AData := False locStrBuffer := LowerCase(Trim(locBuffer));
Else If IsStrEmpty(locStrBuffer) Then
AData := StrToBool(locBuffer); AData := False
Else
AData := StrToBool(locStrBuffer);
end;
end; end;
procedure TSOAPBaseFormatter.GetAnsiChar( function TSOAPBaseFormatter.GetAnsiChar(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
const ANameSpace: string; const ANameSpace: string;
var AName: String; var AName: String;
var AData: AnsiChar var AData: AnsiChar
); ) : Boolean;
var var
tmpString : DOMString; tmpString : DOMString;
begin begin
tmpString := GetNodeValue(ANameSpace,AName); Result := GetNodeValue(ANameSpace,AName,tmpString);
if ( Length(tmpString) > 0 ) then if Result then begin
AData := AnsiChar(tmpString[1]) if ( Length(tmpString) > 0 ) then
else AData := AnsiChar(tmpString[1])
AData := #0; else
AData := #0;
end;
end; end;
procedure TSOAPBaseFormatter.GetWideChar( function TSOAPBaseFormatter.GetWideChar(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
const ANameSpace: string; const ANameSpace: string;
var AName: String; var AName: String;
var AData: WideChar var AData: WideChar
); ) : Boolean;
var var
tmpString : DOMString; tmpString : DOMString;
begin begin
tmpString := GetNodeValue(ANameSpace,AName); Result := GetNodeValue(ANameSpace,AName,tmpString);
if ( Length(tmpString) > 0 ) then if Result then begin
AData := tmpString[1] if ( Length(tmpString) > 0 ) then
else AData := tmpString[1]
AData := #0; else
AData := #0;
end;
end; end;
{$IFDEF FPC} {$IFDEF FPC}
procedure TSOAPBaseFormatter.GetInt( function TSOAPBaseFormatter.GetInt(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
var AName: String; var AName: String;
var AData: Integer var AData: Integer
); ) : Boolean;
var
locBuffer : DOMString;
begin begin
AData := StrToIntDef(Trim(GetNodeValue(ANameSpace,AName)),0); Result := GetNodeValue(ANameSpace,AName,locBuffer);
if Result then
AData := StrToIntDef(Trim(locBuffer),0);
end; end;
{$ENDIF} {$ENDIF}
procedure TSOAPBaseFormatter.GetInt64( function TSOAPBaseFormatter.GetInt64(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
var AName : String; var AName : String;
var AData : Int64 var AData : Int64
); ) : Boolean;
var
locBuffer : DOMString;
begin begin
AData := StrToInt64Def(Trim(GetNodeValue(ANameSpace,AName)),0); Result := GetNodeValue(ANameSpace,AName,locBuffer);
if Result then
AData :=StrToInt64Def(Trim(locBuffer),0);
end; end;
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
procedure TSOAPBaseFormatter.GetUInt64( function TSOAPBaseFormatter.GetUInt64(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
var AName : String; var AName : String;
var AData : QWord var AData : QWord
); ) : Boolean;
var
locBuffer : DOMString;
begin begin
AData := StrToQWordDef(Trim(GetNodeValue(ANameSpace,AName)),0); Result := GetNodeValue(ANameSpace,AName,locBuffer);
if Result then
AData := StrToQWordDef(Trim(locBuffer),0);
end; end;
{$ENDIF HAS_QWORD} {$ENDIF HAS_QWORD}
procedure TSOAPBaseFormatter.GetFloat( function TSOAPBaseFormatter.GetFloat(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
var AName : String; var AName : String;
var AData : Extended var AData : Extended
); ) : Boolean;
var
locBuffer : DOMString;
begin begin
Result := GetNodeValue(ANameSpace,AName,locBuffer);
if Result then begin
{$IFDEF HAS_FORMAT_SETTINGS} {$IFDEF HAS_FORMAT_SETTINGS}
AData := StrToFloatDef(Trim(GetNodeValue(ANameSpace,AName)),0,wst_FormatSettings); AData := StrToFloatDef(Trim(locBuffer),0,wst_FormatSettings);
{$ELSE} {$ELSE}
AData := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(GetNodeValue(ANameSpace,AName))),0); AData := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(locBuffer)),0);
{$ENDIF HAS_FORMAT_SETTINGS} {$ENDIF HAS_FORMAT_SETTINGS}
end;
end; end;
procedure TSOAPBaseFormatter.GetStr( function TSOAPBaseFormatter.GetStr(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
var AName : String; var AName : String;
var AData : String var AData : String
); ) : Boolean;
var
locBuffer : DOMString;
begin begin
AData := GetNodeValue(ANameSpace,AName); Result := GetNodeValue(ANameSpace,AName,locBuffer);
if Result then
AData := locBuffer;
end; end;
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
procedure TSOAPBaseFormatter.GetUnicodeStr( function TSOAPBaseFormatter.GetUnicodeStr(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
const ANameSpace: string; const ANameSpace: string;
var AName: String; var AName: String;
var AData: UnicodeString var AData: UnicodeString
); ) : Boolean;
var
locBuffer : DOMString;
begin begin
AData := GetNodeValue(ANameSpace,AName); Result := GetNodeValue(ANameSpace,AName,locBuffer);
if Result then
AData := locBuffer;
end; end;
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
procedure TSOAPBaseFormatter.GetWideStr( function TSOAPBaseFormatter.GetWideStr(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
const ANameSpace: string; const ANameSpace: string;
var AName: String; var AName: String;
var AData: WideString var AData: WideString
); ) : Boolean;
var
locBuffer : DOMString;
begin begin
AData := GetNodeValue(ANameSpace,AName); Result := GetNodeValue(ANameSpace,AName,locBuffer);
if Result then
AData := locBuffer;
end; end;
procedure TSOAPBaseFormatter.GetObj( function TSOAPBaseFormatter.GetObj(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : TObject var AData : TObject
); ) : Boolean;
begin begin
{ TODO -cEXCEPTION_SAFE : Load() should be a function ! }
TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Load(AData, Self,AName,ATypeInfo); TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Load(AData, Self,AName,ATypeInfo);
Result := True;
end; end;
procedure TSOAPBaseFormatter.GetRecord( function TSOAPBaseFormatter.GetRecord(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : Pointer var AData : Pointer
); ) : Boolean;
begin begin
{ TODO -cEXCEPTION_SAFE : Load() should be a function ! }
TRemotableRecordEncoder.Load(AData, Self,AName,ATypeInfo); TRemotableRecordEncoder.Load(AData, Self,AName,ATypeInfo);
Result := True;
end; end;
function TSOAPBaseFormatter.GetXmlDoc(): TwstXMLDocument; function TSOAPBaseFormatter.GetXmlDoc(): TwstXMLDocument;
@ -1955,12 +2007,12 @@ begin
StackTop().ScopeObject.AppendChild(FDoc.CreateTextNode(dataBuffer)); StackTop().ScopeObject.AppendChild(FDoc.CreateTextNode(dataBuffer));
end; end;
procedure TSOAPBaseFormatter.Get( function TSOAPBaseFormatter.Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
var AName : String; var AName : String;
var AData var AData
); ) : Boolean;
Var Var
int64Data : Int64; int64Data : Int64;
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
@ -1983,66 +2035,75 @@ begin
tkChar : tkChar :
begin begin
ansiCharData := #0; ansiCharData := #0;
GetAnsiChar(ATypeInfo,ANameSpace,AName,ansiCharData); Result := GetAnsiChar(ATypeInfo,ANameSpace,AName,ansiCharData);
AnsiChar(AData) := ansiCharData; if Result then
AnsiChar(AData) := ansiCharData;
end; end;
tkWChar : tkWChar :
begin begin
wideCharData := #0; wideCharData := #0;
GetWideChar(ATypeInfo,ANameSpace,AName,wideCharData); Result := GetWideChar(ATypeInfo,ANameSpace,AName,wideCharData);
WideChar(AData) := wideCharData; if Result then
WideChar(AData) := wideCharData;
end; end;
tkInt64 : tkInt64 :
Begin Begin
int64Data := 0; int64Data := 0;
GetInt64(ATypeInfo,ANameSpace,AName,int64Data); Result := GetInt64(ATypeInfo,ANameSpace,AName,int64Data);
Int64(AData) := int64Data; if Result then
Int64(AData) := int64Data;
End; End;
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
tkQWord : tkQWord :
Begin Begin
uint64Data := 0; uint64Data := 0;
GetUInt64(ATypeInfo,ANameSpace,AName,uint64Data); Result := GetUInt64(ATypeInfo,ANameSpace,AName,uint64Data);
QWord(AData) := uint64Data; if Result then
QWord(AData) := uint64Data;
End; End;
{$ENDIF HAS_QWORD} {$ENDIF HAS_QWORD}
tkLString{$IFDEF FPC},tkAString{$ENDIF} : tkLString{$IFDEF FPC},tkAString{$ENDIF} :
Begin Begin
strData := ''; strData := '';
GetStr(ATypeInfo,ANameSpace,AName,strData); Result := GetStr(ATypeInfo,ANameSpace,AName,strData);
String(AData) := strData; if Result then
String(AData) := strData;
End; End;
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
tkUString : tkUString :
begin begin
unicodeStrData := ''; unicodeStrData := '';
GetUnicodeStr(ATypeInfo,ANameSpace,AName,unicodeStrData); Result := GetUnicodeStr(ATypeInfo,ANameSpace,AName,unicodeStrData);
UnicodeString(AData) := unicodeStrData; if Result then
UnicodeString(AData) := unicodeStrData;
end; end;
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
tkWString : tkWString :
begin begin
wideStrData := ''; wideStrData := '';
GetWideStr(ATypeInfo,ANameSpace,AName,wideStrData); Result := GetWideStr(ATypeInfo,ANameSpace,AName,wideStrData);
WideString(AData) := wideStrData; if Result then
WideString(AData) := wideStrData;
end; end;
tkClass : tkClass :
Begin Begin
objData := TObject(AData); objData := TObject(AData);
GetObj(ATypeInfo,AName,objData); Result := GetObj(ATypeInfo,AName,objData);
TObject(AData) := objData; if Result then
TObject(AData) := objData;
End; End;
tkRecord : tkRecord :
begin begin
recObject := Pointer(@AData); recObject := Pointer(@AData);
GetRecord(ATypeInfo,AName,recObject); Result := GetRecord(ATypeInfo,AName,recObject);
end; end;
{$IFDEF FPC} {$IFDEF FPC}
tkBool : tkBool :
Begin Begin
boolData := False; boolData := False;
GetBool(ATypeInfo,ANameSpace,AName,boolData); Result := GetBool(ATypeInfo,ANameSpace,AName,boolData);
Boolean(AData) := boolData; if Result then
Boolean(AData) := boolData;
End; End;
{$ENDIF} {$ENDIF}
tkInteger, tkEnumeration : tkInteger, tkEnumeration :
@ -2052,51 +2113,58 @@ begin
( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) ) ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) )
then begin then begin
boolData := False; boolData := False;
GetBool(ATypeInfo,ANameSpace,AName,boolData); Result := GetBool(ATypeInfo,ANameSpace,AName,boolData);
Boolean(AData) := boolData; if Result then
Boolean(AData) := boolData;
end else begin end else begin
{$ENDIF} {$ENDIF}
enumData := 0; enumData := 0;
If ( ATypeInfo^.Kind = tkInteger ) Then if ( ATypeInfo^.Kind = tkInteger ) then
GetInt64(ATypeInfo,ANameSpace,AName,enumData) Result := GetInt64(ATypeInfo,ANameSpace,AName,enumData)
Else else
GetEnum(ATypeInfo,ANameSpace,AName,enumData); Result := GetEnum(ATypeInfo,ANameSpace,AName,enumData);
Case GetTypeData(ATypeInfo)^.OrdType Of if Result then begin
otSByte : ShortInt(AData) := enumData; case GetTypeData(ATypeInfo)^.OrdType of
otUByte : Byte(AData) := enumData; otSByte : ShortInt(AData) := enumData;
otSWord : SmallInt(AData) := enumData; otUByte : Byte(AData) := enumData;
otUWord : Word(AData) := enumData; otSWord : SmallInt(AData) := enumData;
otSLong : LongInt(AData) := enumData; otUWord : Word(AData) := enumData;
otULong : LongWord(AData) := enumData; otSLong : LongInt(AData) := enumData;
End; otULong : LongWord(AData) := enumData;
end;
end;
{$IFDEF WST_DELPHI} {$IFDEF WST_DELPHI}
end; end;
{$ENDIF} {$ENDIF}
end; end;
tkFloat : tkFloat :
Begin begin
floatDt := 0; floatDt := 0;
GetFloat(ATypeInfo,ANameSpace,AName,floatDt); Result := GetFloat(ATypeInfo,ANameSpace,AName,floatDt);
Case GetTypeData(ATypeInfo)^.FloatType Of if Result then begin
ftSingle : Single(AData) := floatDt; case GetTypeData(ATypeInfo)^.FloatType of
ftDouble : Double(AData) := floatDt; ftSingle : Single(AData) := floatDt;
ftExtended : Extended(AData) := floatDt; ftDouble : Double(AData) := floatDt;
ftCurr : Currency(AData) := floatDt; ftExtended : Extended(AData) := floatDt;
ftCurr : Currency(AData) := floatDt;
{$IFDEF CPU86} {$IFDEF CPU86}
ftComp : Comp(AData) := floatDt; ftComp : Comp(AData) := floatDt;
{$ENDIF} {$ENDIF}
End; end;
End; end;
End; end;
else
Result := False;
end;
end; end;
procedure TSOAPBaseFormatter.Get( function TSOAPBaseFormatter.Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : string; var AName : string;
var AData var AData
); ) : Boolean;
begin begin
Get(ATypeInfo,'',AName,AData); Result := Get(ATypeInfo,'',AName,AData);
end; end;
procedure TSOAPBaseFormatter.GetScopeInnerValue( procedure TSOAPBaseFormatter.GetScopeInnerValue(
@ -2202,7 +2270,7 @@ begin
end; end;
end; end;
function TSOAPBaseFormatter.ReadBuffer (const AName : string ) : string; function TSOAPBaseFormatter.ReadBuffer(const AName : string; out AResBuffer : string) : Boolean;
Var Var
locElt : TDOMNode; locElt : TDOMNode;
namespaceShortName, strNodeName : string; namespaceShortName, strNodeName : string;
@ -2221,11 +2289,9 @@ begin
locElt := GetCurrentScopeObject().GetAttributeNode(strNodeName); locElt := GetCurrentScopeObject().GetAttributeNode(strNodeName);
end; end;
if Assigned(locElt) then begin Result := ( locElt <> nil );
Result := NodeToBuffer(locElt); if Result then
end else begin AResBuffer := NodeToBuffer(locElt);
Error('Param or Attribute not found : "%s"',[AName]);
end;
end; end;
procedure TSOAPBaseFormatter.SaveToStream(AStream: TStream); procedure TSOAPBaseFormatter.SaveToStream(AStream: TStream);

View File

@ -242,76 +242,76 @@ type
const AData : Pointer const AData : Pointer
);{$IFDEF USE_INLINE}inline;{$ENDIF} );{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetNodeValue(var AName : String):DOMString; function GetNodeValue(var AName : string; out AResBuffer : DOMString) : Boolean;
procedure GetEnum( function GetEnum(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : TEnumIntType Var AData : TEnumIntType
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetAnsiChar( function GetAnsiChar(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : AnsiChar Var AData : AnsiChar
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetWideChar( function GetWideChar(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : WideChar Var AData : WideChar
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetBool( function GetBool(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : Boolean Var AData : Boolean
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetInt( function GetInt(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : Integer Var AData : Integer
); ) : Boolean;
procedure GetInt64( function GetInt64(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : Int64 Var AData : Int64
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
procedure GetUInt64( function GetUInt64(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : QWord Var AData : QWord
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF HAS_QWORD} {$ENDIF HAS_QWORD}
procedure GetFloat( function GetFloat(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : Extended Var AData : Extended
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetStr( function GetStr(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : String Var AData : String
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
procedure GetUnicodeStr( function GetUnicodeStr(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : UnicodeString Var AData : UnicodeString
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
procedure GetWideStr( function GetWideStr(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : WideString Var AData : WideString
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetObj( function GetObj(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
Var AData : TObject Var AData : TObject
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetRecord( function GetRecord(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : Pointer var AData : Pointer
);{$IFDEF USE_INLINE}inline;{$ENDIF} ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
protected protected
function GetXmlDoc():TXMLDocument;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetXmlDoc():TXMLDocument;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PushStack(AScopeObject : TDOMNode):TStackItem;overload;{$IFDEF USE_INLINE}inline;{$ENDIF} function PushStack(AScopeObject : TDOMNode):TStackItem;overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
@ -409,22 +409,22 @@ type
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const AData const AData
); );
procedure Get( function Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : string; var AName : string;
var AData var AData
);overload; ) : Boolean;overload;
procedure Get( function Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
var AName : string; var AName : string;
var AData var AData
);overload; ) : Boolean;overload;
procedure GetScopeInnerValue( procedure GetScopeInnerValue(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AData var AData
); );
function ReadBuffer(const AName : string) : string; function ReadBuffer(const AName : string; out AResBuffer : string) : Boolean;
procedure WriteBuffer(const AValue : string); procedure WriteBuffer(const AValue : string);
procedure SaveToStream(AStream : TStream); procedure SaveToStream(AStream : TStream);
@ -949,7 +949,10 @@ begin
Result := InternalPutData(AName,xdtdouble,wst_FormatFloat(ATypeInfo,AData)); Result := InternalPutData(AName,xdtdouble,wst_FormatFloat(ATypeInfo,AData));
end; end;
function TXmlRpcBaseFormatter.GetNodeValue(var AName: string): DOMString; function TXmlRpcBaseFormatter.GetNodeValue(
var AName: string;
out AResBuffer : DOMString
) : Boolean;
var var
locElt : TDOMNode; locElt : TDOMNode;
stkTop : TStackItem; stkTop : TStackItem;
@ -957,161 +960,205 @@ begin
stkTop := StackTop(); stkTop := StackTop();
locElt := stkTop.FindNode(AName) as TDOMElement; locElt := stkTop.FindNode(AName) as TDOMElement;
if Assigned(locElt) then begin Result := ( locElt <> nil );
if Result then begin
if locElt.HasChildNodes then begin if locElt.HasChildNodes then begin
Result := locElt.FirstChild.NodeValue AResBuffer := locElt.FirstChild.NodeValue
end else begin end else begin
if ( stkTop.FoundState = fsFoundNil ) then if ( stkTop.FoundState = fsFoundNil ) then
Result := '' AResBuffer := ''
else else
Result := locElt.NodeValue; AResBuffer := locElt.NodeValue;
end; end;
end else begin
Error('Param or Attribute not found : "%s"',[AName]);
end; end;
end; end;
procedure TXmlRpcBaseFormatter.GetEnum( function TXmlRpcBaseFormatter.GetEnum(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: TEnumIntType var AData: TEnumIntType
); ) : Boolean;
Var var
locBuffer : String; locBuffer : DOMString;
locStr : string;
begin begin
locBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(GetNodeValue(AName)); Result := GetNodeValue(AName,locBuffer);
If IsStrEmpty(locBuffer) Then if Result then begin
AData := 0 locStr := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(locBuffer);
Else If IsStrEmpty(locStr) Then
AData := GetEnumValue(ATypeInfo,locBuffer) AData := 0
Else
AData := GetEnumValue(ATypeInfo,locStr)
end;
End; End;
procedure TXmlRpcBaseFormatter.GetBool( function TXmlRpcBaseFormatter.GetBool(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : Boolean var AData : Boolean
); ) : Boolean;
var
locBuffer : DOMString;
begin begin
AData := ( GetNodeValue(AName) = XML_RPC_TRUE ); Result := GetNodeValue(AName,locBuffer);
if Result then
AData := ( locBuffer = XML_RPC_TRUE );
end; end;
procedure TXmlRpcBaseFormatter.GetInt( function TXmlRpcBaseFormatter.GetInt(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: Integer var AData: Integer
); ) : Boolean;
var
locBuffer : DOMString;
begin begin
AData := StrToIntDef(Trim(GetNodeValue(AName)),0); Result := GetNodeValue(AName,locBuffer);
if Result then
AData := StrToIntDef(Trim(locBuffer),0);
end; end;
procedure TXmlRpcBaseFormatter.GetAnsiChar( function TXmlRpcBaseFormatter.GetAnsiChar(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: AnsiChar var AData: AnsiChar
); ) : Boolean;
var var
locBuffer : DOMString; locBuffer : DOMString;
begin begin
locBuffer := GetNodeValue(AName); Result := GetNodeValue(AName,locBuffer);
if ( Length(locBuffer) = 0 ) then if Result then begin
AData := #0 if ( Length(locBuffer) = 0 ) then
else AData := #0
AData := AnsiChar(locBuffer[1]); else
AData := AnsiChar(locBuffer[1]);
end;
end; end;
procedure TXmlRpcBaseFormatter.GetWideChar( function TXmlRpcBaseFormatter.GetWideChar(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: WideChar var AData: WideChar
); ) : Boolean;
var var
locBuffer : DOMString; locBuffer : DOMString;
begin begin
locBuffer := GetNodeValue(AName); Result := GetNodeValue(AName,locBuffer);
if ( Length(locBuffer) = 0 ) then if Result then begin
AData := #0 if ( Length(locBuffer) = 0 ) then
else AData := #0
AData := locBuffer[1]; else
AData := locBuffer[1];
end;
end; end;
procedure TXmlRpcBaseFormatter.GetInt64( function TXmlRpcBaseFormatter.GetInt64(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : Int64 var AData : Int64
); ) : Boolean;
var
locBuffer : DOMString;
begin begin
AData := StrToInt64Def(Trim(GetNodeValue(AName)),0); Result := GetNodeValue(AName,locBuffer);
if Result then
AData := StrToInt64Def(Trim(locBuffer),0);
end; end;
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
procedure TXmlRpcBaseFormatter.GetUInt64( function TXmlRpcBaseFormatter.GetUInt64(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : QWord var AData : QWord
); ) : Boolean;
var
locBuffer : DOMString;
begin begin
AData := StrToQWordDef(Trim(GetNodeValue(AName)),0); Result := GetNodeValue(AName,locBuffer);
if Result then
AData := StrToQWordDef(Trim(locBuffer),0);
end; end;
{$ENDIF HAS_QWORD} {$ENDIF HAS_QWORD}
procedure TXmlRpcBaseFormatter.GetFloat( function TXmlRpcBaseFormatter.GetFloat(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : Extended var AData : Extended
); ) : Boolean;
var
locBuffer : DOMString;
begin begin
Result := GetNodeValue(AName,locBuffer);
if Result then begin
{$IFDEF HAS_FORMAT_SETTINGS} {$IFDEF HAS_FORMAT_SETTINGS}
AData := StrToFloatDef(Trim(GetNodeValue(AName)),0,wst_FormatSettings); AData := StrToFloatDef(Trim(locBuffer),0,wst_FormatSettings);
{$ELSE} {$ELSE}
AData := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(GetNodeValue(AName))),0); AData := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(locBuffer)),0);
{$ENDIF HAS_FORMAT_SETTINGS} {$ENDIF HAS_FORMAT_SETTINGS}
end;
end; end;
procedure TXmlRpcBaseFormatter.GetStr( function TXmlRpcBaseFormatter.GetStr(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : String var AData : String
); ) : Boolean;
var
locBuffer : DOMString;
begin begin
AData := GetNodeValue(AName); Result := GetNodeValue(AName,locBuffer);
if Result then
AData := locBuffer;
end; end;
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
procedure TXmlRpcBaseFormatter.GetUnicodeStr( function TXmlRpcBaseFormatter.GetUnicodeStr(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: UnicodeString var AData: UnicodeString
); ) : Boolean;
var
locBuffer : DOMString;
begin begin
AData := GetNodeValue(AName); Result := GetNodeValue(AName,locBuffer);
if Result then
AData := locBuffer;
end; end;
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
procedure TXmlRpcBaseFormatter.GetWideStr( function TXmlRpcBaseFormatter.GetWideStr(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
var AName: String; var AName: String;
var AData: WideString var AData: WideString
); ) : Boolean;
var
locBuffer : DOMString;
begin begin
AData := GetNodeValue(AName); Result := GetNodeValue(AName,locBuffer);
if Result then
AData := locBuffer;
end; end;
procedure TXmlRpcBaseFormatter.GetObj( function TXmlRpcBaseFormatter.GetObj(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : TObject var AData : TObject
); ) : Boolean;
begin begin
{ TODO -cEXCEPTION_SAFE : Load() should be a function ! }
TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Load(AData, Self,AName,ATypeInfo); TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Load(AData, Self,AName,ATypeInfo);
Result := True;
end; end;
procedure TXmlRpcBaseFormatter.GetRecord( function TXmlRpcBaseFormatter.GetRecord(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : Pointer var AData : Pointer
); ) : Boolean;
begin begin
{ TODO -cEXCEPTION_SAFE : Load() should be a function ! }
TRemotableRecordEncoder.Load(AData, Self,AName,ATypeInfo); TRemotableRecordEncoder.Load(AData, Self,AName,ATypeInfo);
Result := True;
end; end;
function TXmlRpcBaseFormatter.GetXmlDoc(): TwstXMLDocument; function TXmlRpcBaseFormatter.GetXmlDoc(): TwstXMLDocument;
@ -1535,11 +1582,11 @@ begin
StackTop().ScopeObject.AppendChild(FDoc.CreateTextNode(dataBuffer)); StackTop().ScopeObject.AppendChild(FDoc.CreateTextNode(dataBuffer));
end; end;
procedure TXmlRpcBaseFormatter.Get( function TXmlRpcBaseFormatter.Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData var AData
); ) : Boolean;
Var Var
int64Data : Int64; int64Data : Int64;
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
@ -1562,66 +1609,75 @@ begin
tkChar : tkChar :
begin begin
ansiCharData := #0; ansiCharData := #0;
GetAnsiChar(ATypeInfo,AName,ansiCharData); Result := GetAnsiChar(ATypeInfo,AName,ansiCharData);
AnsiChar(AData) := ansiCharData; if Result then
AnsiChar(AData) := ansiCharData;
end; end;
tkWChar : tkWChar :
begin begin
wideCharData := #0; wideCharData := #0;
GetWideChar(ATypeInfo,AName,wideCharData); Result := GetWideChar(ATypeInfo,AName,wideCharData);
WideChar(AData) := wideCharData; if Result then
WideChar(AData) := wideCharData;
end; end;
tkInt64 : tkInt64 :
Begin Begin
int64Data := 0; int64Data := 0;
GetInt64(ATypeInfo,AName,int64Data); Result := GetInt64(ATypeInfo,AName,int64Data);
Int64(AData) := int64Data; if Result then
Int64(AData) := int64Data;
End; End;
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
tkQWord : tkQWord :
Begin Begin
uint64Data := 0; uint64Data := 0;
GetUInt64(ATypeInfo,AName,uint64Data); Result := GetUInt64(ATypeInfo,AName,uint64Data);
QWord(AData) := uint64Data; if Result then
QWord(AData) := uint64Data;
End; End;
{$ENDIF HAS_QWORD} {$ENDIF HAS_QWORD}
tkLString{$IFDEF FPC},tkAString{$ENDIF} : tkLString{$IFDEF FPC},tkAString{$ENDIF} :
Begin Begin
strData := ''; strData := '';
GetStr(ATypeInfo,AName,strData); Result := GetStr(ATypeInfo,AName,strData);
String(AData) := strData; if Result then
String(AData) := strData;
End; End;
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
tkUString : tkUString :
begin begin
unicodeStrData := ''; unicodeStrData := '';
GetUnicodeStr(ATypeInfo,AName,unicodeStrData); Result := GetUnicodeStr(ATypeInfo,AName,unicodeStrData);
UnicodeString(AData) := unicodeStrData; if Result then
UnicodeString(AData) := unicodeStrData;
end; end;
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
tkWString : tkWString :
begin begin
wideStrData := ''; wideStrData := '';
GetWideStr(ATypeInfo,AName,wideStrData); Result := GetWideStr(ATypeInfo,AName,wideStrData);
WideString(AData) := wideStrData; if Result then
WideString(AData) := wideStrData;
end; end;
tkClass : tkClass :
Begin Begin
objData := TObject(AData); objData := TObject(AData);
GetObj(ATypeInfo,AName,objData); Result := GetObj(ATypeInfo,AName,objData);
TObject(AData) := objData; if Result then
TObject(AData) := objData;
End; End;
tkRecord : tkRecord :
begin begin
recObject := Pointer(@AData); recObject := Pointer(@AData);
GetRecord(ATypeInfo,AName,recObject); Result := GetRecord(ATypeInfo,AName,recObject);
end; end;
{$IFDEF FPC} {$IFDEF FPC}
tkBool : tkBool :
Begin Begin
boolData := False; boolData := False;
GetBool(ATypeInfo,AName,boolData); Result := GetBool(ATypeInfo,AName,boolData);
Boolean(AData) := boolData; if Result then
Boolean(AData) := boolData;
End; End;
{$ENDIF} {$ENDIF}
tkInteger, tkEnumeration : tkInteger, tkEnumeration :
@ -1631,52 +1687,59 @@ begin
( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) ) ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) )
then begin then begin
boolData := False; boolData := False;
GetBool(ATypeInfo,AName,boolData); Result := GetBool(ATypeInfo,AName,boolData);
Boolean(AData) := boolData; if Result then
Boolean(AData) := boolData;
end else begin end else begin
{$ENDIF} {$ENDIF}
enumData := 0; enumData := 0;
If ( ATypeInfo^.Kind = tkInteger ) Then if ( ATypeInfo^.Kind = tkInteger ) then
GetInt64(ATypeInfo,AName,enumData) Result := GetInt64(ATypeInfo,AName,enumData)
Else else
GetEnum(ATypeInfo,AName,enumData); Result := GetEnum(ATypeInfo,AName,enumData);
Case GetTypeData(ATypeInfo)^.OrdType Of if Result then begin
otSByte : ShortInt(AData) := enumData; case GetTypeData(ATypeInfo)^.OrdType Of
otUByte : Byte(AData) := enumData; otSByte : ShortInt(AData) := enumData;
otSWord : SmallInt(AData) := enumData; otUByte : Byte(AData) := enumData;
otUWord : Word(AData) := enumData; otSWord : SmallInt(AData) := enumData;
otSLong : LongInt(AData) := enumData; otUWord : Word(AData) := enumData;
otULong : LongWord(AData) := enumData; otSLong : LongInt(AData) := enumData;
End; otULong : LongWord(AData) := enumData;
end;
end;
{$IFDEF WST_DELPHI} {$IFDEF WST_DELPHI}
end; end;
{$ENDIF} {$ENDIF}
End; End;
tkFloat : tkFloat :
Begin begin
floatDt := 0; floatDt := 0;
GetFloat(ATypeInfo,AName,floatDt); Result := GetFloat(ATypeInfo,AName,floatDt);
Case GetTypeData(ATypeInfo)^.FloatType Of if Result then begin
ftSingle : Single(AData) := floatDt; case GetTypeData(ATypeInfo)^.FloatType of
ftDouble : Double(AData) := floatDt; ftSingle : Single(AData) := floatDt;
ftExtended : Extended(AData) := floatDt; ftDouble : Double(AData) := floatDt;
ftCurr : Currency(AData) := floatDt; ftExtended : Extended(AData) := floatDt;
ftCurr : Currency(AData) := floatDt;
{$IFDEF HAS_COMP} {$IFDEF HAS_COMP}
ftComp : Comp(AData) := floatDt; ftComp : Comp(AData) := floatDt;
{$ENDIF} {$ENDIF}
End; end;
End; end;
End; end;
else
Result := False;
end;
end; end;
procedure TXmlRpcBaseFormatter.Get( function TXmlRpcBaseFormatter.Get(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const ANameSpace : string; const ANameSpace : string;
var AName : string; var AName : string;
var AData var AData
); ) : Boolean;
begin begin
Get(ATypeInfo,AName,AData); Result := Get(ATypeInfo,AName,AData);
end; end;
procedure TXmlRpcBaseFormatter.GetScopeInnerValue( procedure TXmlRpcBaseFormatter.GetScopeInnerValue(
@ -1774,7 +1837,10 @@ begin
end; end;
end; end;
function TXmlRpcBaseFormatter.ReadBuffer (const AName : string ) : string; function TXmlRpcBaseFormatter.ReadBuffer(
const AName : string;
out AResBuffer : string
) : Boolean;
var var
locElt : TDOMNode; locElt : TDOMNode;
stkTop : TStackItem; stkTop : TStackItem;
@ -1784,11 +1850,9 @@ begin
locName := AName; locName := AName;
locElt := stkTop.FindNode(locName); locElt := stkTop.FindNode(locName);
if Assigned(locElt) then begin Result := ( locElt <> nil );
Result := NodeToBuffer(locElt); if Result then
end else begin AResBuffer := NodeToBuffer(locElt);
Error('Param or Attribute not found : "%s"',[AName]);
end;
end; end;
procedure TXmlRpcBaseFormatter.SaveToStream(AStream: TStream); procedure TXmlRpcBaseFormatter.SaveToStream(AStream: TStream);

View File

@ -29,12 +29,16 @@ type
TPropSerializationInfo = class; TPropSerializationInfo = class;
TPropertyReadProc = procedure( TPropertyReadProc = function(
AObject : TObject;
APropInfo : TPropSerializationInfo;
AStore : IFormatterBase
) : Boolean;
TPropertyWriteProc = procedure(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); );
TPropertyWriteProc = TPropertyReadProc;
{ TPropSerializationInfo } { TPropSerializationInfo }
@ -125,12 +129,18 @@ type
{$ENDIF TRemotableTypeInitializer_Initialize} {$ENDIF TRemotableTypeInitializer_Initialize}
end; end;
resourcestring
SERR_NoReaderProc = 'No reader proc for that type, Prop : "(%s : %s)".';
SERR_NoSerializerFoThisType = 'No serializer for this type : %s.';
SERR_SerializerInitializationException = 'Unable to initialize the serializer of that type : "%s".';
implementation implementation
uses
wst_consts;
function ErrorFunc(
AObject : TObject;
APropInfo : TPropSerializationInfo;
AStore : IFormatterBase
) : Boolean;
begin
raise Exception.CreateFmt(SERR_NoReaderProc,[APropInfo.Name,APropInfo.PropInfo^.Name]);
end;
procedure ErrorProc( procedure ErrorProc(
AObject : TObject; AObject : TObject;
@ -138,7 +148,7 @@ procedure ErrorProc(
AStore : IFormatterBase AStore : IFormatterBase
); );
begin begin
raise Exception.CreateFmt(SERR_NoReaderProc,[APropInfo.Name,APropInfo.FPropInfo^.Name]); raise Exception.CreateFmt(SERR_NoReaderProc,[APropInfo.Name,APropInfo.PropInfo^.Name]);
end; end;
type type
@ -163,27 +173,28 @@ type
// Simple readers // Simple readers
{$IFDEF HAS_TKBOOL} {$IFDEF HAS_TKBOOL}
procedure BoolReader( function BoolReader(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); ) : Boolean;
var var
locName : string; locName : string;
locData : Boolean; locData : Boolean;
begin begin
locData := False; locData := False;
locName := APropInfo.ExternalName; locName := APropInfo.ExternalName;
AStore.Get(APropInfo.PropInfo^.PropType,locName,locData); Result := AStore.Get(APropInfo.PropInfo^.PropType,locName,locData);
SetOrdProp(AObject,APropInfo.PropInfo,Ord(locData)); if Result then
SetOrdProp(AObject,APropInfo.PropInfo,Ord(locData));
end; end;
{$ENDIF HAS_TKBOOL} {$ENDIF HAS_TKBOOL}
procedure ClassReader( function ClassReader(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); ) : Boolean;
var var
locName : string; locName : string;
objData : TObject; objData : TObject;
@ -193,8 +204,8 @@ begin
objData := GetObjectProp(AObject,APropInfo.PropInfo); objData := GetObjectProp(AObject,APropInfo.PropInfo);
objDataCreateHere := not Assigned(objData); objDataCreateHere := not Assigned(objData);
try try
AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,objData); Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,objData);
if objDataCreateHere then if Result and objDataCreateHere then
SetObjectProp(AObject,APropInfo.PropInfo,objData); SetObjectProp(AObject,APropInfo.PropInfo,objData);
finally finally
if objDataCreateHere and ( objData <> GetObjectProp(AObject,APropInfo.PropInfo) ) then if objDataCreateHere and ( objData <> GetObjectProp(AObject,APropInfo.PropInfo) ) then
@ -202,11 +213,11 @@ begin
end; end;
end; end;
procedure FloatReader( function FloatReader(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); ) : Boolean;
var var
propName : string; propName : string;
floatBuffer : TFloatBuffer; floatBuffer : TFloatBuffer;
@ -219,38 +230,46 @@ begin
case GetTypeData(pt)^.FloatType of case GetTypeData(pt)^.FloatType of
ftSingle : ftSingle :
begin begin
AStore.Get(pt,propName,floatBuffer.SingleData); Result := AStore.Get(pt,propName,floatBuffer.SingleData);
floatDt := floatBuffer.SingleData; if Result then
floatDt := floatBuffer.SingleData;
end; end;
ftDouble : ftDouble :
begin begin
AStore.Get(pt,propName,floatBuffer.DoubleData); Result := AStore.Get(pt,propName,floatBuffer.DoubleData);
floatDt := floatBuffer.DoubleData; if Result then
floatDt := floatBuffer.DoubleData;
end; end;
ftExtended : ftExtended :
begin begin
AStore.Get(pt,propName,floatBuffer.ExtendedData); Result := AStore.Get(pt,propName,floatBuffer.ExtendedData);
floatDt := floatBuffer.ExtendedData; if Result then
floatDt := floatBuffer.ExtendedData;
end; end;
ftCurr : ftCurr :
begin begin
AStore.Get(pt,propName,floatBuffer.CurrencyData); Result := AStore.Get(pt,propName,floatBuffer.CurrencyData);
floatDt := floatBuffer.CurrencyData; if Result then
floatDt := floatBuffer.CurrencyData;
end; end;
ftComp : ftComp :
begin begin
AStore.Get(pt,propName,floatBuffer.CompData); Result := AStore.Get(pt,propName,floatBuffer.CompData);
floatDt := floatBuffer.CompData; if Result then
floatDt := floatBuffer.CompData;
end; end;
else
Result := False;
end; end;
SetFloatProp(AObject,APropInfo.PropInfo,floatDt); if Result then
SetFloatProp(AObject,APropInfo.PropInfo,floatDt);
end; end;
procedure IntEnumReader( function IntEnumReader(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); ) : Boolean;
var var
propName : string; propName : string;
int64Data : Int64; int64Data : Int64;
@ -266,134 +285,149 @@ begin
if ( pt^.Kind = tkEnumeration ) and if ( pt^.Kind = tkEnumeration ) and
( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) ) ( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) )
then begin then begin
AStore.Get(pt,propName,boolData); Result := AStore.Get(pt,propName,boolData);
SetPropValue(AObject,propName,boolData); if Result then
SetPropValue(AObject,propName,boolData);
end else begin end else begin
{$ENDIF} {$ENDIF}
enumData.ULongIntData := 0; enumData.ULongIntData := 0;
Case GetTypeData(pt)^.OrdType Of Case GetTypeData(pt)^.OrdType Of
otSByte : otSByte :
Begin Begin
AStore.Get(pt,propName,enumData.ShortIntData); Result := AStore.Get(pt,propName,enumData.ShortIntData);
int64Data := enumData.ShortIntData; if Result then
int64Data := enumData.ShortIntData;
End; End;
otUByte : otUByte :
Begin Begin
AStore.Get(pt,propName,enumData.ByteData); Result := AStore.Get(pt,propName,enumData.ByteData);
int64Data := enumData.ByteData; if Result then
int64Data := enumData.ByteData;
End; End;
otSWord : otSWord :
Begin Begin
AStore.Get(pt,propName,enumData.SmallIntData); Result := AStore.Get(pt,propName,enumData.SmallIntData);
int64Data := enumData.SmallIntData; if Result then
int64Data := enumData.SmallIntData;
End; End;
otUWord : otUWord :
Begin Begin
AStore.Get(pt,propName,enumData.WordData); Result := AStore.Get(pt,propName,enumData.WordData);
int64Data := enumData.WordData; if Result then
int64Data := enumData.WordData;
End; End;
otSLong: otSLong:
Begin Begin
AStore.Get(pt,propName,enumData.SLongIntData); Result := AStore.Get(pt,propName,enumData.SLongIntData);
int64Data := enumData.SLongIntData; if Result then
int64Data := enumData.SLongIntData;
End; End;
otULong : otULong :
Begin Begin
AStore.Get(pt,propName,enumData.ULongIntData); Result := AStore.Get(pt,propName,enumData.ULongIntData);
int64Data := enumData.ULongIntData; if Result then
int64Data := enumData.ULongIntData;
End; End;
else
Result := False;
End; End;
SetOrdProp(AObject,APropInfo.PropInfo,int64Data); if Result then
SetOrdProp(AObject,APropInfo.PropInfo,int64Data);
{$IFDEF WST_DELPHI} {$IFDEF WST_DELPHI}
end; end;
{$ENDIF} {$ENDIF}
end; end;
procedure Int64Reader( function Int64Reader(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); ) : Boolean;
var var
locName : string; locName : string;
locData : Int64; locData : Int64;
begin begin
locData := 0; locData := 0;
locName := APropInfo.ExternalName; locName := APropInfo.ExternalName;
AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData); Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData);
SetInt64Prop(AObject,APropInfo.PropInfo,locData); if Result then
SetInt64Prop(AObject,APropInfo.PropInfo,locData);
end; end;
procedure StringReader( function StringReader(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); ) : Boolean;
var var
locName : string; locName : string;
locData : string; locData : string;
begin begin
locData := ''; locData := '';
locName := APropInfo.ExternalName; locName := APropInfo.ExternalName;
AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData); Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData);
SetStrProp(AObject,APropInfo.PropInfo,locData); if Result then
SetStrProp(AObject,APropInfo.PropInfo,locData);
end; end;
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
procedure UnicodeStringReader( function UnicodeStringReader(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); ) : Boolean;
var var
locName : string; locName : string;
locData : UnicodeString; locData : UnicodeString;
begin begin
locData := ''; locData := '';
locName := APropInfo.ExternalName; locName := APropInfo.ExternalName;
AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData); Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData);
SetUnicodeStrProp(AObject,APropInfo.PropInfo,locData); if Result then
SetUnicodeStrProp(AObject,APropInfo.PropInfo,locData);
end; end;
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
procedure WideStringReader( function WideStringReader(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); ) : Boolean;
var var
locName : string; locName : string;
locData : WideString; locData : WideString;
begin begin
locData := ''; locData := '';
locName := APropInfo.ExternalName; locName := APropInfo.ExternalName;
AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData); Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData);
SetWideStrProp(AObject,APropInfo.PropInfo,locData); if Result then
SetWideStrProp(AObject,APropInfo.PropInfo,locData);
end; end;
// Qualified readers // Qualified readers
{$IFDEF HAS_TKBOOL} {$IFDEF HAS_TKBOOL}
procedure BoolReaderQualifier( function BoolReaderQualifier(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); ) : Boolean;
var var
locName : string; locName : string;
locData : Boolean; locData : Boolean;
begin begin
locData := False; locData := False;
locName := APropInfo.ExternalName; locName := APropInfo.ExternalName;
AStore.Get(APropInfo.PropInfo^.PropType,APropInfo.NameSpace,locName,locData); Result := AStore.Get(APropInfo.PropInfo^.PropType,APropInfo.NameSpace,locName,locData);
SetOrdProp(AObject,APropInfo.PropInfo,Ord(locData)); if Result then
SetOrdProp(AObject,APropInfo.PropInfo,Ord(locData));
end; end;
{$ENDIF HAS_TKBOOL} {$ENDIF HAS_TKBOOL}
procedure ClassReaderQualified( function ClassReaderQualified(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); ) : Boolean;
var var
locName : string; locName : string;
objData : TObject; objData : TObject;
@ -403,8 +437,8 @@ begin
objData := GetObjectProp(AObject,APropInfo.PropInfo); objData := GetObjectProp(AObject,APropInfo.PropInfo);
objDataCreateHere := not Assigned(objData); objDataCreateHere := not Assigned(objData);
try try
AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,objData); Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,objData);
if objDataCreateHere then if objDataCreateHere and Result then
SetObjectProp(AObject,APropInfo.PropInfo,objData); SetObjectProp(AObject,APropInfo.PropInfo,objData);
finally finally
if objDataCreateHere and ( objData <> GetObjectProp(AObject,APropInfo.PropInfo) ) then if objDataCreateHere and ( objData <> GetObjectProp(AObject,APropInfo.PropInfo) ) then
@ -412,11 +446,11 @@ begin
end; end;
end; end;
procedure FloatReaderQualified( function FloatReaderQualified(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); ) : Boolean;
var var
propName : string; propName : string;
floatBuffer : TFloatBuffer; floatBuffer : TFloatBuffer;
@ -429,53 +463,62 @@ begin
case GetTypeData(pt)^.FloatType of case GetTypeData(pt)^.FloatType of
ftSingle : ftSingle :
begin begin
AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.SingleData); Result := AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.SingleData);
floatDt := floatBuffer.SingleData; if Result then
floatDt := floatBuffer.SingleData;
end; end;
ftDouble : ftDouble :
begin begin
AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.DoubleData); Result := AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.DoubleData);
floatDt := floatBuffer.DoubleData; if Result then
floatDt := floatBuffer.DoubleData;
end; end;
ftExtended : ftExtended :
begin begin
AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.ExtendedData); Result := AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.ExtendedData);
floatDt := floatBuffer.ExtendedData; if Result then
floatDt := floatBuffer.ExtendedData;
end; end;
ftCurr : ftCurr :
begin begin
AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.CurrencyData); Result := AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.CurrencyData);
floatDt := floatBuffer.CurrencyData; if Result then
floatDt := floatBuffer.CurrencyData;
end; end;
ftComp : ftComp :
begin begin
AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.CompData); Result := AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.CompData);
floatDt := floatBuffer.CompData; if Result then
floatDt := floatBuffer.CompData;
end; end;
else
Result := False;
end; end;
SetFloatProp(AObject,APropInfo.PropInfo,floatDt); if Result then
SetFloatProp(AObject,APropInfo.PropInfo,floatDt);
end; end;
procedure Int64ReaderQualified( function Int64ReaderQualified(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); ) : Boolean;
var var
locName : string; locName : string;
locData : Int64; locData : Int64;
begin begin
locData := 0; locData := 0;
locName := APropInfo.ExternalName; locName := APropInfo.ExternalName;
AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData); Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData);
SetInt64Prop(AObject,APropInfo.PropInfo,locData); if Result then
SetInt64Prop(AObject,APropInfo.PropInfo,locData);
end; end;
procedure IntEnumReaderQualified( function IntEnumReaderQualified(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); ) : Boolean;
var var
propName : string; propName : string;
int64Data : Int64; int64Data : Int64;
@ -491,94 +534,107 @@ begin
if ( pt^.Kind = tkEnumeration ) and if ( pt^.Kind = tkEnumeration ) and
( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) ) ( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) )
then begin then begin
AStore.Get(pt,APropInfo.NameSpace,propName,boolData); Result := AStore.Get(pt,APropInfo.NameSpace,propName,boolData);
SetPropValue(AObject,propName,boolData); if Result then
SetPropValue(AObject,propName,boolData);
end else begin end else begin
{$ENDIF} {$ENDIF}
enumData.ULongIntData := 0; enumData.ULongIntData := 0;
Case GetTypeData(pt)^.OrdType Of Case GetTypeData(pt)^.OrdType Of
otSByte : otSByte :
Begin Begin
AStore.Get(pt,APropInfo.NameSpace,propName,enumData.ShortIntData); Result := AStore.Get(pt,APropInfo.NameSpace,propName,enumData.ShortIntData);
int64Data := enumData.ShortIntData; if Result then
int64Data := enumData.ShortIntData;
End; End;
otUByte : otUByte :
Begin Begin
AStore.Get(pt,APropInfo.NameSpace,propName,enumData.ByteData); Result := AStore.Get(pt,APropInfo.NameSpace,propName,enumData.ByteData);
int64Data := enumData.ByteData; if Result then
int64Data := enumData.ByteData;
End; End;
otSWord : otSWord :
Begin Begin
AStore.Get(pt,APropInfo.NameSpace,propName,enumData.SmallIntData); Result := AStore.Get(pt,APropInfo.NameSpace,propName,enumData.SmallIntData);
int64Data := enumData.SmallIntData; if Result then
int64Data := enumData.SmallIntData;
End; End;
otUWord : otUWord :
Begin Begin
AStore.Get(pt,APropInfo.NameSpace,propName,enumData.WordData); Result := AStore.Get(pt,APropInfo.NameSpace,propName,enumData.WordData);
int64Data := enumData.WordData; if Result then
int64Data := enumData.WordData;
End; End;
otSLong: otSLong:
Begin Begin
AStore.Get(pt,APropInfo.NameSpace,propName,enumData.SLongIntData); Result := AStore.Get(pt,APropInfo.NameSpace,propName,enumData.SLongIntData);
int64Data := enumData.SLongIntData; if Result then
int64Data := enumData.SLongIntData;
End; End;
otULong : otULong :
Begin Begin
AStore.Get(pt,APropInfo.NameSpace,propName,enumData.ULongIntData); Result := AStore.Get(pt,APropInfo.NameSpace,propName,enumData.ULongIntData);
int64Data := enumData.ULongIntData; if Result then
int64Data := enumData.ULongIntData;
End; End;
else
Result := False;
End; End;
SetOrdProp(AObject,APropInfo.PropInfo,int64Data); if Result then
SetOrdProp(AObject,APropInfo.PropInfo,int64Data);
{$IFDEF WST_DELPHI} {$IFDEF WST_DELPHI}
end; end;
{$ENDIF} {$ENDIF}
end; end;
procedure StringReaderQualified( function StringReaderQualified(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); ) : Boolean;
var var
locName : string; locName : string;
locData : string; locData : string;
begin begin
locData := ''; locData := '';
locName := APropInfo.ExternalName; locName := APropInfo.ExternalName;
AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData); Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData);
SetStrProp(AObject,APropInfo.PropInfo,locData); if Result then
SetStrProp(AObject,APropInfo.PropInfo,locData);
end; end;
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
procedure UnicodeStringReaderQualified( function UnicodeStringReaderQualified(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); ) : Boolean;
var var
locName : string; locName : string;
locData : UnicodeString; locData : UnicodeString;
begin begin
locData := ''; locData := '';
locName := APropInfo.ExternalName; locName := APropInfo.ExternalName;
AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData); Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData);
SetUnicodeStrProp(AObject,APropInfo.PropInfo,locData); if Result then
SetUnicodeStrProp(AObject,APropInfo.PropInfo,locData);
end; end;
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
procedure WideStringReaderQualified( function WideStringReaderQualified(
AObject : TObject; AObject : TObject;
APropInfo : TPropSerializationInfo; APropInfo : TPropSerializationInfo;
AStore : IFormatterBase AStore : IFormatterBase
); ) : Boolean;
var var
locName : string; locName : string;
locData : WideString; locData : WideString;
begin begin
locData := ''; locData := '';
locName := APropInfo.ExternalName; locName := APropInfo.ExternalName;
AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData); Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData);
SetWideStrProp(AObject,APropInfo.PropInfo,locData); if Result then
SetWideStrProp(AObject,APropInfo.PropInfo,locData);
end; end;
// Simple Writers // Simple Writers
@ -1005,47 +1061,55 @@ end;
type type
TReaderWriterInfo = record TReaderInfo = record
Simple : TPropertyReadProc; Simple : TPropertyReadProc;
Qualified : TPropertyReadProc; Qualified : TPropertyReadProc;
end; end;
TWriterInfo = record
Simple : TPropertyWriteProc;
Qualified : TPropertyWriteProc;
end;
var var
{$IFDEF FPC} {$IFDEF FPC}
ReaderWriterInfoMap : array[0..1] of array[TTypeKind] of TReaderWriterInfo = ( //ReaderWriterInfoMap : array[0..1] of array[TTypeKind] of TReaderWriterInfo = (
( // Readers ReaderInfoMap : array[TTypeKind] of TReaderInfo = (
( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkUnknown // Readers
( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkUnknown
( Simple : @IntEnumReader; Qualified : @IntEnumReaderQualified ;) , //tkInteger ( Simple : @IntEnumReader; Qualified : @IntEnumReaderQualified ;) , //tkInteger
( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkChar ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkChar
( Simple : @IntEnumReader; Qualified : @IntEnumReaderQualified ;) , //tkEnumeration ( Simple : @IntEnumReader; Qualified : @IntEnumReaderQualified ;) , //tkEnumeration
( Simple : @FloatReader; Qualified : @FloatReaderQualified ;) , //tkFloat ( Simple : @FloatReader; Qualified : @FloatReaderQualified ;) , //tkFloat
( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkSet ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkSet
( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkMethod ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkMethod
( Simple : @StringReader; Qualified : @StringReaderQualified ;) , //tkSString ( Simple : @StringReader; Qualified : @StringReaderQualified ;) , //tkSString
( Simple : @StringReader; Qualified : @StringReaderQualified ;) , //tkLString ( Simple : @StringReader; Qualified : @StringReaderQualified ;) , //tkLString
( Simple : @StringReader; Qualified : @StringReaderQualified ;) , //tkAString ( Simple : @StringReader; Qualified : @StringReaderQualified ;) , //tkAString
( Simple : @WideStringReader; Qualified : @WideStringReaderQualified ;) , //tkWString ( Simple : @WideStringReader; Qualified : @WideStringReaderQualified ;) , //tkWString
( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkVariant ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkVariant
( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkArray ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkArray
( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkRecord ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkRecord
( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkInterface ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkInterface
( Simple : @ClassReader; Qualified : @ClassReaderQualified ;) , //tkClass ( Simple : @ClassReader; Qualified : @ClassReaderQualified ;) , //tkClass
( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkObject ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkObject
( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkWChar ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkWChar
( Simple : @BoolReader; Qualified : @BoolReaderQualifier ;) , //tkBool ( Simple : @BoolReader; Qualified : @BoolReaderQualifier ;) , //tkBool
( Simple : @Int64Reader; Qualified : @Int64ReaderQualified ;) , //tkInt64 ( Simple : @Int64Reader; Qualified : @Int64ReaderQualified ;) , //tkInt64
( Simple : @Int64Reader; Qualified : @Int64ReaderQualified ;) , //tkQWord ( Simple : @Int64Reader; Qualified : @Int64ReaderQualified ;) , //tkQWord
( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkDynArray ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkDynArray
( Simple : @ErrorProc; Qualified : @ErrorProc ;) //tkInterfaceRaw ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) //tkInterfaceRaw
{$IFDEF WST_TKPROCVAR} {$IFDEF WST_TKPROCVAR}
,( Simple : @ErrorProc; Qualified : @ErrorProc ;) //tkProcVar ,( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) //tkProcVar
{$ENDIF WST_TKPROCVAR} {$ENDIF WST_TKPROCVAR}
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
,( Simple : @UnicodeStringReader; Qualified : @UnicodeStringReaderQualified ;) //tkUString ,( Simple : @UnicodeStringReader; Qualified : @UnicodeStringReaderQualified ;) //tkUString
,( Simple : @ErrorProc; Qualified : @ErrorProc ;) //tkUChar ,( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) //tkUChar
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
), );
( // Writers
WriterInfoMap : array[TTypeKind] of TWriterInfo = (
// Writers
( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkUnknown ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkUnknown
( Simple : @IntEnumWriter; Qualified : @IntEnumWriterQualified ;) , //tkInteger ( Simple : @IntEnumWriter; Qualified : @IntEnumWriterQualified ;) , //tkInteger
( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkChar ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkChar
@ -1076,36 +1140,38 @@ var
,( Simple : @UnicodeStringWriter; Qualified : @UnicodeStringWriterQualified ;) //tkUString ,( Simple : @UnicodeStringWriter; Qualified : @UnicodeStringWriterQualified ;) //tkUString
,( Simple : @ErrorProc; Qualified : @ErrorProc ;) //tkUChar ,( Simple : @ErrorProc; Qualified : @ErrorProc ;) //tkUChar
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
)
); );
{$ENDIF FPC} {$ENDIF FPC}
{$IFDEF WST_DELPHI} {$IFDEF WST_DELPHI}
ReaderWriterInfoMap : array[0..1] of array[TTypeKind] of TReaderWriterInfo = ( ReaderInfoMap : array[TTypeKind] of TReaderInfo = (
( // Readers // Readers
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkUnknown ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkUnknown
( Simple : IntEnumReader; Qualified : IntEnumReaderQualified ;) , //tkInteger ( Simple : IntEnumReader; Qualified : IntEnumReaderQualified ;) , //tkInteger
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkChar ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkChar
( Simple : IntEnumReader; Qualified : IntEnumReaderQualified ;) , //tkEnumeration ( Simple : IntEnumReader; Qualified : IntEnumReaderQualified ;) , //tkEnumeration
( Simple : FloatReader; Qualified : FloatReaderQualified ;) , //tkFloat ( Simple : FloatReader; Qualified : FloatReaderQualified ;) , //tkFloat
( Simple : StringReader; Qualified : StringReaderQualified ;) , //tkString ( Simple : StringReader; Qualified : StringReaderQualified ;) , //tkString
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkSet ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkSet
( Simple : ClassReader; Qualified : ClassReaderQualified ;) , //tkClass ( Simple : ClassReader; Qualified : ClassReaderQualified ;) , //tkClass
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkMethod ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkMethod
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkWChar ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkWChar
( Simple : StringReader; Qualified : StringReaderQualified ;) , //tkLString ( Simple : StringReader; Qualified : StringReaderQualified ;) , //tkLString
( Simple : WideStringReader; Qualified : WideStringReaderQualified ;) , //tkWString ( Simple : WideStringReader; Qualified : WideStringReaderQualified ;) , //tkWString
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkVariant ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkVariant
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkArray ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkArray
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkRecord ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkRecord
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkInterface ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkInterface
( Simple : Int64Reader; Qualified : Int64ReaderQualified ;) , //tkInt64 ( Simple : Int64Reader; Qualified : Int64ReaderQualified ;) , //tkInt64
( Simple : ErrorProc; Qualified : ErrorProc ;) //tkDynArray ( Simple : ErrorFunc; Qualified : ErrorFunc ;) //tkDynArray
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
,( Simple : UnicodeStringReader; Qualified : UnicodeStringReaderQualified ;) //tkUString ,( Simple : UnicodeStringReader; Qualified : UnicodeStringReaderQualified ;) //tkUString
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
), );
( // Writers
WriterInfoMap : array[TTypeKind] of TWriterInfo = (
// Writers
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkUnknown ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkUnknown
( Simple : IntEnumWriter; Qualified : IntEnumWriterQualified ;) , //tkInteger ( Simple : IntEnumWriter; Qualified : IntEnumWriterQualified ;) , //tkInteger
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkChar ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkChar
@ -1127,8 +1193,7 @@ var
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
,( Simple : UnicodeStringWriter; Qualified : UnicodeStringWriterQualified ;) //tkUString ,( Simple : UnicodeStringWriter; Qualified : UnicodeStringWriterQualified ;) //tkUString
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
) );
);
{$ENDIF WST_DELPHI} {$ENDIF WST_DELPHI}
{ TObjectSerializer } { TObjectSerializer }
@ -1170,8 +1235,8 @@ begin
serInfo.FName := ppi^.Name; serInfo.FName := ppi^.Name;
serInfo.FPersisteType := st; serInfo.FPersisteType := st;
serInfo.FPropInfo := ppi; serInfo.FPropInfo := ppi;
serInfo.FReaderProc := ReaderWriterInfoMap[0][ppi^.PropType^.Kind].Simple; serInfo.FReaderProc := ReaderInfoMap[ppi^.PropType^.Kind].Simple;
serInfo.FWriterProc := ReaderWriterInfoMap[1][ppi^.PropType^.Kind].Simple; serInfo.FWriterProc := WriterInfoMap[ppi^.PropType^.Kind].Simple;
if Target.IsAttributeProperty(ppi^.Name) then if Target.IsAttributeProperty(ppi^.Name) then
serInfo.FStyle := ssAttibuteSerialization serInfo.FStyle := ssAttibuteSerialization
else else
@ -1194,8 +1259,8 @@ begin
if ( thisRegItem.NameSpace <> regItem.NameSpace ) then begin if ( thisRegItem.NameSpace <> regItem.NameSpace ) then begin
serInfo.FNameSpace := regItem.NameSpace; serInfo.FNameSpace := regItem.NameSpace;
serInfo.FQualifiedName := True; serInfo.FQualifiedName := True;
serInfo.FReaderProc := ReaderWriterInfoMap[0][ppi^.PropType^.Kind].Qualified; serInfo.FReaderProc := ReaderInfoMap[ppi^.PropType^.Kind].Qualified;
serInfo.FWriterProc := ReaderWriterInfoMap[1][ppi^.PropType^.Kind].Qualified; serInfo.FWriterProc := WriterInfoMap[ppi^.PropType^.Kind].Qualified;
end; end;
end; end;
end; end;
@ -1294,13 +1359,10 @@ begin
locSerInfo := TPropSerializationInfo(FSerializationInfos[i]); locSerInfo := TPropSerializationInfo(FSerializationInfos[i]);
if ( locSerInfo.Style <> AStore.GetSerializationStyle() ) then if ( locSerInfo.Style <> AStore.GetSerializationStyle() ) then
AStore.SetSerializationStyle(locSerInfo.Style); AStore.SetSerializationStyle(locSerInfo.Style);
try if ( not locSerInfo.ReaderProc(AObject,locSerInfo,AStore) ) and
locSerInfo.ReaderProc(AObject,locSerInfo,AStore); ( locSerInfo.PersisteType = pstAlways )
except then begin
on e : EBaseRemoteException do begin AStore.Error(SERR_ParamaterNotFound,[locSerInfo.ExternalName]);
if ( locSerInfo.PersisteType = pstAlways ) then
raise;
end;
end; end;
end; end;
end; end;

View File

@ -697,6 +697,7 @@ begin
if ( A = nil ) and ( B = nil ) then begin if ( A = nil ) and ( B = nil ) then begin
Result := True Result := True
end else if ( A <> nil ) and ( B <> nil ) then begin end else if ( A <> nil ) and ( B <> nil ) then begin
Result := False;
if ( A^.NilObject = B^.NilObject ) and if ( A^.NilObject = B^.NilObject ) and
( A^.Count = B^.Count ) and ( A^.Count = B^.Count ) and
( CompareNodes(A^.InnerData,B^.InnerData) ) ( CompareNodes(A^.InnerData,B^.InnerData) )
@ -730,7 +731,7 @@ var
ok : Boolean; ok : Boolean;
begin begin
if ( A = nil ) and ( B = nil ) then begin if ( A = nil ) and ( B = nil ) then begin
Result := True ok := True
end else if ( A <> nil ) and ( B <> nil ) then begin end else if ( A <> nil ) and ( B <> nil ) then begin
if ( A^.Count = B^.Count ) then begin if ( A^.Count = B^.Count ) then begin
ok := True; ok := True;
@ -748,7 +749,7 @@ begin
ok := False; ok := False;
end; end;
end else begin end else begin
Result := ok; ok := False;
end; end;
Result := ok; Result := ok;
end; end;
@ -4850,7 +4851,7 @@ const
{$ENDIF FPC} {$ENDIF FPC}
{$IFDEF DELPHI} {$IFDEF DELPHI}
s_XML_BUFFER : AnsiString = s_XML_BUFFER : AnsiString =
'<ns1:ObjProperty xmlns:ns2uri:testnamespace> ' + '<ns1:ObjProperty xmlns:ns1uri:testnamespace> ' +
' <ns1:fieldSmallint>1</ns1:fieldSmallint> ' + ' <ns1:fieldSmallint>1</ns1:fieldSmallint> ' +
' <ns1:fieldWord>0</ns1:fieldWord> ' + ' <ns1:fieldWord>0</ns1:fieldWord> ' +
' <ns1:fieldString>SampleStringContent</ns1:fieldString> ' + ' <ns1:fieldString>SampleStringContent</ns1:fieldString> ' +
@ -4890,7 +4891,7 @@ begin
f.BeginObjectRead(strName,TypeInfo(TClass_A)); f.BeginObjectRead(strName,TypeInfo(TClass_A));
strName := 'inst'; strName := 'inst';
f.BeginObjectRead(strName,TypeInfo(TTestSmallClass2)); f.BeginObjectRead(strName,TypeInfo(TTestSmallClass2));
strBuffer := f.ReadBuffer('ObjProperty'); Check(f.ReadBuffer('ObjProperty',strBuffer));
f.EndScopeRead(); f.EndScopeRead();
f.EndScopeRead(); f.EndScopeRead();
CheckEquals(SpecialTrim(s_XML_BUFFER),SpecialTrim(strBuffer)); CheckEquals(SpecialTrim(s_XML_BUFFER),SpecialTrim(strBuffer));

View File

@ -21,7 +21,11 @@ resourcestring
SERR_InvalidCollectionLength = 'Invalid collection length : %d.'; SERR_InvalidCollectionLength = 'Invalid collection length : %d.';
SERR_InvalidHourOffetValue = '"%d" is not a valid hour offset value.'; SERR_InvalidHourOffetValue = '"%d" is not a valid hour offset value.';
SERR_InvalidMinuteOffetValue = '"%d" is not a valid minute offset value.'; SERR_InvalidMinuteOffetValue = '"%d" is not a valid minute offset value.';
SERR_InvalidParameter = 'Invalid parameter : "%s".'; SERR_InvalidParameter = 'Invalid parameter : "%s".';
SERR_NoReaderProc = 'No reader proc for that type, Prop : "(%s : %s)".';
SERR_NoSerializerFoThisType = 'No serializer for this type : "%s".';
SERR_ParamaterNotFound = 'Parameter non found : "%s".';
SERR_SerializerInitializationException = 'Unable to initialize the serializer of that type : "%s".';
implementation implementation