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

Better handling of "LowgWord" and "QWord" in the serializers.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@852 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2009-06-17 19:03:05 +00:00
parent da9be87c61
commit 423ca16d13
6 changed files with 364 additions and 66 deletions
Download Patch File Download Diff File Expand all files Collapse all files

77
wst/trunk/base_binary_formatter.pas
View File

@ -285,6 +285,13 @@ type
Const ATypeInfo : PTypeInfo;
Const AData : Int64
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF HAS_QWORD}
procedure PutUInt64(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : QWord
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF HAS_QWORD}
procedure PutObj(
Const AName : String;
Const ATypeInfo : PTypeInfo;
@ -332,6 +339,13 @@ type
Var AName : String;
Var AData : Int64
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF HAS_QWORD}
procedure GetUInt64(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : QWord
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF}
procedure GetAnsiStr(
Const ATypeInfo : PTypeInfo;
Var AName : String;
@ -1119,6 +1133,17 @@ begin
StackTop().CreateBuffer(AName,dtInt64S)^.Int64S := AData;
end;
{$IFDEF HAS_QWORD}
procedure TBaseBinaryFormatter.PutUInt64(
const AName: String;
const ATypeInfo: PTypeInfo;
const AData: QWord
);
begin
StackTop().CreateBuffer(AName,dtInt64U)^.Int64U := AData;
end;
{$ENDIF HAS_QWORD}
procedure TBaseBinaryFormatter.PutObj(
const AName: String;
const ATypeInfo: PTypeInfo;
@ -1229,6 +1254,17 @@ begin
AData := GetDataBuffer(AName)^.Int64S;
end;
{$IFDEF HAS_QWORD}
procedure TBaseBinaryFormatter.GetUInt64(
const ATypeInfo: PTypeInfo;
var AName: String;
var AData: QWord
);
begin
AData := GetDataBuffer(AName)^.Int64U;
end;
{$ENDIF HAS_QWORD}
procedure TBaseBinaryFormatter.GetAnsiStr(
const ATypeInfo: PTypeInfo;
var AName: String;
@ -1404,6 +1440,9 @@ end;
procedure TBaseBinaryFormatter.Put(const AName: String; const ATypeInfo: PTypeInfo;const AData);
Var
int64Data : Int64;
{$IFDEF HAS_QWORD}
uint64Data : QWOrd;
{$ENDIF HAS_QWORD}
ansiStrData : AnsiString;
objData : TObject;
boolData : Boolean;
@ -1444,11 +1483,18 @@ begin
PutUnicodeStr(AName,ATypeInfo,unicodeStrData);
end;
{$ENDIF WST_UNICODESTRING}
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
tkInt64 :
Begin
int64Data := Int64(AData);
PutInt64(AName,ATypeInfo,int64Data);
End;
{$IFDEF HAS_QWORD}
tkQWord :
Begin
uint64Data := QWord(AData);
PutUInt64(AName,ATypeInfo,uint64Data);
End;
{$ENDIF HAS_QWORD}
tkClass :
Begin
objData := TObject(AData);
@ -1523,7 +1569,9 @@ procedure TBaseBinaryFormatter.PutScopeInnerValue(
);
var
int64SData : Int64;
{$IFDEF FPC}int64UData : QWord;{$ENDIF}
{$IFDEF HAS_QWORD}
uint64Data : QWord;
{$ENDIF HAS_QWORD}
strData : string;
boolData : Boolean;
enumData : TEnumData;
@ -1569,13 +1617,13 @@ begin
int64SData := Int64(AData);
StackTop().CreateInnerBuffer(dtInt64S)^.Int64S := int64SData;
end;
{$IFDEF FPC}
{$IFDEF HAS_QWORD}
tkQWord :
begin
int64UData := QWord(AData);
StackTop().CreateInnerBuffer(dtInt64U)^.Int64U := int64UData;
uint64Data := QWord(AData);
StackTop().CreateInnerBuffer(dtInt64U)^.Int64U := uint64Data;
end;
{$ENDIF}
{$ENDIF HAS_QWORD}
tkClass, tkRecord :
begin
raise EBinaryFormatterException.Create('Inner Scope value must be a "simple type" value.');
@ -1690,6 +1738,9 @@ procedure TBaseBinaryFormatter.Get(
);
Var
int64Data : Int64;
{$IFDEF HAS_QWORD}
uint64Data : QWOrd;
{$ENDIF HAS_QWORD}
strData : AnsiString;
objData : TObject;
boolData : Boolean;
@ -1704,12 +1755,20 @@ Var
wideCharData : WideChar;
begin
Case ATypeInfo^.Kind Of
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
tkInt64 :
Begin
int64Data := 0;
GetInt64(ATypeInfo,AName,int64Data);
Int64(AData) := int64Data;
End;
{$IFDEF HAS_QWORD}
tkQWord :
Begin
uint64Data := 0;
GetUInt64(ATypeInfo,AName,uint64Data);
QWord(AData) := uint64Data;
End;
{$ENDIF HAS_QWORD}
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
Begin
strData := '';
@ -1829,9 +1888,9 @@ begin
tkChar : AnsiChar(AData) := dataBuffer^.AnsiCharData ;
tkWChar : WideChar(AData) := dataBuffer^.WideCharData ;
tkInt64 : Int64(AData) := dataBuffer^.Int64S;
{$IFDEF FPC}
{$IFDEF HAS_QWORD}
tkQWord : QWord(AData) := dataBuffer^.Int64U;
{$ENDIF}
{$ENDIF HAS_QWORD}
tkLString
{$IFDEF FPC},

119
wst/trunk/base_json_formatter.pas
View File

@ -71,6 +71,12 @@ type
Const AName : string;
const AValue : Int64
) : TJSONData;virtual;
{$IFDEF HAS_QWORD}
function CreateUInt64Buffer(
Const AName : string;
const AValue : QWord
) : TJSONData;virtual;
{$ENDIF HAS_QWORD}
function CreateFloatBuffer(
Const AName : string;
const AValue : TJSONFloat
@ -223,6 +229,13 @@ type
Const ATypeInfo : PTypeInfo;
Const AData : Int64
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF HAS_QWORD}
procedure PutUInt64(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : QWord
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF HAS_QWORD}
procedure PutStr(
Const AName : String;
Const ATypeInfo : PTypeInfo;
@ -289,6 +302,13 @@ type
Var AName : String;
Var AData : Int64
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF HAS_QWORD}
procedure GetUInt64(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : QWord
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF HAS_QWORD}
procedure GetFloat(
Const ATypeInfo : PTypeInfo;
Var AName : String;
@ -506,6 +526,17 @@ begin
StackTop().CreateInt64Buffer(AName,AData);
end;
{$IFDEF HAS_QWORD}
procedure TJsonRpcBaseFormatter.PutUInt64(
const AName : String;
const ATypeInfo : PTypeInfo;
const AData : QWord
);
begin
StackTop().CreateUInt64Buffer(AName,AData);
end;
{$ENDIF HAS_QWORD}
procedure TJsonRpcBaseFormatter.PutStr(
const AName : String;
const ATypeInfo : PTypeInfo;
@ -641,6 +672,34 @@ begin
AData := Round(locBuffer.AsFloat);
end;
{$IFDEF HAS_QWORD}
procedure TJsonRpcBaseFormatter.GetUInt64(
const ATypeInfo : PTypeInfo;
var AName : String;
var AData : QWord
);
var
locBuffer : TJSONData;
locExtData : TJSONFloat;
tmp : QWord;
begin
locBuffer := GetDataBuffer(AName);
if ( locBuffer.JSONType = jtNumber ) and ( TJSONNumber(locBuffer).NumberType = ntInteger ) then begin
AData := locBuffer.AsInteger
end else begin
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;
{$ENDIF HAS_QWORD}
procedure TJsonRpcBaseFormatter.GetFloat(
const ATypeInfo : PTypeInfo;
var AName : String;
@ -874,6 +933,9 @@ procedure TJsonRpcBaseFormatter.Put(
);
Var
int64Data : Int64;
{$IFDEF HAS_QWORD}
uint64Data : QWord;
{$ENDIF HAS_QWORD}
strData : string;
objData : TObject;
boolData : Boolean;
@ -914,11 +976,18 @@ begin
wideStrData := WideString(AData);
PutWideStr(AName,ATypeInfo,wideStrData);
end;
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
tkInt64 :
Begin
int64Data := Int64(AData);
PutInt64(AName,ATypeInfo,int64Data);
End;
{$IFDEF HAS_QWORD}
tkQWord :
Begin
uint64Data := QWord(AData);
PutUInt64(AName,ATypeInfo,uint64Data);
End;
{$ENDIF HAS_QWORD}
tkClass :
Begin
objData := TObject(AData);
@ -991,6 +1060,9 @@ procedure TJsonRpcBaseFormatter.PutScopeInnerValue(const ATypeInfo : PTypeInfo;
var
locName : string;
int64Data : Int64;
{$IFDEF HAS_QWORD}
uint64Data : QWord;
{$ENDIF HAS_QWORD}
strData : string;
objData : TObject;
boolData : Boolean;
@ -1032,11 +1104,18 @@ begin
PutUnicodeStr(locName,ATypeInfo,unicodeStrData);
end;
{$ENDIF WST_UNICODESTRING}
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
tkInt64 :
Begin
int64Data := Int64(AData);
PutInt64(locName,ATypeInfo,int64Data);
End;
{$IFDEF HAS_QWORD}
tkQWord :
Begin
uint64Data := QWord(AData);
PutUInt64(locName,ATypeInfo,uint64Data);
End;
{$ENDIF HAS_QWORD}
tkClass, tkRecord :
begin
raise EJsonRpcException.Create('Inner Scope value must be a "simple type" value.');
@ -1097,6 +1176,9 @@ procedure TJsonRpcBaseFormatter.Get(
);
Var
int64Data : Int64;
{$IFDEF HAS_QWORD}
uint64Data : QWord;
{$ENDIF HAS_QWORD}
strData : string;
objData : TObject;
boolData : Boolean;
@ -1123,12 +1205,20 @@ begin
GetWideChar(ATypeInfo,AName,wideCharData);
WideChar(AData) := wideCharData;
end;
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
tkInt64 :
Begin
int64Data := 0;
GetInt64(ATypeInfo,AName,int64Data);
Int64(AData) := int64Data;
End;
{$IFDEF HAS_QWORD}
tkQWord :
Begin
uint64Data := 0;
GetUInt64(ATypeInfo,AName,uint64Data);
QWord(AData) := uint64Data;
End;
{$ENDIF HAS_QWORD}
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
Begin
strData := '';
@ -1227,6 +1317,9 @@ procedure TJsonRpcBaseFormatter.GetScopeInnerValue(const ATypeInfo : PTypeInfo;
var
locName : string;
int64Data : Int64;
{$IFDEF HAS_QWORD}
uint64Data : QWord;
{$ENDIF HAS_QWORD}
strData : string;
objData : TObject;
boolData : Boolean;
@ -1254,12 +1347,20 @@ begin
GetWideChar(ATypeInfo,locName,wideCharData);
WideChar(AData) := wideCharData;
end;
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
tkInt64 :
Begin
int64Data := 0;
GetInt64(ATypeInfo,locName,int64Data);
Int64(AData) := int64Data;
End;
{$IFDEF HAS_QWORD}
tkQWord :
Begin
uint64Data := 0;
GetUInt64(ATypeInfo,locName,uint64Data);
QWord(AData) := uint64Data;
End;
{$ENDIF HAS_QWORD}
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
Begin
strData := '';
@ -1453,6 +1554,16 @@ begin
Result := CreateFloatBuffer(AName,AValue);
end;
{$IFDEF HAS_QWORD}
function TStackItem.CreateUInt64Buffer(
const AName : string;
const AValue : QWord
) : TJSONData;
begin
Result := CreateFloatBuffer(AName,AValue);
end;
{$ENDIF HAS_QWORD}
{ TObjectStackItem }
function TObjectStackItem.GetDataObject() : TJSONObject;

111
wst/trunk/base_soap_formatter.pas
View File

@ -186,6 +186,14 @@ type
Const ATypeInfo : PTypeInfo;
Const AData : Int64
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF HAS_QWORD}
function PutUInt64(
const ANameSpace : string;
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : QWord
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF HAS_QWORD}
function PutStr(
const ANameSpace : string;
Const AName : String;
@ -262,6 +270,14 @@ type
Var AName : String;
Var AData : Int64
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF HAS_QWORD}
procedure GetUInt64(
Const ATypeInfo : PTypeInfo;
const ANameSpace : string;
Var AName : String;
Var AData : QWord
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF HAS_QWORD}
procedure GetFloat(
Const ATypeInfo : PTypeInfo;
const ANameSpace : string;
@ -918,6 +934,18 @@ begin
Result := InternalPutData(ANameSpace,AName,ATypeInfo,IntToStr(AData));
end;
{$IFDEF HAS_QWORD}
function TSOAPBaseFormatter.PutUInt64(
const ANameSpace : string;
const AName : String;
const ATypeInfo : PTypeInfo;
const AData : QWord
): TDOMNode;
begin
Result := InternalPutData(ANameSpace,AName,ATypeInfo,IntToStr(AData));
end;
{$ENDIF HAS_QWORD}
function TSOAPBaseFormatter.PutStr(
const ANameSpace : string;
const AName: String;
@ -1099,6 +1127,18 @@ begin
AData := StrToInt64Def(Trim(GetNodeValue(ANameSpace,AName)),0);
end;
{$IFDEF HAS_QWORD}
procedure TSOAPBaseFormatter.GetUInt64(
const ATypeInfo : PTypeInfo;
const ANameSpace : string;
var AName : String;
var AData : QWord
);
begin
AData := StrToQWordDef(Trim(GetNodeValue(ANameSpace,AName)),0);
end;
{$ENDIF HAS_QWORD}
procedure TSOAPBaseFormatter.GetFloat(
const ATypeInfo : PTypeInfo;
const ANameSpace : string;
@ -1654,6 +1694,9 @@ procedure TSOAPBaseFormatter.Put(
);
Var
int64Data : Int64;
{$IFDEF HAS_QWORD}
uint64Data : QWord;
{$ENDIF HAS_QWORD}
strData : string;
objData : TObject;
boolData : Boolean;
@ -1677,11 +1720,18 @@ begin
wideCharData := WideChar(AData);
PutWideChar(ANameSpace,AName,ATypeInfo,wideCharData);
end;
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
tkInt64 :
Begin
int64Data := Int64(AData);
PutInt64(ANameSpace,AName,ATypeInfo,int64Data);
End;
{$IFDEF HAS_QWORD}
tkQWord :
Begin
uint64Data := QWord(AData);
PutUInt64(ANameSpace,AName,ATypeInfo,uint64Data);
End;
{$ENDIF HAS_QWORD}
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
Begin
strData := String(AData);
@ -1731,8 +1781,8 @@ begin
otUByte : enumData := Byte(AData);
otSWord : enumData := SmallInt(AData);
otUWord : enumData := Word(AData);
otSLong,
otULong : enumData := LongInt(AData);
otSLong : enumData := LongInt(AData);
otULong : enumData := LongWord(AData);
End;
If ( ATypeInfo^.Kind = tkInteger ) Then
PutInt64(ANameSpace,AName,ATypeInfo,enumData)
@ -1772,10 +1822,12 @@ procedure TSOAPBaseFormatter.PutScopeInnerValue(
);
Var
int64SData : Int64;
{$IFDEF FPC}
int64UData : QWord;
boolData : Boolean;
{$ENDIF}
{$IFDEF FPC}
boolData : Boolean;
{$ENDIF FPC}
{$IFDEF HAS_QWORD}
uint64Data : QWord;
{$ENDIF HAS_QWORD}
strData : string;
enumData : TEnumIntType;
floatDt : Extended;
@ -1804,13 +1856,13 @@ begin
int64SData := Int64(AData);
dataBuffer := IntToStr(int64SData);
end;
{$IFDEF FPC}
{$IFDEF HAS_QWORD}
tkQWord :
begin
int64UData := QWord(AData);
dataBuffer := IntToStr(int64UData);
uint64Data := QWord(AData);
dataBuffer := IntToStr(uint64Data);
end;
{$ENDIF}
{$ENDIF HAS_QWORD}
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
begin
strData := string(AData);
@ -1846,8 +1898,8 @@ begin
otUByte : enumData := Byte(AData);
otSWord : enumData := SmallInt(AData);
otUWord : enumData := Word(AData);
otSLong,
otULong : enumData := LongInt(AData);
otSLong : enumData := LongInt(AData);
otULong : enumData := LongWord(AData);
end;
dataBuffer := IntToStr(enumData);
end;
@ -1859,8 +1911,8 @@ begin
otUByte : enumData := Byte(AData);
otSWord : enumData := SmallInt(AData);
otUWord : enumData := Word(AData);
otSLong,
otULong : enumData := LongInt(AData);
otSLong : enumData := LongInt(AData);
otULong : enumData := LongWord(AData);
end;
dataBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetExternalPropertyName(GetEnumName(ATypeInfo,enumData))
end;
@ -1888,6 +1940,9 @@ procedure TSOAPBaseFormatter.Get(
);
Var
int64Data : Int64;
{$IFDEF HAS_QWORD}
uint64Data : QWord;
{$ENDIF HAS_QWORD}
strData : string;
objData : TObject;
boolData : Boolean;
@ -1914,12 +1969,20 @@ begin
GetWideChar(ATypeInfo,ANameSpace,AName,wideCharData);
WideChar(AData) := wideCharData;
end;
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
tkInt64 :
Begin
int64Data := 0;
GetInt64(ATypeInfo,ANameSpace,AName,int64Data);
Int64(AData) := int64Data;
End;
{$IFDEF HAS_QWORD}
tkQWord :
Begin
uint64Data := 0;
GetUInt64(ATypeInfo,ANameSpace,AName,uint64Data);
QWord(AData) := uint64Data;
End;
{$ENDIF HAS_QWORD}
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
Begin
strData := '';
@ -1980,8 +2043,8 @@ begin
otUByte : Byte(AData) := enumData;
otSWord : SmallInt(AData) := enumData;
otUWord : Word(AData) := enumData;
otSLong,
otULong : LongInt(AData) := enumData;
otSLong : LongInt(AData) := enumData;
otULong : LongWord(AData) := enumData;
End;
{$IFDEF WST_DELPHI}
end;
@ -2045,9 +2108,9 @@ begin
WideChar(AData) := #0;
end;
tkInt64 : Int64(AData) := StrToInt64Def(Trim(dataBuffer),0);
{$IFDEF FPC}
tkQWord : QWord(AData) := StrToInt64Def(Trim(dataBuffer),0);
{$ENDIF}
{$IFDEF HAS_QWORD}
tkQWord : QWord(AData) := StrToQWordDef(Trim(dataBuffer),0);
{$ENDIF HAS_QWORD}
tkLString{$IFDEF FPC},tkAString{$ENDIF} : string(AData) := dataBuffer;
tkWString : WideString(AData) := dataBuffer;
{$IFDEF WST_UNICODESTRING}
@ -2070,7 +2133,7 @@ begin
tkInteger, tkEnumeration :
begin
if ( ATypeInfo^.Kind = tkInteger ) then
enumData := StrToIntDef(Trim(dataBuffer),0)
enumData := StrToInt64Def(Trim(dataBuffer),0)
else
enumData := GetEnumValue(ATypeInfo,GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(dataBuffer));
case GetTypeData(ATypeInfo)^.OrdType of
@ -2078,8 +2141,8 @@ begin
otUByte : Byte(AData) := enumData;
otSWord : SmallInt(AData) := enumData;
otUWord : Word(AData) := enumData;
otSLong,
otULong : LongInt(AData) := enumData;
otSLong : LongInt(AData) := enumData;
otULong : LongWord(AData) := enumData;
end;
end;
tkFloat :

107
wst/trunk/base_xmlrpc_formatter.pas
View File

@ -201,6 +201,13 @@ type
Const ATypeInfo : PTypeInfo;
Const AData : Int64
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF HAS_QWORD}
function PutUInt64(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : QWord
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF HAS_QWORD}
function PutStr(
Const AName : String;
Const ATypeInfo : PTypeInfo;
@ -267,6 +274,13 @@ type
Var AName : String;
Var AData : Int64
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF HAS_QWORD}
procedure GetUInt64(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : QWord
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF HAS_QWORD}
procedure GetFloat(
Const ATypeInfo : PTypeInfo;
Var AName : String;
@ -858,6 +872,17 @@ begin
Result := InternalPutData(AName,xdtInt,IntToStr(AData));
end;
{$IFDEF HAS_QWORD}
function TXmlRpcBaseFormatter.PutUInt64(
const AName : String;
const ATypeInfo : PTypeInfo;
const AData : QWord
): TDOMNode;
begin
Result := InternalPutData(AName,xdtInt,IntToStr(AData));
end;
{$ENDIF HAS_QWORD}
function TXmlRpcBaseFormatter.PutStr(
const AName: String;
const ATypeInfo: PTypeInfo;
@ -1028,6 +1053,17 @@ begin
AData := StrToInt64Def(Trim(GetNodeValue(AName)),0);
end;
{$IFDEF HAS_QWORD}
procedure TXmlRpcBaseFormatter.GetUInt64(
const ATypeInfo : PTypeInfo;
var AName : String;
var AData : QWord
);
begin
AData := StrToQWordDef(Trim(GetNodeValue(AName)),0);
end;
{$ENDIF HAS_QWORD}
procedure TXmlRpcBaseFormatter.GetFloat(
const ATypeInfo : PTypeInfo;
var AName : String;
@ -1258,6 +1294,9 @@ procedure TXmlRpcBaseFormatter.Put(
);
Var
int64Data : Int64;
{$IFDEF HAS_QWORD}
uint64Data : QWord;
{$ENDIF HAS_QWORD}
strData : string;
objData : TObject;
{$IFDEF FPC}boolData : Boolean;{$ENDIF}
@ -1281,11 +1320,18 @@ begin
wideCharData := WideChar(AData);
PutWideChar(AName,ATypeInfo,wideCharData);
end;
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
tkInt64 :
Begin
int64Data := Int64(AData);
PutInt64(AName,ATypeInfo,int64Data);
End;
{$IFDEF HAS_QWORD}
tkQWord :
Begin
uint64Data := QWord(AData);
PutUInt64(AName,ATypeInfo,uint64Data);
End;
{$ENDIF HAS_QWORD}
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
Begin
strData := String(AData);
@ -1327,8 +1373,8 @@ begin
otUByte : enumData := Byte(AData);
otSWord : enumData := SmallInt(AData);
otUWord : enumData := Word(AData);
otSLong,
otULong : enumData := LongInt(AData);
otSLong : enumData := LongInt(AData);
otULong : enumData := LongWord(AData);
End;
If ( ATypeInfo^.Kind = tkInteger ) Then
PutInt64(AName,ATypeInfo,enumData)
@ -1365,10 +1411,12 @@ procedure TXmlRpcBaseFormatter.PutScopeInnerValue(
);
Var
int64SData : Int64;
{$IFDEF FPC}
int64UData : QWord;
boolData : Boolean;
{$ENDIF}
{$IFDEF HAS_QWORD}
uint64Data : QWord;
{$ENDIF HAS_QWORD}
{$IFDEF FPC}
boolData : Boolean;
{$ENDIF}
strData : string;
enumData : TEnumIntType;
floatDt : Extended;
@ -1397,13 +1445,13 @@ begin
int64SData := Int64(AData);
dataBuffer := IntToStr(int64SData);
end;
{$IFDEF FPC}
{$IFDEF HAS_QWORD}
tkQWord :
begin
int64UData := QWord(AData);
dataBuffer := IntToStr(int64UData);
uint64Data := QWord(AData);
dataBuffer := IntToStr(uint64Data);
end;
{$ENDIF}
{$ENDIF HAS_QWORD}
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
begin
strData := string(AData);
@ -1439,8 +1487,8 @@ begin
otUByte : enumData := Byte(AData);
otSWord : enumData := SmallInt(AData);
otUWord : enumData := Word(AData);
otSLong,
otULong : enumData := LongInt(AData);
otSLong : enumData := LongInt(AData);
otULong : enumData := LongWord(AData);
end;
dataBuffer := IntToStr(enumData);
end;
@ -1452,8 +1500,8 @@ begin
otUByte : enumData := Byte(AData);
otSWord : enumData := SmallInt(AData);
otUWord : enumData := Word(AData);
otSLong,
otULong : enumData := LongInt(AData);
otSLong : enumData := LongInt(AData);
otULong : enumData := LongWord(AData);
end;
dataBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetExternalPropertyName(GetEnumName(ATypeInfo,enumData))
end;
@ -1480,6 +1528,9 @@ procedure TXmlRpcBaseFormatter.Get(
);
Var
int64Data : Int64;
{$IFDEF HAS_QWORD}
uint64Data : QWord;
{$ENDIF HAS_QWORD}
strData : string;
objData : TObject;
{$IFDEF FPC}boolData : Boolean;{$ENDIF}
@ -1506,12 +1557,20 @@ begin
GetWideChar(ATypeInfo,AName,wideCharData);
WideChar(AData) := wideCharData;
end;
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
tkInt64 :
Begin
int64Data := 0;
GetInt64(ATypeInfo,AName,int64Data);
Int64(AData) := int64Data;
End;
{$IFDEF HAS_QWORD}
tkQWord :
Begin
uint64Data := 0;
GetUInt64(ATypeInfo,AName,uint64Data);
QWord(AData) := uint64Data;
End;
{$ENDIF HAS_QWORD}
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
Begin
strData := '';
@ -1563,8 +1622,8 @@ begin
otUByte : Byte(AData) := enumData;
otSWord : SmallInt(AData) := enumData;
otUWord : Word(AData) := enumData;
otSLong,
otULong : LongInt(AData) := enumData;
otSLong : LongInt(AData) := enumData;
otULong : LongWord(AData) := enumData;
End;
End;
tkFloat :
@ -1626,9 +1685,9 @@ begin
WideChar(AData) := #0;
end;
tkInt64 : Int64(AData) := StrToInt64Def(Trim(dataBuffer),0);
{$IFDEF FPC}
tkQWord : QWord(AData) := StrToInt64Def(Trim(dataBuffer),0);
{$ENDIF}
{$IFDEF HAS_QWORD}
tkQWord : QWord(AData) := StrToQWordDef(Trim(dataBuffer),0);
{$ENDIF HAS_QWORD}
tkLString{$IFDEF FPC},tkAString{$ENDIF} : string(AData) := dataBuffer;
tkWString : WideString(AData) := dataBuffer;
{$IFDEF WST_UNICODESTRING}
@ -1651,7 +1710,7 @@ begin
tkInteger, tkEnumeration :
begin
if ( ATypeInfo^.Kind = tkInteger ) then
enumData := StrToIntDef(Trim(dataBuffer),0)
enumData := StrToInt64Def(Trim(dataBuffer),0)
else
enumData := GetEnumValue(ATypeInfo,GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(dataBuffer));
case GetTypeData(ATypeInfo)^.OrdType of
@ -1659,8 +1718,8 @@ begin
otUByte : Byte(AData) := enumData;
otSWord : SmallInt(AData) := enumData;
otUWord : Word(AData) := enumData;
otSLong,
otULong : LongInt(AData) := enumData;
otSLong : LongInt(AData) := enumData;
otULong : LongWord(AData) := enumData;
end;
end;
tkFloat :

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

@ -1299,7 +1299,7 @@ begin
end;
procedure TTestFormatterSimpleType.Test_Int_32_ScopeData;
const VAL_1 = 121076; VAL_2 : LongInt = -101276;
const VAL_1 = 3294967295; VAL_2 : LongInt = -101276;
var
f : IFormatterBase;
s : TMemoryStream;
@ -1351,7 +1351,7 @@ begin
end;
procedure TTestFormatterSimpleType.Test_Int_64;
const VAL_1 = $FFFFFFFFFF; VAL_2 : Int64 = -$FFFFFFFFF0;
const VAL_1 = High(QWord) -1000; VAL_2 : Int64 = -$FFFFFFFFF0;
Var
f : IFormatterBase;
s : TMemoryStream;
@ -1393,7 +1393,7 @@ begin
end;
procedure TTestFormatterSimpleType.Test_Int_64_ScopeData;
const VAL_1 = 121076; VAL_2 : Int64 = -101276;
const VAL_1 = High(QWord) -1000; VAL_2 : Int64 = -101276;
var
f : IFormatterBase;
s : TMemoryStream;
@ -2118,7 +2118,11 @@ const
CONST_Val_16S = -$7FFF;
CONST_Val_32U = $FFFFFFFE;
CONST_Val_32S = -$7FFFFFFF;
{$IFDEF HAS_BUILT_IN_64UINT}
CONST_Val_64U = 18446744073709551604{ = $FFFFFFFFFFFFFFF4};
{$ELSE HAS_BUILT_IN_64UINT}
CONST_Val_64U = $FFFFFFFFFFFFF;
{$ENDIF HAS_BUILT_IN_64UINT}
CONST_Val_64S = -$FFFFFFFFFFFFF;
Var
f : IFormatterBase;
@ -5157,8 +5161,8 @@ end;
function TTestBinaryFormatterAttributes.CreateFormatter(ARootType: PTypeInfo): IFormatterBase;
begin
Result := TSOAPBaseFormatter.Create() as IFormatterBase;
Result.BeginObject('Env',ARootType);
Result := TBaseBinaryFormatter.Create() as IFormatterBase;
//Result.BeginObject('Root',ARootType);
Result.SetSerializationStyle(ssAttibuteSerialization);
end;

2
wst/trunk/wst_global.inc
View File

@ -9,6 +9,7 @@
{$IFDEF FPC}
{$mode objfpc}{$H+}
{$DEFINE HAS_QWORD}
{$DEFINE HAS_BUILT_IN_64UINT}
{$DEFINE HAS_TKBOOL}
{$UNDEF WST_INTF_DOM}
//{$DEFINE USE_INLINE}
@ -46,6 +47,7 @@
{$DEFINE HAS_FORMAT_SETTINGS}
{$ENDIF}
{$IFDEF VER200} // Delphi 2009
{$DEFINE HAS_BUILT_IN_64UINT}
{$DEFINE WST_UNICODESTRING}
{$DEFINE USE_INLINE}
{$ENDIF}