pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
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
Download Patch File Download Diff File Expand all files Collapse all files

301
wst/trunk/base_binary_formatter.pas
View File

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

353
wst/trunk/base_json_formatter.pas
View File

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

12
wst/trunk/base_service_intf.pas
View File

@ -195,22 +195,22 @@ type
const ATypeInfo : PTypeInfo;
const AData
);
procedure Get(
function Get(
const ATypeInfo : PTypeInfo;
var AName : string;
var AData
);overload;
procedure Get(
) : Boolean; overload;
function Get(
const ATypeInfo : PTypeInfo;
const ANameSpace : string;
var AName : string;
var AData
);overload;
) : Boolean; overload;
procedure GetScopeInnerValue(
const ATypeInfo : PTypeInfo;
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!
procedure WriteBuffer(const AValue : string);
@ -6078,7 +6078,7 @@ var
buffer : string;
locObj : TStringBufferRemotable;
begin
buffer := AStore.ReadBuffer(AName);
AStore.ReadBuffer(AName,buffer);
if ( AObject = nil ) then
AObject := Create();
locObj := AObject as TStringBufferRemotable;;

298
wst/trunk/base_soap_formatter.pas
View File

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

318
wst/trunk/base_xmlrpc_formatter.pas
View File

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

310
wst/trunk/object_serializer.pas
View File

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

9
wst/trunk/tests/test_suite/testformatter_unit.pas
View File

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

4
wst/trunk/wst_consts.pas
View File

@ -22,6 +22,10 @@ resourcestring
SERR_InvalidHourOffetValue = '"%d" is not a valid hour offset value.';
SERR_InvalidMinuteOffetValue = '"%d" is not a valid minute offset value.';
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