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

119
wst/trunk/base_json_formatter.pas
View File

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

111
wst/trunk/base_soap_formatter.pas
View File

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

107
wst/trunk/base_xmlrpc_formatter.pas
View File

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

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

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

2
wst/trunk/wst_global.inc
View File

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