* Fix bug ID #35113

git-svn-id: trunk@41473 -
This commit is contained in:
michael 2019-02-25 21:04:39 +00:00
parent c7834af354
commit 970188907e
6 changed files with 92 additions and 13 deletions

View File

@ -2496,7 +2496,7 @@ begin
vtChar : Result:=CreateJSON(VChar); vtChar : Result:=CreateJSON(VChar);
vtExtended : Result:=CreateJSON(VExtended^); vtExtended : Result:=CreateJSON(VExtended^);
vtString : Result:=CreateJSON(vString^); vtString : Result:=CreateJSON(vString^);
vtAnsiString : Result:=CreateJSON(AnsiString(vAnsiString)); vtAnsiString : Result:=CreateJSON(UTF8Decode(StrPas(VPChar)));
vtPChar : Result:=CreateJSON(StrPas(VPChar)); vtPChar : Result:=CreateJSON(StrPas(VPChar));
vtPointer : If (VPointer<>Nil) then vtPointer : If (VPointer<>Nil) then
TJSONData.DoError(SErrPointerNotNil,[SourceType]) TJSONData.DoError(SErrPointerNotNil,[SourceType])
@ -3153,7 +3153,7 @@ constructor TJSONObject.Create(const Elements: array of {$ifdef pas2js}jsvalue{$
Var Var
I : integer; I : integer;
AName : String; AName : TJSONUnicodeStringType;
J : TJSONData; J : TJSONData;
begin begin
@ -3173,7 +3173,7 @@ begin
Case VType of Case VType of
vtChar : AName:=VChar; vtChar : AName:=VChar;
vtString : AName:=vString^; vtString : AName:=vString^;
vtAnsiString : AName:=(AnsiString(vAnsiString)); vtAnsiString : AName:=UTF8Decode(StrPas(VPChar));
vtPChar : AName:=StrPas(VPChar); vtPChar : AName:=StrPas(VPChar);
else else
DoError(SErrNameMustBeString,[I+1]); DoError(SErrNameMustBeString,[I+1]);
@ -3183,7 +3183,7 @@ begin
DoError(SErrNameMustBeString,[I+1]); DoError(SErrNameMustBeString,[I+1]);
Inc(I); Inc(I);
J:=VarRecToJSON(Elements[i],'Object'); J:=VarRecToJSON(Elements[i],'Object');
Add(AName,J); Add(UTF8Encode(AName),J);
Inc(I); Inc(I);
end; end;
end; end;

View File

@ -90,13 +90,21 @@ type
Procedure EnumValues(Const APath : UnicodeString; List : TStrings); Procedure EnumValues(Const APath : UnicodeString; List : TStrings);
function GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString; overload; function GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString; overload;
function GetValue(const APath: RawByteString; const ADefault: RawByteString): UnicodeString; overload;
function GetValue(const APath: UnicodeString; ADefault: Integer): Integer; overload; function GetValue(const APath: UnicodeString; ADefault: Integer): Integer; overload;
function GetValue(const APath: RawByteString; ADefault: Integer): Integer; overload;
function GetValue(const APath: UnicodeString; ADefault: Int64): Int64; overload; function GetValue(const APath: UnicodeString; ADefault: Int64): Int64; overload;
function GetValue(const APath: RawByteString; ADefault: Int64): Int64; overload;
function GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean; overload; function GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean; overload;
function GetValue(const APath: RawByteString; ADefault: Boolean): Boolean; overload;
function GetValue(const APath: UnicodeString; ADefault: Double): Double; overload; function GetValue(const APath: UnicodeString; ADefault: Double): Double; overload;
function GetValue(const APath: RawByteString; ADefault: Double): Double; overload;
Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: String) : Boolean; overload; Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: String) : Boolean; overload;
Function GetValue(const APath: RawByteString; AValue: TStrings; Const ADefault: String) : Boolean; overload;
Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: TStrings): Boolean; overload; Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: TStrings): Boolean; overload;
procedure SetValue(const APath: UnicodeString; const AValue: UnicodeString); overload; procedure SetValue(const APath: UnicodeString; const AValue: UnicodeString); overload;
procedure SetValue(const APath: RawByteString; const AValue: RawByteString); overload;
procedure SetValue(const APath: UnicodeString; AValue: Integer); overload; procedure SetValue(const APath: UnicodeString; AValue: Integer); overload;
procedure SetValue(const APath: UnicodeString; AValue: Int64); overload; procedure SetValue(const APath: UnicodeString; AValue: Int64); overload;
procedure SetValue(const APath: UnicodeString; AValue: Boolean); overload; procedure SetValue(const APath: UnicodeString; AValue: Boolean); overload;
@ -289,6 +297,12 @@ begin
end; end;
function TJSONConfig.GetValue(const APath: RawByteString; const ADefault: RawByteString): UnicodeString;
begin
Result:=GetValue(UTF8Decode(aPath),UTF8Decode(ADefault));
end;
function TJSONConfig.GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString; function TJSONConfig.GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString;
var var
@ -302,6 +316,12 @@ begin
Result:=ADefault; Result:=ADefault;
end; end;
function TJSONConfig.GetValue(const APath: RawByteString; ADefault: Integer): Integer;
begin
Result:=GetValue(UTF8Decode(aPath),ADefault);
end;
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Integer): Integer; function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Integer): Integer;
var var
El : TJSONData; El : TJSONData;
@ -316,6 +336,12 @@ begin
Result:=StrToIntDef(El.AsString,ADefault); Result:=StrToIntDef(El.AsString,ADefault);
end; end;
function TJSONConfig.GetValue(const APath: RawByteString; ADefault: Int64): Int64;
begin
Result:=GetValue(UTF8Decode(aPath),ADefault);
end;
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Int64): Int64; function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Int64): Int64;
var var
El : TJSONData; El : TJSONData;
@ -330,6 +356,12 @@ begin
Result:=StrToInt64Def(El.AsString,ADefault); Result:=StrToInt64Def(El.AsString,ADefault);
end; end;
function TJSONConfig.GetValue(const APath: RawByteString; ADefault: Boolean): Boolean;
begin
Result:=GetValue(UTF8Decode(aPath),ADefault);
end;
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean; function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean;
var var
@ -345,6 +377,12 @@ begin
Result:=StrToBoolDef(El.AsString,ADefault); Result:=StrToBoolDef(El.AsString,ADefault);
end; end;
function TJSONConfig.GetValue(const APath: RawByteString; ADefault: Double): Double;
begin
Result:=GetValue(UTF8Decode(aPath),ADefault);
end;
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Double): Double; function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Double): Double;
var var
@ -360,6 +398,14 @@ begin
Result:=StrToFloatDef(El.AsString,ADefault); Result:=StrToFloatDef(El.AsString,ADefault);
end; end;
function TJSONConfig.GetValue(const APath: RawByteString; AValue: TStrings;
const ADefault: String): Boolean;
begin
Result:=GetValue(UTF8Decode(aPath),AValue, ADefault);
end;
function TJSONConfig.GetValue(const APath: UnicodeString; AValue: TStrings; function TJSONConfig.GetValue(const APath: UnicodeString; AValue: TStrings;
const ADefault: String): Boolean; const ADefault: String): Boolean;
var var
@ -418,6 +464,13 @@ begin
FModified:=True; FModified:=True;
end; end;
procedure TJSONConfig.SetValue(const APath: RawByteString;
const AValue: RawByteString);
begin
SetValue(UTF8Decode(APath),UTF8Decode(AValue));
end;
procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; const AValue, DefValue: UnicodeString); procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; const AValue, DefValue: UnicodeString);
begin begin
if AValue = DefValue then if AValue = DefValue then

View File

@ -36,7 +36,7 @@ Type
procedure DoError(const Msg: String); procedure DoError(const Msg: String);
Procedure DoParse(AtCurrent,AllowEOF: Boolean); Procedure DoParse(AtCurrent,AllowEOF: Boolean);
function GetNextToken: TJSONToken; function GetNextToken: TJSONToken;
function CurrentTokenString: String; function CurrentTokenString: RawByteString;
function CurrentToken: TJSONToken; inline; function CurrentToken: TJSONToken; inline;
Procedure KeyValue(Const AKey : TJSONStringType); virtual; abstract; Procedure KeyValue(Const AKey : TJSONStringType); virtual; abstract;
@ -203,7 +203,7 @@ begin
Result:=FScanner.CurToken; Result:=FScanner.CurToken;
end; end;
function TBaseJSONReader.CurrentTokenString: String; function TBaseJSONReader.CurrentTokenString: RawByteString;
begin begin
If CurrentToken in [tkString,tkIdentifier,tkNumber,tkComment] then If CurrentToken in [tkString,tkIdentifier,tkNumber,tkComment] then

View File

@ -28,7 +28,7 @@ uses SysUtils, Classes;
resourcestring resourcestring
SErrInvalidCharacter = 'Invalid character at line %d, pos %d: ''%s'''; SErrInvalidCharacter = 'Invalid character at line %d, pos %d: ''%s''';
SUnterminatedComment = 'Unterminated comment at line %d, pos %d: ''%s'''; SUnterminatedComment = 'Unterminated comment at line %d, pos %d: ''%s''';
SErrOpenString = 'string exceeds end of line'; SErrOpenString = 'string exceeds end of line %d';
type type
@ -331,7 +331,7 @@ begin
u1:=u2; u1:=u2;
end end
end; end;
#0 : Error(SErrOpenString); #0 : Error(SErrOpenString,[FCurRow]);
else else
Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]); Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
end; end;
@ -355,11 +355,11 @@ begin
else else
MaybeAppendUnicode; MaybeAppendUnicode;
if FTokenStr[0] = #0 then if FTokenStr[0] = #0 then
Error(SErrOpenString); Error(SErrOpenString,[FCurRow]);
Inc(FTokenStr); Inc(FTokenStr);
end; end;
if FTokenStr[0] = #0 then if FTokenStr[0] = #0 then
Error(SErrOpenString); Error(SErrOpenString,[FCurRow]);
MaybeAppendUnicode; MaybeAppendUnicode;
SectionLength := FTokenStr - TokenStart; SectionLength := FTokenStr - TokenStart;
SetLength(FCurTokenString, OldLength + SectionLength); SetLength(FCurTokenString, OldLength + SectionLength);

View File

@ -27,6 +27,7 @@ type
procedure TestKey; procedure TestKey;
procedure TestStrings; procedure TestStrings;
procedure TestUnicodeStrings; procedure TestUnicodeStrings;
procedure TestUnicodeStrings2;
end; end;
implementation implementation
@ -352,6 +353,34 @@ begin
end; end;
end; end;
procedure TTestJSONConfig.TestUnicodeStrings2;
Const
utf8str = 'Größe ÄÜÖ ㎰ す 가';
utf8path = 'Größe/す가';
Var
Co : TJSONCOnfig;
begin
Co:=CreateConf('test.json');
try
Co.SetValue('/проверка',utf8str);
Co.SetValue(utf8path,'something');
Co.Flush;
finally
co.Free;
end;
Co:=CreateConf('test.json');
try
AssertEquals('UTF8 string read/Write',utf8str,utf8encode(Co.GetValue('/проверка','')));
AssertEquals('UTF8 path read/Write','something',Co.GetValue(utf8path,'something'));
finally
DeleteConf(Co,True);
end;
end;
initialization initialization

View File

@ -14,9 +14,6 @@
</BuildModes> </BuildModes>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<local> <local>