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

AnsiChar and WideChar support in WST runtime

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@560 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2008-09-15 02:30:43 +00:00
parent 1e95624282
commit 2cb02c46ec
6 changed files with 696 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

109
wst/trunk/base_binary_formatter.pas
View File

@ -42,7 +42,7 @@ type
dtInt16U, dtInt16S,
dtInt32U, dtInt32S,
dtInt64U, dtInt64S,
dtBool, dtEnum,
dtBool, dtAnsiChar, dtWideChar, dtEnum,
dtSingle, dtDouble, dtExtended, dtCurrency,
dtAnsiString, dtWideString,
{$IFDEF WST_UNICODESTRING}
@ -72,6 +72,8 @@ type
dtInt64U : ( Int64U : TInt64U );
dtInt64S : ( Int64S : TInt64S );
dtBool : ( BoolData : TBoolData );
dtAnsiChar : ( AnsiCharData : TAnsiCharacter; );
dtWideChar : ( WideCharData : TWideCharacter; );
dtEnum : ( EnumData : TEnumData );
dtSingle : ( SingleData : TFloat_Single_4 );
dtDouble : ( DoubleData : TFloat_Double_8 );
@ -253,6 +255,16 @@ type
Const ATypeInfo : PTypeInfo;
Const AData : Boolean
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutAnsiChar(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : AnsiChar
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutWideChar(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : WideChar
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutInt64(
Const AName : String;
Const ATypeInfo : PTypeInfo;
@ -280,6 +292,16 @@ type
Var AName : String;
Var AData : Boolean
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetAnsiChar(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : AnsiChar
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetWideChar(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : WideChar
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetFloat(
Const ATypeInfo : PTypeInfo;
Var AName : String;
@ -648,6 +670,8 @@ Begin
dtUnicodeString : ADest.WriteUnicodeStr(ARoot^.UnicodeStrData^.Data);
{$ENDIF WST_UNICODESTRING}
dtBool : ADest.WriteBool(ARoot^.BoolData);
dtAnsiChar : ADest.WriteAnsiChar(ARoot^.AnsiCharData);
dtWideChar : ADest.WriteWideChar(ARoot^.WideCharData);
dtEnum : ADest.WriteEnum(ARoot^.EnumData);
dtObject :
Begin
@ -715,6 +739,8 @@ Begin
dtUnicodeString : Result^.UnicodeStrData^.Data := AStoreRdr.ReadUnicodeStr();
{$ENDIF WST_UNICODESTRING}
dtBool : Result^.BoolData := AStoreRdr.ReadBool();
dtAnsiChar : Result^.AnsiCharData := AStoreRdr.ReadAnsiChar();
dtWideChar : Result^.WideCharData := AStoreRdr.ReadWideChar();
dtEnum : Result^.EnumData := AStoreRdr.ReadEnum();
dtObject :
Begin
@ -1051,6 +1077,24 @@ begin
StackTop().CreateBuffer(AName,dtBool)^.BoolData := AData;
end;
procedure TBaseBinaryFormatter.PutAnsiChar(
const AName: String;
const ATypeInfo: PTypeInfo;
const AData: AnsiChar
);
begin
StackTop().CreateBuffer(AName,dtAnsiChar)^.AnsiCharData := AData;
end;
procedure TBaseBinaryFormatter.PutWideChar(
const AName: String;
const ATypeInfo: PTypeInfo;
const AData: WideChar
);
begin
StackTop().CreateBuffer(AName,dtWideChar)^.WideCharData := AData;
end;
procedure TBaseBinaryFormatter.PutInt64(
const AName: String;
const ATypeInfo: PTypeInfo;
@ -1103,6 +1147,24 @@ begin
AData := GetDataBuffer(AName)^.BoolData;
end;
procedure TBaseBinaryFormatter.GetAnsiChar(
const ATypeInfo: PTypeInfo;
var AName: String;
var AData: AnsiChar
);
begin
AData := GetDataBuffer(AName)^.AnsiCharData;
end;
procedure TBaseBinaryFormatter.GetWideChar(
const ATypeInfo: PTypeInfo;
var AName: String;
var AData: WideChar
);
begin
AData := GetDataBuffer(AName)^.WideCharData;
end;
procedure TBaseBinaryFormatter.GetFloat(
const ATypeInfo : PTypeInfo;
var AName : String;
@ -1239,7 +1301,10 @@ begin
Result := StackTop().IsCurrentScopeNil();
end;
procedure TBaseBinaryFormatter.BeginObject(const AName: TDataName;const ATypeInfo: PTypeInfo);
procedure TBaseBinaryFormatter.BeginObject(
const AName: string;
const ATypeInfo: PTypeInfo
);
begin
PushStack(StackTop().CreateBuffer(AName,dtObject));
end;
@ -1332,8 +1397,20 @@ Var
{$IFDEF WST_UNICODESTRING}
unicodeStrData : UnicodeString;
{$ENDIF WST_UNICODESTRING}
ansiCharData : AnsiChar;
wideCharData : WideChar;
begin
Case ATypeInfo^.Kind Of
tkChar :
begin
ansiCharData := AnsiChar(AData);
PutAnsiChar(AName,ATypeInfo,ansiCharData);
end;
tkWChar :
begin
wideCharData := WideChar(AData);
PutWideChar(AName,ATypeInfo,wideCharData);
end;
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
Begin
ansiStrData := String(AData);
@ -1439,9 +1516,21 @@ var
{$IFDEF WST_UNICODESTRING}
unicodeStrData : UnicodeString;
{$ENDIF WST_UNICODESTRING}
ansiCharData : AnsiChar;
wideCharData : WideChar;
begin
CheckScope();
case ATypeInfo^.Kind of
tkChar :
begin
ansiCharData := AnsiChar(AData);
StackTop().CreateInnerBuffer(dtAnsiChar)^.AnsiCharData:= ansiCharData;
end;
tkWChar :
begin
wideCharData := WideChar(AData);
StackTop().CreateInnerBuffer(dtWideChar)^.WideCharData:= wideCharData;
end;
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
begin
strData := string(AData);
@ -1595,6 +1684,8 @@ Var
{$IFDEF WST_UNICODESTRING}
unicodeStrData : UnicodeString;
{$ENDIF WST_UNICODESTRING}
ansiCharData : AnsiChar;
wideCharData : WideChar;
begin
Case ATypeInfo^.Kind Of
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
@ -1642,6 +1733,18 @@ begin
Boolean(AData) := boolData;
End;
{$ENDIF}
tkChar :
begin
ansiCharData := #0;
GetAnsiChar(ATypeInfo,AName,ansiCharData);
AnsiChar(AData) := ansiCharData;
end;
tkWChar :
begin
wideCharData := #0;
GetWideChar(ATypeInfo,AName,wideCharData);
WideChar(AData) := wideCharData;
end;
tkInteger, tkEnumeration :
Begin
{$IFNDEF FPC}
@ -1707,6 +1810,8 @@ begin
CheckScope();
dataBuffer := StackTop().GetInnerBuffer();
Case ATypeInfo^.Kind Of
tkChar : AnsiChar(AData) := dataBuffer^.AnsiCharData ;
tkWChar : WideChar(AData) := dataBuffer^.WideCharData ;
tkInt64 : Int64(AData) := dataBuffer^.Int64S;
{$IFDEF FPC}
tkQWord : QWord(AData) := dataBuffer^.Int64U;

120
wst/trunk/base_json_formatter.pas
View File

@ -204,6 +204,16 @@ type
Const ATypeInfo : PTypeInfo;
Const AData : Boolean
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutAnsiChar(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : AnsiChar
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutWideChar(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : WideChar
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutInt64(
Const AName : String;
Const ATypeInfo : PTypeInfo;
@ -254,6 +264,16 @@ type
Var AData : Boolean
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF FPC}
procedure GetAnsiChar(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : AnsiChar
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetWideChar(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : WideChar
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetInt(
Const ATypeInfo : PTypeInfo;
Var AName : String;
@ -455,6 +475,24 @@ begin
StackTop().CreateBoolBuffer(AName,AData);
end;
procedure TJsonRpcBaseFormatter.PutAnsiChar(
const AName: String;
const ATypeInfo: PTypeInfo;
const AData: AnsiChar
);
begin
StackTop().CreateStringBuffer(AName,AData);
end;
procedure TJsonRpcBaseFormatter.PutWideChar(
const AName: String;
const ATypeInfo: PTypeInfo;
const AData: WideChar
);
begin
StackTop().CreateStringBuffer(AName,AData);
end;
procedure TJsonRpcBaseFormatter.PutInt64(
const AName : String;
const ATypeInfo : PTypeInfo;
@ -545,6 +583,36 @@ 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;
@ -804,8 +872,20 @@ Var
unicodeStrData : UnicodeString;
{$ENDIF WST_UNICODESTRING}
wideStrData : WideString;
ansiCharData : AnsiChar;
wideCharData : WideChar;
begin
Case ATypeInfo^.Kind Of
tkChar :
begin
ansiCharData := AnsiChar(AData);
PutAnsiChar(AName,ATypeInfo,ansiCharData);
end;
tkWChar :
begin
wideCharData := WideChar(AData);
PutWideChar(AName,ATypeInfo,wideCharData);
end;
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
Begin
strData := String(AData);
@ -909,9 +989,21 @@ var
{$IFDEF WST_UNICODESTRING}
unicodeStrData : UnicodeString;
{$ENDIF WST_UNICODESTRING}
ansiCharData : AnsiChar;
wideCharData : WideChar;
begin
locName := s_inner_value;
Case ATypeInfo^.Kind Of
tkChar :
begin
ansiCharData := AnsiChar(AData);
PutAnsiChar(locName,ATypeInfo,ansiCharData);
end;
tkWChar :
begin
wideCharData := WideChar(AData);
PutWideChar(locName,ATypeInfo,wideCharData);
end;
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
Begin
strData := String(AData);
@ -1004,8 +1096,22 @@ Var
unicodeStrData : UnicodeString;
{$ENDIF WST_UNICODESTRING}
WideStrData : WideString;
ansiCharData : AnsiChar;
wideCharData : WideChar;
begin
Case ATypeInfo^.Kind Of
tkChar :
begin
ansiCharData := #0;
GetAnsiChar(ATypeInfo,AName,ansiCharData);
AnsiChar(AData) := ansiCharData;
end;
tkWChar :
begin
wideCharData := #0;
GetWideChar(ATypeInfo,AName,wideCharData);
WideChar(AData) := wideCharData;
end;
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
Begin
int64Data := 0;
@ -1120,9 +1226,23 @@ var
{$IFDEF WST_UNICODESTRING}
unicodeStrData : UnicodeString;
{$ENDIF WST_UNICODESTRING}
ansiCharData : AnsiChar;
wideCharData : WideChar;
begin
locName := s_inner_value;
Case ATypeInfo^.Kind Of
tkChar :
begin
ansiCharData := #0;
GetAnsiChar(ATypeInfo,locName,ansiCharData);
AnsiChar(AData) := ansiCharData;
end;
tkWChar :
begin
wideCharData := #0;
GetWideChar(ATypeInfo,locName,wideCharData);
WideChar(AData) := wideCharData;
end;
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
Begin
int64Data := 0;

145
wst/trunk/base_soap_formatter.pas
View File

@ -166,6 +166,18 @@ type
Const ATypeInfo : PTypeInfo;
Const AData : Boolean
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PutAnsiChar(
const ANameSpace : string;
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : AnsiChar
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PutWideChar(
const ANameSpace : string;
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : WideChar
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PutInt64(
const ANameSpace : string;
Const AName : String;
@ -222,6 +234,18 @@ type
Var AName : String;
Var AData : Boolean
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetAnsiChar(
Const ATypeInfo : PTypeInfo;
const ANameSpace : string;
Var AName : String;
Var AData : AnsiChar
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetWideChar(
Const ATypeInfo : PTypeInfo;
const ANameSpace : string;
Var AName : String;
Var AData : WideChar
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF FPC}
procedure GetInt(
Const ATypeInfo : PTypeInfo;
@ -821,6 +845,26 @@ begin
Result := InternalPutData(ANameSpace,AName,ATypeInfo,BoolToSoapBool(AData));
end;
function TSOAPBaseFormatter.PutAnsiChar(
const ANameSpace: string;
const AName: String;
const ATypeInfo: PTypeInfo;
const AData: AnsiChar
) : TDOMNode;
begin
Result := InternalPutData(ANameSpace,AName,ATypeInfo,AData);
end;
function TSOAPBaseFormatter.PutWideChar(
const ANameSpace: string;
const AName: String;
const ATypeInfo: PTypeInfo;
const AData: WideChar
): TDOMNode;
begin
Result := InternalPutData(ANameSpace,AName,ATypeInfo,AData);
end;
function TSOAPBaseFormatter.PutInt64(
const ANameSpace : string;
const AName : String;
@ -980,6 +1024,38 @@ begin
AData := StrToBool(locBuffer);
end;
procedure TSOAPBaseFormatter.GetAnsiChar(
const ATypeInfo: PTypeInfo;
const ANameSpace: string;
var AName: String;
var AData: AnsiChar
);
var
tmpString : DOMString;
begin
tmpString := GetNodeValue(ANameSpace,AName);
if ( Length(tmpString) > 0 ) then
AData := AnsiChar(tmpString[1])
else
AData := #0;
end;
procedure TSOAPBaseFormatter.GetWideChar(
const ATypeInfo: PTypeInfo;
const ANameSpace: string;
var AName: String;
var AData: WideChar
);
var
tmpString : DOMString;
begin
tmpString := GetNodeValue(ANameSpace,AName);
if ( Length(tmpString) > 0 ) then
AData := tmpString[1]
else
AData := #0;
end;
{$IFDEF FPC}
procedure TSOAPBaseFormatter.GetInt(
const ATypeInfo: PTypeInfo;
@ -1542,8 +1618,20 @@ Var
unicodeStrData : UnicodeString;
{$ENDIF WST_UNICODESTRING}
wideStrData : WideString;
ansiCharData : AnsiChar;
wideCharData : WideChar;
begin
Case ATypeInfo^.Kind Of
tkChar :
begin
ansiCharData := AnsiChar(AData);
PutAnsiChar(ANameSpace,AName,ATypeInfo,ansiCharData);
end;
tkWChar :
begin
wideCharData := WideChar(AData);
PutWideChar(ANameSpace,AName,ATypeInfo,wideCharData);
end;
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
Begin
int64Data := Int64(AData);
@ -1646,19 +1734,28 @@ Var
strData : string;
enumData : TEnumIntType;
floatDt : Extended;
dataBuffer : string;
dataBuffer : DOMString;
frmt : string;
prcsn,i : Integer;
wideStrData : WideString;
{$IFDEF WST_UNICODESTRING}
unicodeStrData : UnicodeString;
{$ENDIF WST_UNICODESTRING}
{strm : TStringStream;
locDoc : TwstXMLDocument;
locNode : TDOMNode;}
ansiCharData : AnsiChar;
wideCharData : WideChar;
begin
CheckScope();
Case ATypeInfo^.Kind Of
tkChar :
begin
ansiCharData := AnsiChar(AData);
dataBuffer := ansiCharData;
end;
tkWChar :
begin
wideCharData := WideChar(AData);
dataBuffer := wideCharData;
end;
tkInt64 :
begin
int64SData := Int64(AData);
@ -1761,16 +1858,6 @@ begin
dataBuffer[i] := '.';
end;
end;
(*locDoc := nil;
strm := TStringStream.Create(dataBuffer);
try
ReadXMLFile(locDoc,strm);
locNode := locDoc.DocumentElement.CloneNode(True {$IFDEF FPC}, StackTop().ScopeObject.OwnerDocument{$ENDIF});
StackTop().ScopeObject.AppendChild(locNode);
finally
ReleaseDomNode(locDoc);
strm.Free();
end;*)
StackTop().ScopeObject.AppendChild(FDoc.CreateTextNode(dataBuffer));
end;
@ -1792,8 +1879,22 @@ Var
unicodeStrData : UnicodeString;
{$ENDIF WST_UNICODESTRING}
wideStrData : WideString;
ansiCharData : AnsiChar;
wideCharData : WideChar;
begin
Case ATypeInfo^.Kind Of
tkChar :
begin
ansiCharData := #0;
GetAnsiChar(ATypeInfo,ANameSpace,AName,ansiCharData);
AnsiChar(AData) := ansiCharData;
end;
tkWChar :
begin
wideCharData := #0;
GetWideChar(ATypeInfo,ANameSpace,AName,wideCharData);
WideChar(AData) := wideCharData;
end;
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
Begin
int64Data := 0;
@ -1900,7 +2001,7 @@ procedure TSOAPBaseFormatter.GetScopeInnerValue(
Var
enumData : TEnumIntType;
floatDt : Extended;
dataBuffer : string;
dataBuffer : DOMString;
nd : TDOMNode;
begin
CheckScope();
@ -1910,6 +2011,20 @@ begin
else
dataBuffer := StackTop().ScopeObject.NodeValue;
Case ATypeInfo^.Kind Of
tkChar :
begin
if ( Length(dataBuffer) > 0 ) then
AnsiChar(AData) := AnsiChar(dataBuffer[1])
else
AnsiChar(AData) := #0;
end;
tkWChar :
begin
if ( Length(dataBuffer) > 0 ) then
WideChar(AData) := dataBuffer[1]
else
WideChar(AData) := #0;
end;
tkInt64 : Int64(AData) := StrToInt64Def(Trim(dataBuffer),0);
{$IFDEF FPC}
tkQWord : QWord(AData) := StrToInt64Def(Trim(dataBuffer),0);

124
wst/trunk/base_xmlrpc_formatter.pas
View File

@ -186,6 +186,16 @@ type
Const AData : Boolean
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF}
function PutAnsiChar(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : AnsiChar
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PutWideChar(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : WideChar
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PutInt64(
Const AName : String;
Const ATypeInfo : PTypeInfo;
@ -230,6 +240,16 @@ type
Var AName : String;
Var AData : TEnumIntType
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetAnsiChar(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : AnsiChar
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetWideChar(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : WideChar
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF FPC}
procedure GetBool(
Const ATypeInfo : PTypeInfo;
@ -811,6 +831,24 @@ begin
end;
{$ENDIF}
function TXmlRpcBaseFormatter.PutAnsiChar(
const AName: String;
const ATypeInfo: PTypeInfo;
const AData: AnsiChar
) : TDOMNode;
begin
Result := InternalPutData(AName,xdtString,AData);
end;
function TXmlRpcBaseFormatter.PutWideChar(
const AName: String;
const ATypeInfo: PTypeInfo;
const AData: WideChar
) : TDOMNode;
begin
Result := InternalPutData(AName,xdtString,AData);
end;
function TXmlRpcBaseFormatter.PutInt64(
const AName : String;
const ATypeInfo : PTypeInfo;
@ -966,6 +1004,36 @@ begin
end;
{$ENDIF}
procedure TXmlRpcBaseFormatter.GetAnsiChar(
const ATypeInfo: PTypeInfo;
var AName: String;
var AData: AnsiChar
);
var
locBuffer : DOMString;
begin
locBuffer := GetNodeValue(AName);
if ( Length(locBuffer) = 0 ) then
AData := #0
else
AData := AnsiChar(locBuffer[1]);
end;
procedure TXmlRpcBaseFormatter.GetWideChar(
const ATypeInfo: PTypeInfo;
var AName: String;
var AData: WideChar
);
var
locBuffer : DOMString;
begin
locBuffer := GetNodeValue(AName);
if ( Length(locBuffer) = 0 ) then
AData := #0
else
AData := locBuffer[1];
end;
procedure TXmlRpcBaseFormatter.GetInt64(
const ATypeInfo : PTypeInfo;
var AName : String;
@ -1214,8 +1282,20 @@ Var
unicodeStrData : UnicodeString;
{$ENDIF WST_UNICODESTRING}
wideStrData : WideString;
ansiCharData : AnsiChar;
wideCharData : WideChar;
begin
Case ATypeInfo^.Kind Of
tkChar :
begin
ansiCharData := AnsiChar(AData);
PutAnsiChar(AName,ATypeInfo,ansiCharData);
end;
tkWChar :
begin
wideCharData := WideChar(AData);
PutWideChar(AName,ATypeInfo,wideCharData);
end;
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
Begin
int64Data := Int64(AData);
@ -1307,16 +1387,28 @@ Var
strData : string;
enumData : TEnumIntType;
floatDt : Extended;
dataBuffer : string;
dataBuffer : DOMString;
frmt : string;
prcsn,i : Integer;
wideStrData : WideString;
{$IFDEF WST_UNICODESTRING}
unicodeStrData : UnicodeString;
{$ENDIF WST_UNICODESTRING}
ansiCharData : AnsiChar;
wideCharData : WideChar;
begin
CheckScope();
Case ATypeInfo^.Kind Of
tkChar :
begin
ansiCharData := AnsiChar(AData);
dataBuffer := ansiCharData;
end;
tkWChar :
begin
wideCharData := WideChar(AData);
dataBuffer := wideCharData;
end;
tkInt64 :
begin
int64SData := Int64(AData);
@ -1439,8 +1531,22 @@ Var
unicodeStrData : UnicodeString;
{$ENDIF WST_UNICODESTRING}
wideStrData : WideString;
ansiCharData : AnsiChar;
wideCharData : WideChar;
begin
Case ATypeInfo^.Kind Of
tkChar :
begin
ansiCharData := #0;
GetAnsiChar(ATypeInfo,AName,ansiCharData);
AnsiChar(AData) := ansiCharData;
end;
tkWChar :
begin
wideCharData := #0;
GetWideChar(ATypeInfo,AName,wideCharData);
WideChar(AData) := wideCharData;
end;
tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
Begin
int64Data := 0;
@ -1536,7 +1642,7 @@ procedure TXmlRpcBaseFormatter.GetScopeInnerValue(
Var
enumData : TEnumIntType;
floatDt : Extended;
dataBuffer : string;
dataBuffer : DOMString;
nd : TDOMNode;
begin
CheckScope();
@ -1546,6 +1652,20 @@ begin
else
dataBuffer := StackTop().ScopeObject.NodeValue;
Case ATypeInfo^.Kind Of
tkChar :
begin
if ( Length(dataBuffer) > 0 ) then
AnsiChar(AData) := AnsiChar(dataBuffer[1])
else
AnsiChar(AData) := #0;
end;
tkWChar :
begin
if ( Length(dataBuffer) > 0 ) then
WideChar(AData) :=dataBuffer[1]
else
WideChar(AData) := #0;
end;
tkInt64 : Int64(AData) := StrToInt64Def(Trim(dataBuffer),0);
{$IFDEF FPC}
tkQWord : QWord(AData) := StrToInt64Def(Trim(dataBuffer),0);

30
wst/trunk/binary_streamer.pas
View File

@ -35,6 +35,8 @@ Type
{$IFDEF WST_UNICODESTRING}
TUnicodeStringData = UnicodeString;
{$ENDIF WST_UNICODESTRING}
TAnsiCharacter = AnsiChar;
TWideCharacter = WideChar;
TFloat_Single_4 = Single;
TFloat_Double_8 = Double;
@ -56,6 +58,8 @@ Type
procedure WriteInt64S(Const AData : TInt64S);
procedure WriteBool(Const AData : TBoolData);
procedure WriteAnsiChar(const AData : TAnsiCharacter);
procedure WriteWideChar(const AData : TWideCharacter);
procedure WriteEnum(Const AData : TEnumData);
procedure WriteAnsiStr(Const AData : TAnsiStringData);
procedure WriteWideStr(Const AData : TWideStringData);
@ -85,6 +89,8 @@ Type
function ReadInt64S():TInt64S;
function ReadBool():TBoolData;
function ReadAnsiChar() : TAnsiCharacter;
function ReadWideChar() : TWideCharacter;
function ReadEnum():TEnumData;
function ReadAnsiStr():TAnsiStringData;
function ReadWideStr():TWideStringData;
@ -217,6 +223,8 @@ Type
procedure WriteInt64S(Const AData : TInt64S);
procedure WriteBool(Const AData : TBoolData);
procedure WriteAnsiChar(const AData : TAnsiCharacter);
procedure WriteWideChar(const AData : TWideCharacter);
procedure WriteEnum(Const AData : TEnumData);
procedure WriteAnsiStr(Const AData : TAnsiStringData);
procedure WriteWideStr(Const AData : TWideStringData);
@ -252,6 +260,8 @@ Type
function ReadInt64S():TInt64S;
function ReadBool():TBoolData;
function ReadAnsiChar() : TAnsiCharacter;
function ReadWideChar() : TWideCharacter;
function ReadEnum():TEnumData;
function ReadAnsiStr():TAnsiStringData;
function ReadWideStr():TWideStringData;
@ -380,6 +390,16 @@ begin
WriteInt8U(i);
end;
procedure TDataStore.WriteAnsiChar(const AData: TAnsiCharacter);
begin
WriteInt8U(Ord(AData));
end;
procedure TDataStore.WriteWideChar(const AData: TWideCharacter);
begin
WriteInt16U(Ord(AData));
end;
procedure TDataStore.WriteEnum(const AData: TEnumData);
begin
WriteInt64S(AData);
@ -558,6 +578,16 @@ begin
Result := ( ReadInt8U() > 0 );
end;
function TDataStoreReader.ReadAnsiChar(): TAnsiCharacter;
begin
Result := TAnsiCharacter(ReadInt8U());
end;
function TDataStoreReader.ReadWideChar(): TWideCharacter;
begin
Result := TWideCharacter(ReadInt16U());
end;
function TDataStoreReader.ReadEnum(): TEnumData;
begin
Result := ReadInt64S();

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

@ -368,6 +368,10 @@ type
function Support_ComplextType_with_SimpleContent():Boolean;virtual;
function Support_nil():Boolean;virtual;
published
procedure Test_AnsiChar;
procedure Test_AnsiChar_ScopeData;
procedure Test_WideChar;
procedure Test_WideChar_ScopeData;
procedure Test_Int_8;
procedure Test_Int_8_ScopeData;
procedure Test_Int_16;
@ -720,6 +724,189 @@ begin
Result := True;
end;
procedure TTestFormatterSimpleType.Test_AnsiChar;
const VAL_1 : AnsiChar = 'O'; VAL_2 : AnsiChar = 'i';
Var
f : IFormatterBase;
s : TMemoryStream;
x : string;
xVal_1, xVal_2 : AnsiChar;
begin
s := Nil;
Try
xVal_1 := VAL_1;
xVal_2 := VAL_2;
f := CreateFormatter(TypeInfo(TClass_Int));
f.BeginObject('Root',TypeInfo(TClass_Int));
f.Put('xVal_1',TypeInfo(AnsiChar),xVal_1);
f.Put('xVal_2',TypeInfo(AnsiChar),xVal_2);
f.EndScope();
s := TMemoryStream.Create();
f.SaveToStream(s); s.SaveToFile(ClassName + '.Test_AnsiChar.xml');
xVal_1 := #0;
xVal_2 := #0;
f := CreateFormatter(TypeInfo(TClass_Int));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'xVal_1';
f.Get(TypeInfo(AnsiChar),x,xVal_1);
x := 'xVal_2';
f.Get(TypeInfo(AnsiChar),x,xVal_2);
f.EndScopeRead();
CheckEquals(VAL_1,xVal_1);
CheckEquals(VAL_2,xVal_2);
Finally
s.Free();
End;
end;
procedure TTestFormatterSimpleType.Test_AnsiChar_ScopeData;
const VAL_1 : AnsiChar = 'O'; VAL_2 : AnsiChar = 'i';
var
f : IFormatterBase;
s : TMemoryStream;
x : string;
xVal_1 : AnsiChar;
begin
s := Nil;
try
xVal_1 := VAL_1;
f := CreateFormatter(TypeInfo(TClass_Int));
f.BeginObject('Root',TypeInfo(TClass_Int));
f.PutScopeInnerValue(TypeInfo(AnsiChar),xVal_1);
f.EndScope();
s := TMemoryStream.Create();
f.SaveToStream(s);
xVal_1 := #0;
f := CreateFormatter(TypeInfo(TClass_Int));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_Int));
f.GetScopeInnerValue(TypeInfo(AnsiChar),xVal_1);
f.EndScopeRead();
CheckEquals(VAL_1,xVal_1);
xVal_1 := VAL_2;
f := CreateFormatter(TypeInfo(TClass_Int));
f.BeginObject('Root',TypeInfo(TClass_Int));
f.PutScopeInnerValue(TypeInfo(AnsiChar),xVal_1);
f.EndScope();
s := TMemoryStream.Create();
f.SaveToStream(s);
xVal_1 := #0;
f := CreateFormatter(TypeInfo(TClass_Int));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_Int));
f.GetScopeInnerValue(TypeInfo(AnsiChar),xVal_1);
f.EndScopeRead();
CheckEquals(VAL_2,xVal_1);
finally
s.Free();
end;
end;
procedure TTestFormatterSimpleType.Test_WideChar;
const VAL_1 : WideChar = WideChar(300); VAL_2 : WideChar = WideChar(400);
Var
f : IFormatterBase;
s : TMemoryStream;
x : string;
xVal_1, xVal_2 : WideChar;
begin
s := Nil;
Try
xVal_1 := VAL_1;
xVal_2 := VAL_2;
f := CreateFormatter(TypeInfo(TClass_Int));
f.BeginObject('Root',TypeInfo(TClass_Int));
f.Put('xVal_1',TypeInfo(WideChar),xVal_1);
f.Put('xVal_2',TypeInfo(WideChar),xVal_2);
f.EndScope();
s := TMemoryStream.Create();
f.SaveToStream(s); s.SaveToFile(ClassName + '.Test_WideChar.xml');
xVal_1 := #0;
xVal_2 := #0;
f := CreateFormatter(TypeInfo(TClass_Int));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'xVal_1';
f.Get(TypeInfo(WideChar),x,xVal_1);
x := 'xVal_2';
f.Get(TypeInfo(WideChar),x,xVal_2);
f.EndScopeRead();
CheckEquals(VAL_1,xVal_1);
CheckEquals(VAL_2,xVal_2);
Finally
s.Free();
End;
end;
procedure TTestFormatterSimpleType.Test_WideChar_ScopeData;
const VAL_1 : WideChar = WideChar(300); VAL_2 : WideChar = WideChar(400);
var
f : IFormatterBase;
s : TMemoryStream;
x : string;
xVal_1 : WideChar;
begin
s := Nil;
try
xVal_1 := VAL_1;
f := CreateFormatter(TypeInfo(TClass_Int));
f.BeginObject('Root',TypeInfo(TClass_Int));
f.PutScopeInnerValue(TypeInfo(WideChar),xVal_1);
f.EndScope();
s := TMemoryStream.Create();
f.SaveToStream(s);
xVal_1 := #0;
f := CreateFormatter(TypeInfo(TClass_Int));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_Int));
f.GetScopeInnerValue(TypeInfo(WideChar),xVal_1);
f.EndScopeRead();
CheckEquals(VAL_1,xVal_1);
xVal_1 := VAL_2;
f := CreateFormatter(TypeInfo(TClass_Int));
f.BeginObject('Root',TypeInfo(TClass_Int));
f.PutScopeInnerValue(TypeInfo(WideChar),xVal_1);
f.EndScope();
s := TMemoryStream.Create();
f.SaveToStream(s);
xVal_1 := #0;
f := CreateFormatter(TypeInfo(TClass_Int));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_Int));
f.GetScopeInnerValue(TypeInfo(WideChar),xVal_1);
f.EndScopeRead();
CheckEquals(VAL_2,xVal_1);
finally
s.Free();
end; end;
procedure TTestFormatterSimpleType.Test_Int_8;
const VAL_1 = 12; VAL_2 = -10;
Var