From 7538493419aaf2426b1c534e938afa53b80ce8af Mon Sep 17 00:00:00 2001 From: Hafedh TRIMECHE Date: Mon, 18 Jan 2021 19:55:47 +0100 Subject: [PATCH 01/10] Exclude an Empty object from being converted to Json: InternalStringify Method --- src/Jsons.pas | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Jsons.pas b/src/Jsons.pas index 79d001e..bb407d5 100644 --- a/src/Jsons.pas +++ b/src/Jsons.pas @@ -486,9 +486,10 @@ procedure ArrayStringify(JsonArray:Jsons.TJsonArray); Stream.WriteString(']'); end; begin + if AValue.IsEmpty then Exit; if AName<>'' then Stream.WriteString('"'+AValue.Encode(AName)+'":'); case AValue.ValueType of - jvNone , + jvNone : ; jvNull : Stream.WriteString('null'); jvString : Stream.WriteString('"'+AValue.Encode(AValue.AsString)+'"'); jvNumber : Stream.WriteString(FixedFloatToStr(AValue.AsNumber)); From f42b56ac3f6d5ee60386a8b0b7051bb570d3ce4a Mon Sep 17 00:00:00 2001 From: Hafedh TRIMECHE Date: Mon, 25 Jan 2021 21:26:38 +0100 Subject: [PATCH 02/10] Ignore jvNone objects --- src/Jsons.pas | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/Jsons.pas b/src/Jsons.pas index bb407d5..119c582 100644 --- a/src/Jsons.pas +++ b/src/Jsons.pas @@ -466,8 +466,11 @@ procedure ObjectStringify(JsonObject:Jsons.TJsonObject); for i:=0 to JsonObject.Count-1 do begin Item := JsonObject.Items[i]; - if i>0 then Stream.WriteString(','); - InternalStringify(Stream,Item.Name,Item.Value); + if Item.Value.ValueType<>jvNone then + begin + if i>0 then Stream.WriteString(','); + InternalStringify(Stream,Item.Name,Item.Value); + end; end; Stream.WriteString('}'); end; @@ -480,8 +483,11 @@ procedure ArrayStringify(JsonArray:Jsons.TJsonArray); for i:=0 to JsonArray.Count-1 do begin Item := JsonArray.Items[i]; - if i>0 then Stream.WriteString(','); - InternalStringify(Stream,'',Item); + if Item.ValueType<>jvNone then + begin + if i>0 then Stream.WriteString(','); + InternalStringify(Stream,'',Item); + end; end; Stream.WriteString(']'); end; From 7b6fc72a465e579d2bbcaec9928d3c5236d2e68c Mon Sep 17 00:00:00 2001 From: Hafedh TRIMECHE Date: Mon, 15 Feb 2021 15:53:07 +0100 Subject: [PATCH 03/10] --- src/Jsons.pas | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/Jsons.pas b/src/Jsons.pas index 119c582..479a3fe 100644 --- a/src/Jsons.pas +++ b/src/Jsons.pas @@ -459,34 +459,40 @@ procedure TJsonBase.InternalStringify(Stream:TStringStream;AName:string;AValue:T StrBoolean : array[Boolean] of string = ('false', 'true'); procedure ObjectStringify(JsonObject:Jsons.TJsonObject); var - i : Integer; + i , + cnt : Integer; Item : TJsonPair; begin + cnt := 0; Stream.WriteString('{'); for i:=0 to JsonObject.Count-1 do begin Item := JsonObject.Items[i]; if Item.Value.ValueType<>jvNone then begin - if i>0 then Stream.WriteString(','); + if cnt>0 then Stream.WriteString(','); InternalStringify(Stream,Item.Name,Item.Value); + Inc(cnt); end; end; Stream.WriteString('}'); end; procedure ArrayStringify(JsonArray:Jsons.TJsonArray); var - i : Integer; + i , + cnt : Integer; Item : TJsonValue; begin + cnt := 0; Stream.WriteString('['); for i:=0 to JsonArray.Count-1 do begin Item := JsonArray.Items[i]; if Item.ValueType<>jvNone then begin - if i>0 then Stream.WriteString(','); + if cnt>0 then Stream.WriteString(','); InternalStringify(Stream,'',Item); + Inc(cnt); end; end; Stream.WriteString(']'); From 6f1ddc38e3cde416fa54edfc038ba68dee38c4cd Mon Sep 17 00:00:00 2001 From: Hafedh TRIMECHE Date: Wed, 23 Jun 2021 00:04:32 +0100 Subject: [PATCH 04/10] StringReplace JsonsUtils_GLB_DECIMALSEPARATOR by GLB_JSON_STD_DECIMALSEPARATOR --- src/Jsons.pas | 3141 ++++++++++++++++++++---------------------- src/JsonsUtilsEx.pas | 4 +- 2 files changed, 1463 insertions(+), 1682 deletions(-) diff --git a/src/Jsons.pas b/src/Jsons.pas index 479a3fe..731e2d7 100644 --- a/src/Jsons.pas +++ b/src/Jsons.pas @@ -1,1689 +1,1470 @@ -{**************************************************************************** -Copyright (c) 2014 Randolph - -mail: rilyu@sina.com - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in -all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -THE SOFTWARE. - -201804 - Fiy - VGS - Refactor FixedFloatToStr (best use case and optimization) -201805 - Add - VGS - Add OBjectToJson and JsonToObject, rtti based, cross platform Delphi10+ and FPC 3+Refactor -201807 - Fix - VGS - String unicode (\uxxx) encoding and decoding. - -****************************************************************************} - -unit Jsons; - -{$IFDEF FPC} -{$MODE Delphi} -{$ENDIF} - -interface - -uses Classes, SysUtils, jsonsutilsEx; - -type - TJsonValueType = (jvNone, jvNull, jvString, jvNumber, jvBoolean, jvObject, jvArray); - TJsonStructType = (jsNone, jsArray, jsObject); - TJsonNull = (null); - TJsonEmpty = (empty); - -type - TJsonValue = class; - TJsonBase = class(TObject) - private - FOwner : TJsonBase; - function GetOwner: TJsonBase; - procedure InternalStringify(Stream:TStringStream;AName:string;AValue:TJsonValue); - protected - function GetOwnerName: String; - procedure RaiseError(const Msg: String); - procedure RaiseParseError(const JsonString: String); - procedure RaiseAssignError(Source: TJsonBase); - public - constructor Create(AOwner: TJsonBase); - destructor Destroy; override; - - procedure Parse(JsonString: String); virtual; abstract; - function Stringify:string;virtual; - - procedure Assign(Source: TJsonBase); virtual; abstract; - - function Encode(const S: String): String; - function Decode(const S: String): String; - - procedure Split(const S: String; const Delimiter: Char; Strings: TStrings); - - function IsJsonObject(const S: String): Boolean; - function IsJsonArray(const S: String): Boolean; - function IsJsonString(const S: String): Boolean; - function IsJsonNumber(const S: String): Boolean; - function IsJsonBoolean(const S: String): Boolean; - function IsJsonNull(const S: String): Boolean; - - function AnalyzeJsonValueType(const S: String): TJsonValueType; - - public - property Owner: TJsonBase read GetOwner; - - end; - - TJsonObject = class; - TJsonArray = class; - TJsonValue = class(TJsonBase) - private - FValueType: TJsonValueType; - FStringValue: String; - FNumberValue: Extended; - FBooleanValue: Boolean; - FObjectValue: TJsonObject; - FArrayValue: TJsonArray; - - function GetAsArray: TJsonArray; - function GetAsBoolean: Boolean; - function GetAsInteger: Integer; - function GetAsNumber: Extended; - function GetAsObject: TJsonObject; - function GetAsString: String; - function GetIsNull: Boolean; - procedure SetAsBoolean(const Value: Boolean); - procedure SetAsInteger(const Value: Integer); - procedure SetAsNumber(const Value: Extended); - procedure SetAsString(const Value: String); - procedure SetIsNull(const Value: Boolean); - procedure SetAsArray(const Value: TJsonArray); - procedure SetAsObject(const Value: TJsonObject); - function GetIsEmpty: Boolean; - procedure SetIsEmpty(const Value: Boolean); - - protected - procedure RaiseValueTypeError(const AsValueType: TJsonValueType); - public - constructor Create(AOwner: TJsonBase); - destructor Destroy; override; - - procedure Parse(JsonString: String); override; - - procedure Assign(Source: TJsonBase); override; - - procedure Clear; - - public - property ValueType: TJsonValueType read FValueType; - property AsString: String read GetAsString write SetAsString; - property AsNumber: Extended read GetAsNumber write SetAsNumber; - property AsInteger: Integer read GetAsInteger write SetAsInteger; - property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean; - property AsObject: TJsonObject read GetAsObject write SetAsObject; - property AsArray: TJsonArray read GetAsArray write SetAsArray; - property IsNull: Boolean read GetIsNull write SetIsNull; - property IsEmpty: Boolean read GetIsEmpty write SetIsEmpty; - - end; - - TJsonArray = class(TJsonBase) - private - FList: TList; - function GetItems(Index: Integer): TJsonValue; - function GetCount: Integer; - public - constructor Create(AOwner: TJsonBase = nil); - destructor Destroy; override; - - procedure Parse(JsonString: String); override; - - procedure Assign(Source: TJsonBase); override; - procedure Merge(Addition: TJsonArray); - - function Add: TJsonValue; - function Insert(const Index: Integer): TJsonValue; - - function Put(const Value: TJsonEmpty): TJsonValue; overload; - function Put(const Value: TJsonNull): TJsonValue; overload; - function Put(const Value: Boolean): TJsonValue; overload; - function Put(const Value: Integer): TJsonValue; overload; - function Put(const Value: Extended): TJsonValue; overload; - function Put(const Value: String): TJsonValue; overload; - function Put(const Value: TJsonArray): TJsonValue; overload; - function Put(const Value: TJsonObject): TJsonValue; overload; - function Put(const Value: TJsonValue): TJsonValue; overload; - - procedure Delete(const Index: Integer); - procedure Clear; - - public - property Count: Integer read GetCount; - property Items[Index: Integer]: TJsonValue read GetItems; default; - - end; - - TJsonPair = class(TJsonBase) - private - FName: String; - FValue: TJsonValue; - - procedure SetName(const Value: String); - - public - constructor Create(AOwner: TJsonBase; const AName: String = ''); - destructor Destroy; override; - - procedure Parse(JsonString: String); override; - - procedure Assign(Source: TJsonBase); override; - - public - property Name: String read FName write SetName; - property Value: TJsonValue read FValue; - - end; - - TJsonObject = class(TJsonBase) - private - FList: TList; - FAutoAdd: Boolean; - function GetCount: Integer; - function GetItems(Index: Integer): TJsonPair; - function GetValues(Name: String): TJsonValue; - public - constructor Create(AOwner: TJsonBase = nil); - destructor Destroy; override; - - procedure Parse(JsonString: String); override; - - procedure Assign(Source: TJsonBase); override; - procedure Merge(Addition: TJsonObject); - - function Add(const Name: String = ''): TJsonPair; - function Insert(const Index: Integer; const Name: String = ''): TJsonPair; - - function Put(const Name: String; const Value: TJsonEmpty): TJsonValue; overload; - function Put(const Name: String; const Value: TJsonNull): TJsonValue; overload; - function Put(const Name: String; const Value: Boolean): TJsonValue; overload; - function Put(const Name: String; const Value: Integer): TJsonValue; overload; - function Put(const Name: String; const Value: Extended): TJsonValue; overload; - function Put(const Name: String; const Value: String): TJsonValue; overload; - function Put(const Name: String; const Value: TJsonArray): TJsonValue; overload; - function Put(const Name: String; const Value: TJsonObject): TJsonValue; overload; - function Put(const Name: String; const Value: TJsonValue): TJsonValue; overload; - function Put(const Value: TJsonPair): TJsonValue; overload; - - function Find(const Name: String): Integer; - - procedure Delete(const Index: Integer); overload; - procedure Delete(const Name: String); overload; - - procedure Clear; - - public - property Count: Integer read GetCount; - property Items[Index: Integer]: TJsonPair read GetItems; - property Values[Name: String]: TJsonValue read GetValues; default; - property AutoAdd: Boolean read FAutoAdd write FAutoAdd; - - end; - - TJson = class(TJsonBase) - private - FStructType: TJsonStructType; - FJsonArray: TJsonArray; - FJsonObject: TJsonObject; - - function GetCount: Integer; - function GetJsonArray: TJsonArray; - function GetJsonObject: TJsonObject; - function GetValues(Name: String): TJsonValue; - protected - procedure CreateArrayIfNone; - procedure CreateObjectIfNone; - - procedure RaiseIfNone; - procedure RaiseIfNotArray; - procedure RaiseIfNotObject; - - procedure CheckJsonArray; - procedure CheckJsonObject; - - public - constructor Create; - destructor Destroy; override; - - procedure Parse(JsonString: String); override; - function Stringify: String; override; - - procedure Assign(Source: TJsonBase); override; - - procedure Delete(const Index: Integer); overload; - procedure Delete(const Name: String); overload; - - procedure Clear; - - function Get(const Index: Integer): TJsonValue; overload; //for both - function Get(const Name: String): TJsonValue; overload; //for JsonObject - - //for JsonArray - function Put(const Value: TJsonEmpty): TJsonValue; overload; - function Put(const Value: TJsonNull): TJsonValue; overload; - function Put(const Value: Boolean): TJsonValue; overload; - function Put(const Value: Integer): TJsonValue; overload; - function Put(const Value: Extended): TJsonValue; overload; - function Put(const Value: String): TJsonValue; overload; - function Put(const Value: TJsonArray): TJsonValue; overload; - function Put(const Value: TJsonObject): TJsonValue; overload; - function Put(const Value: TJsonValue): TJsonValue; overload; - function Put(const Value: TJson): TJsonValue; overload; - - //for JsonObject - function Put(const Name: String; const Value: TJsonEmpty): TJsonValue; overload; - function Put(const Name: String; const Value: TJsonNull): TJsonValue; overload; - function Put(const Name: String; const Value: Boolean): TJsonValue; overload; - function Put(const Name: String; const Value: Integer): TJsonValue; overload; - function Put(const Name: String; const Value: Extended): TJsonValue; overload; - function Put(const Name: String; const Value: String): TJsonValue; overload; - function Put(const Name: String; const Value: TJsonArray): TJsonValue; overload; - function Put(const Name: String; const Value: TJsonObject): TJsonValue; overload; - function Put(const Name: String; const Value: TJsonValue): TJsonValue; overload; - function Put(const Name: String; const Value: TJson): TJsonValue; overload; - function Put(const Value: TJsonPair): TJsonValue; overload; - - public - property StructType: TJsonStructType read FStructType; - property JsonObject: TJsonObject read GetJsonObject; - property JsonArray: TJsonArray read GetJsonArray; - - property Count: Integer read GetCount; - property Values[Name: String]: TJsonValue read GetValues; default; //for JsonObject - - end; - -implementation - -{ TJsonBase } - -function TJsonBase.AnalyzeJsonValueType(const S: String): TJsonValueType; -var - Len: Integer; - Number: Extended; -begin - Result := jvNone; - Len := Length(S); - if Len >= 2 then - begin - if (S[1] = '{') and (S[Len] = '}') then Result := jvObject - else if (S[1] = '[') and (S[Len] = ']') then Result := jvArray - else if (S[1] = '"') and (S[Len] = '"') then Result := jvString - else if SameText(S, 'null') then Result := jvNull - else if SameText(S, 'true') or SameText(S, 'false') then Result := jvBoolean - else if FixedTryStrToFloat(S, Number) then Result := jvNumber; - end - else if FixedTryStrToFloat(S, Number) then Result := jvNumber; -end; - -constructor TJsonBase.Create(AOwner: TJsonBase); -begin - FOwner := AOwner; -end; - -function TJsonBase.Decode(const S: String): String; - - function HexValue(C: Char): Byte; - begin - case C of - '0'..'9': Result := Byte(C) - Byte('0'); - 'a'..'f': Result := (Byte(C) - Byte('a')) + 10; - 'A'..'F': Result := (Byte(C) - Byte('A')) + 10; - else raise Exception.Create('Illegal hexadecimal characters "' + C + '"'); - end; - end; - -var - I : Integer; - C : Char; - ubuf : integer; - Stream : TStringStream; -begin - Stream := TStringStream.Create; - I := 1; - while I <= Length(S) do - begin - C := S[I]; - Inc(I); - if C = '\' then - begin - C := S[I]; - Inc(I); - case C of - 'b': Stream.WriteString(#8); - 't': Stream.WriteString(#9); - 'n': Stream.WriteString(#10); - 'f': Stream.WriteString(#12); - 'r': Stream.WriteString(#13); - 'u': - begin - if not TryStrToInt('$' + Copy(S, I, 4), ubuf) then - raise Exception.Create(format('Invalid unicode \u%s',[Copy(S, I, 4)])); - Stream.WriteString(WideChar(ubuf)); - Inc(I, 4); - end; - else Stream.WriteString(C); - end; - end - else Stream.WriteString(C); - end; - Result := Stream.DataString; - Stream.Free; -end; - -destructor TJsonBase.Destroy; -begin - inherited Destroy; -end; - -function TJsonBase.Encode(const S: String): String; -var - I , - UnicodeValue : Integer; - C : Char; - Stream : TStringStream; -begin - Stream := TStringStream.Create; - for I := 1 to Length(S) do - begin - C := S[I]; - case C of - '"': Stream.WriteString('\'+C); - '\': Stream.WriteString('\'+C); - '/': Stream.WriteString('\'+C); - #8: Stream.WriteString('\b'); - #9: Stream.WriteString('\t'); - #10: Stream.WriteString('\n'); - #12: Stream.WriteString('\f'); - #13: Stream.WriteString('\r'); - else - if (C < WideChar(32)) or (C > WideChar(127)) then - begin - Stream.WriteString('\u'); - UnicodeValue := Ord(C); - Stream.WriteString(lowercase(IntToHex((UnicodeValue and 61440) shr 12,1))); - Stream.WriteString(lowercase(IntToHex((UnicodeValue and 3840) shr 8,1))); - Stream.WriteString(lowercase(IntToHex((UnicodeValue and 240) shr 4,1))); - Stream.WriteString(lowercase(IntToHex((UnicodeValue and 15),1))); - end - else Stream.WriteString(C); - end; - end; - Result := Stream.DataString; - Stream.Free; -end; - -function TJsonBase.GetOwner: TJsonBase; -begin - Result := FOwner; -end; - -function TJsonBase.GetOwnerName: String; -var - TheOwner: TJsonBase; -begin - Result := ''; - TheOwner := Owner; - while True do - begin - if not Assigned(TheOwner) then Break - else if TheOwner is TJsonPair then - begin - Result := (TheOwner as TJsonPair).Name; - Break; - end - else TheOwner := TheOwner.Owner; - end; -end; - -procedure TJsonBase.InternalStringify(Stream:TStringStream;AName:string;AValue:TJsonValue); +{**************************************************************************** +Copyright (c) 2014 Randolph +mail: rilyu@sina.com +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. +201804 - Fiy - VGS - Refactor FixedFloatToStr (best use case and optimization) +201805 - Add - VGS - Add OBjectToJson and JsonToObject, rtti based, cross platform Delphi10+ and FPC 3+Refactor +201807 - Fix - VGS - String unicode (\uxxx) encoding and decoding. +****************************************************************************} +unit Jsons; +{$IFDEF FPC} +{$MODE Delphi} +{$ENDIF} +interface +uses Classes, SysUtils, jsonsutilsEx; +type + TJsonValueType = (jvNone, jvNull, jvString, jvNumber, jvBoolean, jvObject, jvArray); + TJsonStructType = (jsNone, jsArray, jsObject); + TJsonNull = (null); + TJsonEmpty = (empty); +type + TJsonValue = class; + TJsonBase = class(TObject) + private + FOwner : TJsonBase; + function GetOwner: TJsonBase; + procedure InternalStringify(Stream:TStringStream;AName:string;AValue:TJsonValue); + protected + function GetOwnerName: String; + procedure RaiseError(const Msg: String); + procedure RaiseParseError(const JsonString: String); + procedure RaiseAssignError(Source: TJsonBase); + public + constructor Create(AOwner: TJsonBase); + destructor Destroy; override; + procedure Parse(JsonString: String); virtual; abstract; + function Stringify:string;virtual; + procedure Assign(Source: TJsonBase); virtual; abstract; + function Encode(const S: String): String; + function Decode(const S: String): String; + procedure Split(const S: String; const Delimiter: Char; Strings: TStrings); + function IsJsonObject(const S: String): Boolean; + function IsJsonArray(const S: String): Boolean; + function IsJsonString(const S: String): Boolean; + function IsJsonNumber(const S: String): Boolean; + function IsJsonBoolean(const S: String): Boolean; + function IsJsonNull(const S: String): Boolean; + function AnalyzeJsonValueType(const S: String): TJsonValueType; + public + property Owner: TJsonBase read GetOwner; + end; + TJsonObject = class; + TJsonArray = class; + TJsonValue = class(TJsonBase) + private + FValueType: TJsonValueType; + FStringValue: String; + FNumberValue: Extended; + FBooleanValue: Boolean; + FObjectValue: TJsonObject; + FArrayValue: TJsonArray; + function GetAsArray: TJsonArray; + function GetAsBoolean: Boolean; + function GetAsInteger: Integer; + function GetAsNumber: Extended; + function GetAsObject: TJsonObject; + function GetAsString: String; + function GetIsNull: Boolean; + procedure SetAsBoolean(const Value: Boolean); + procedure SetAsInteger(const Value: Integer); + procedure SetAsNumber(const Value: Extended); + procedure SetAsString(const Value: String); + procedure SetIsNull(const Value: Boolean); + procedure SetAsArray(const Value: TJsonArray); + procedure SetAsObject(const Value: TJsonObject); + function GetIsEmpty: Boolean; + procedure SetIsEmpty(const Value: Boolean); + protected + procedure RaiseValueTypeError(const AsValueType: TJsonValueType); + public + constructor Create(AOwner: TJsonBase); + destructor Destroy; override; + procedure Parse(JsonString: String); override; + procedure Assign(Source: TJsonBase); override; + procedure Clear; + public + property ValueType: TJsonValueType read FValueType; + property AsString: String read GetAsString write SetAsString; + property AsNumber: Extended read GetAsNumber write SetAsNumber; + property AsInteger: Integer read GetAsInteger write SetAsInteger; + property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean; + property AsObject: TJsonObject read GetAsObject write SetAsObject; + property AsArray: TJsonArray read GetAsArray write SetAsArray; + property IsNull: Boolean read GetIsNull write SetIsNull; + property IsEmpty: Boolean read GetIsEmpty write SetIsEmpty; + end; + TJsonArray = class(TJsonBase) + private + FList: TList; + function GetItems(Index: Integer): TJsonValue; + function GetCount: Integer; + public + constructor Create(AOwner: TJsonBase = nil); + destructor Destroy; override; + procedure Parse(JsonString: String); override; + procedure Assign(Source: TJsonBase); override; + procedure Merge(Addition: TJsonArray); + function Add: TJsonValue; + function Insert(const Index: Integer): TJsonValue; + function Put(const Value: TJsonEmpty): TJsonValue; overload; + function Put(const Value: TJsonNull): TJsonValue; overload; + function Put(const Value: Boolean): TJsonValue; overload; + function Put(const Value: Integer): TJsonValue; overload; + function Put(const Value: Extended): TJsonValue; overload; + function Put(const Value: String): TJsonValue; overload; + function Put(const Value: TJsonArray): TJsonValue; overload; + function Put(const Value: TJsonObject): TJsonValue; overload; + function Put(const Value: TJsonValue): TJsonValue; overload; + procedure Delete(const Index: Integer); + procedure Clear; + public + property Count: Integer read GetCount; + property Items[Index: Integer]: TJsonValue read GetItems; default; + end; + TJsonPair = class(TJsonBase) + private + FName: String; + FValue: TJsonValue; + procedure SetName(const Value: String); + public + constructor Create(AOwner: TJsonBase; const AName: String = ''); + destructor Destroy; override; + procedure Parse(JsonString: String); override; + procedure Assign(Source: TJsonBase); override; + public + property Name: String read FName write SetName; + property Value: TJsonValue read FValue; + end; + TJsonObject = class(TJsonBase) + private + FList: TList; + FAutoAdd: Boolean; + function GetCount: Integer; + function GetItems(Index: Integer): TJsonPair; + function GetValues(Name: String): TJsonValue; + public + constructor Create(AOwner: TJsonBase = nil); + destructor Destroy; override; + procedure Parse(JsonString: String); override; + procedure Assign(Source: TJsonBase); override; + procedure Merge(Addition: TJsonObject); + function Add(const Name: String = ''): TJsonPair; + function Insert(const Index: Integer; const Name: String = ''): TJsonPair; + function Put(const Name: String; const Value: TJsonEmpty): TJsonValue; overload; + function Put(const Name: String; const Value: TJsonNull): TJsonValue; overload; + function Put(const Name: String; const Value: Boolean): TJsonValue; overload; + function Put(const Name: String; const Value: Integer): TJsonValue; overload; + function Put(const Name: String; const Value: Extended): TJsonValue; overload; + function Put(const Name: String; const Value: String): TJsonValue; overload; + function Put(const Name: String; const Value: TJsonArray): TJsonValue; overload; + function Put(const Name: String; const Value: TJsonObject): TJsonValue; overload; + function Put(const Name: String; const Value: TJsonValue): TJsonValue; overload; + function Put(const Value: TJsonPair): TJsonValue; overload; + function Find(const Name: String): Integer; + procedure Delete(const Index: Integer); overload; + procedure Delete(const Name: String); overload; + procedure Clear; + public + property Count: Integer read GetCount; + property Items[Index: Integer]: TJsonPair read GetItems; + property Values[Name: String]: TJsonValue read GetValues; default; + property AutoAdd: Boolean read FAutoAdd write FAutoAdd; + end; + TJson = class(TJsonBase) + private + FStructType: TJsonStructType; + FJsonArray: TJsonArray; + FJsonObject: TJsonObject; + function GetCount: Integer; + function GetJsonArray: TJsonArray; + function GetJsonObject: TJsonObject; + function GetValues(Name: String): TJsonValue; + protected + procedure CreateArrayIfNone; + procedure CreateObjectIfNone; + procedure RaiseIfNone; + procedure RaiseIfNotArray; + procedure RaiseIfNotObject; + procedure CheckJsonArray; + procedure CheckJsonObject; + public + constructor Create; + destructor Destroy; override; + procedure Parse(JsonString: String); override; + function Stringify: String; override; + procedure Assign(Source: TJsonBase); override; + procedure Delete(const Index: Integer); overload; + procedure Delete(const Name: String); overload; + procedure Clear; + function Get(const Index: Integer): TJsonValue; overload; //for both + function Get(const Name: String): TJsonValue; overload; //for JsonObject + //for JsonArray + function Put(const Value: TJsonEmpty): TJsonValue; overload; + function Put(const Value: TJsonNull): TJsonValue; overload; + function Put(const Value: Boolean): TJsonValue; overload; + function Put(const Value: Integer): TJsonValue; overload; + function Put(const Value: Extended): TJsonValue; overload; + function Put(const Value: String): TJsonValue; overload; + function Put(const Value: TJsonArray): TJsonValue; overload; + function Put(const Value: TJsonObject): TJsonValue; overload; + function Put(const Value: TJsonValue): TJsonValue; overload; + function Put(const Value: TJson): TJsonValue; overload; + //for JsonObject + function Put(const Name: String; const Value: TJsonEmpty): TJsonValue; overload; + function Put(const Name: String; const Value: TJsonNull): TJsonValue; overload; + function Put(const Name: String; const Value: Boolean): TJsonValue; overload; + function Put(const Name: String; const Value: Integer): TJsonValue; overload; + function Put(const Name: String; const Value: Extended): TJsonValue; overload; + function Put(const Name: String; const Value: String): TJsonValue; overload; + function Put(const Name: String; const Value: TJsonArray): TJsonValue; overload; + function Put(const Name: String; const Value: TJsonObject): TJsonValue; overload; + function Put(const Name: String; const Value: TJsonValue): TJsonValue; overload; + function Put(const Name: String; const Value: TJson): TJsonValue; overload; + function Put(const Value: TJsonPair): TJsonValue; overload; + public + property StructType: TJsonStructType read FStructType; + property JsonObject: TJsonObject read GetJsonObject; + property JsonArray: TJsonArray read GetJsonArray; + property Count: Integer read GetCount; + property Values[Name: String]: TJsonValue read GetValues; default; //for JsonObject + end; +implementation +{ TJsonBase } +function TJsonBase.AnalyzeJsonValueType(const S: String): TJsonValueType; +var + Len: Integer; + Number: Extended; +begin + Result := jvNone; + Len := Length(S); + if Len >= 2 then + begin + if (S[1] = '{') and (S[Len] = '}') then Result := jvObject + else if (S[1] = '[') and (S[Len] = ']') then Result := jvArray + else if (S[1] = '"') and (S[Len] = '"') then Result := jvString + else if SameText(S, 'null') then Result := jvNull + else if SameText(S, 'true') or SameText(S, 'false') then Result := jvBoolean + else if FixedTryStrToFloat(S, Number) then Result := jvNumber; + end + else if FixedTryStrToFloat(S, Number) then Result := jvNumber; +end; +constructor TJsonBase.Create(AOwner: TJsonBase); +begin + FOwner := AOwner; +end; +function TJsonBase.Decode(const S: String): String; + function HexValue(C: Char): Byte; + begin + case C of + '0'..'9': Result := Byte(C) - Byte('0'); + 'a'..'f': Result := (Byte(C) - Byte('a')) + 10; + 'A'..'F': Result := (Byte(C) - Byte('A')) + 10; + else raise Exception.Create('Illegal hexadecimal characters "' + C + '"'); + end; + end; +var + I : Integer; + C : Char; + ubuf : integer; + Stream : TStringStream; +begin + Stream := TStringStream.Create; + I := 1; + while I <= Length(S) do + begin + C := S[I]; + Inc(I); + if C = '\' then + begin + C := S[I]; + Inc(I); + case C of + 'b': Stream.WriteString(#8); + 't': Stream.WriteString(#9); + 'n': Stream.WriteString(#10); + 'f': Stream.WriteString(#12); + 'r': Stream.WriteString(#13); + 'u': + begin + if not TryStrToInt('$' + Copy(S, I, 4), ubuf) then + raise Exception.Create(format('Invalid unicode \u%s',[Copy(S, I, 4)])); + Stream.WriteString(WideChar(ubuf)); + Inc(I, 4); + end; + else Stream.WriteString(C); + end; + end + else Stream.WriteString(C); + end; + Result := Stream.DataString; + Stream.Free; +end; +destructor TJsonBase.Destroy; +begin + inherited Destroy; +end; +function TJsonBase.Encode(const S: String): String; +var + I , + UnicodeValue : Integer; + C : Char; + Stream : TStringStream; +begin + Stream := TStringStream.Create; + for I := 1 to Length(S) do + begin + C := S[I]; + case C of + '"': Stream.WriteString('\'+C); + '\': Stream.WriteString('\'+C); + '/': Stream.WriteString('\'+C); + #8: Stream.WriteString('\b'); + #9: Stream.WriteString('\t'); + #10: Stream.WriteString('\n'); + #12: Stream.WriteString('\f'); + #13: Stream.WriteString('\r'); + else + if (C < WideChar(32)) or (C > WideChar(127)) then + begin + Stream.WriteString('\u'); + UnicodeValue := Ord(C); + Stream.WriteString(lowercase(IntToHex((UnicodeValue and 61440) shr 12,1))); + Stream.WriteString(lowercase(IntToHex((UnicodeValue and 3840) shr 8,1))); + Stream.WriteString(lowercase(IntToHex((UnicodeValue and 240) shr 4,1))); + Stream.WriteString(lowercase(IntToHex((UnicodeValue and 15),1))); + end + else Stream.WriteString(C); + end; + end; + Result := Stream.DataString; + Stream.Free; +end; +function TJsonBase.GetOwner: TJsonBase; +begin + Result := FOwner; +end; +function TJsonBase.GetOwnerName: String; +var + TheOwner: TJsonBase; +begin + Result := ''; + TheOwner := Owner; + while True do + begin + if not Assigned(TheOwner) then Break + else if TheOwner is TJsonPair then + begin + Result := (TheOwner as TJsonPair).Name; + Break; + end + else TheOwner := TheOwner.Owner; + end; +end; +procedure TJsonBase.InternalStringify(Stream:TStringStream;AName:string;AValue:TJsonValue); const - StrBoolean : array[Boolean] of string = ('false', 'true'); -procedure ObjectStringify(JsonObject:Jsons.TJsonObject); -var - i , - cnt : Integer; - Item : TJsonPair; -begin - cnt := 0; - Stream.WriteString('{'); - for i:=0 to JsonObject.Count-1 do - begin - Item := JsonObject.Items[i]; - if Item.Value.ValueType<>jvNone then - begin - if cnt>0 then Stream.WriteString(','); - InternalStringify(Stream,Item.Name,Item.Value); - Inc(cnt); - end; - end; - Stream.WriteString('}'); -end; + StrBoolean : array[Boolean] of string = ('false', 'true'); +procedure ObjectStringify(JsonObject:Jsons.TJsonObject); +var + i , + cnt : Integer; + Item : TJsonPair; +begin + cnt := 0; + Stream.WriteString('{'); + for i:=0 to JsonObject.Count-1 do + begin + Item := JsonObject.Items[i]; + if Item.Value.ValueType<>jvNone then + begin + if cnt>0 then Stream.WriteString(','); + InternalStringify(Stream,Item.Name,Item.Value); + Inc(cnt); + end; + end; + Stream.WriteString('}'); +end; procedure ArrayStringify(JsonArray:Jsons.TJsonArray); -var - i , - cnt : Integer; - Item : TJsonValue; -begin - cnt := 0; - Stream.WriteString('['); - for i:=0 to JsonArray.Count-1 do - begin - Item := JsonArray.Items[i]; - if Item.ValueType<>jvNone then - begin - if cnt>0 then Stream.WriteString(','); - InternalStringify(Stream,'',Item); - Inc(cnt); - end; - end; - Stream.WriteString(']'); -end; -begin - if AValue.IsEmpty then Exit; - if AName<>'' then Stream.WriteString('"'+AValue.Encode(AName)+'":'); - case AValue.ValueType of - jvNone : ; - jvNull : Stream.WriteString('null'); - jvString : Stream.WriteString('"'+AValue.Encode(AValue.AsString)+'"'); - jvNumber : Stream.WriteString(FixedFloatToStr(AValue.AsNumber)); - jvBoolean : Stream.WriteString(StrBoolean[AValue.AsBoolean]); - jvObject : ObjectStringify(AValue.AsObject); - jvArray : ArrayStringify(AValue.AsArray); - end; +var + i , + cnt : Integer; + Item : TJsonValue; +begin + cnt := 0; + Stream.WriteString('['); + for i:=0 to JsonArray.Count-1 do + begin + Item := JsonArray.Items[i]; + if Item.ValueType<>jvNone then + begin + if cnt>0 then Stream.WriteString(','); + InternalStringify(Stream,'',Item); + Inc(cnt); + end; + end; + Stream.WriteString(']'); +end; +begin + if AValue.IsEmpty then Exit; + if AName<>'' then Stream.WriteString('"'+AValue.Encode(AName)+'":'); + case AValue.ValueType of + jvNone : ; + jvNull : Stream.WriteString('null'); + jvString : Stream.WriteString('"'+AValue.Encode(AValue.AsString)+'"'); + jvNumber : Stream.WriteString(FixedFloatToStr(AValue.AsNumber)); + jvBoolean : Stream.WriteString(StrBoolean[AValue.AsBoolean]); + jvObject : ObjectStringify(AValue.AsObject); + jvArray : ArrayStringify(AValue.AsArray); + end; end; -function TJsonBase.Stringify:string; -var +function TJsonBase.Stringify:string; +var Stream : TStringStream; begin Stream := TStringStream.Create; InternalStringify(Stream,'',TJsonValue(Self)); Result := Stream.DataString; - Stream.Free; -end; - -function TJsonBase.IsJsonArray(const S: String): Boolean; -var - Len: Integer; -begin - Len := Length(S); - Result := (Len >= 2) and (S[1] = '[') and (S[Len] = ']'); -end; - -function TJsonBase.IsJsonBoolean(const S: String): Boolean; -begin - Result := SameText(lowercase(S), 'true') or SameText(lowercase(S), 'false'); -end; - -function TJsonBase.IsJsonNull(const S: String): Boolean; -begin - Result := SameText(S, 'null'); -end; - -function TJsonBase.IsJsonNumber(const S: String): Boolean; -var - Number: Extended; -begin - Result := FixedTryStrToFloat(S, Number); -end; - -function TJsonBase.IsJsonObject(const S: String): Boolean; -var - Len: Integer; -begin - Len := Length(S); - Result := (Len >= 2) and (S[1] = '{') and (S[Len] = '}'); -end; - -function TJsonBase.IsJsonString(const S: String): Boolean; -var - Len: Integer; -begin - Len := Length(S); - Result := (Len >= 2) and (S[1] = '"') and (S[Len] = '"'); -end; - -procedure TJsonBase.RaiseAssignError(Source: TJsonBase); -var - SourceClassName: String; -begin - if Source is TObject then SourceClassName := Source.ClassName - else SourceClassName := 'nil'; - RaiseError(Format('assign error: %s to %s', [SourceClassName, ClassName])); -end; - -procedure TJsonBase.RaiseError(const Msg: String); -var - S: String; -begin - S := Format('<%s>%s', [ClassName, Msg]); - raise Exception.Create(S); -end; - -procedure TJsonBase.RaiseParseError(const JsonString: String); -begin - RaiseError(Format('"%s" parse error: %s', [GetOwnerName, JsonString])); -end; - -procedure TJsonBase.Split(const S: String; const Delimiter: Char; - Strings: TStrings); - - function IsPairBegin(C: Char): Boolean; - begin - Result := (C = '{') or (C = '[') or (C = '"'); - end; - - function GetPairEnd(C: Char): Char; - begin - case C of - '{': Result := '}'; - '[': Result := ']'; - '"': Result := '"'; - else Result := #0; - end; - end; - - function MoveToPair(P: PChar): PChar; - var - PairBegin, PairEnd: Char; - C: Char; - begin - PairBegin := P^; - PairEnd := GetPairEnd(PairBegin); - Result := P; - while Result^ <> #0 do - begin - Inc(Result); - C := Result^; - if C = PairEnd then Break - else if (PairBegin = '"') and (C = '\') then Inc(Result) - else if (PairBegin <> '"') and IsPairBegin(C) then Result := MoveToPair(Result); - end; - end; - -var - PtrBegin, PtrEnd: PChar; - C: Char; - StrItem: String; -begin - PtrBegin := PChar(S); - PtrEnd := PtrBegin; - while PtrEnd^ <> #0 do - begin - C := PtrEnd^; - if C = Delimiter then - begin - StrItem := Trim(Copy(PtrBegin, 1, PtrEnd - PtrBegin)); - Strings.Add(StrItem); - PtrBegin := PtrEnd + 1; - PtrEnd := PtrBegin; - Continue; - end - else if IsPairBegin(C) then PtrEnd := MoveToPair(PtrEnd); - Inc(PtrEnd); - end; - StrItem := Trim(Copy(PtrBegin, 1, PtrEnd - PtrBegin)); - if StrItem <> '' then Strings.Add(StrItem); -end; - -{ TJsonValue } - -procedure TJsonValue.Assign(Source: TJsonBase); -var - Src: TJsonValue; -begin - Clear; - if not(Source is TJsonValue) and not(Source is TJsonObject) and not(Source is TJsonArray) then - RaiseAssignError(Source); - if Source is TJsonObject then - begin - FValueType := jvObject; - FObjectValue := TJsonObject.Create(Self); - FObjectValue.Assign(Source); - end - else if Source is TJsonArray then - begin - FValueType := jvArray; - FArrayValue := TJsonArray.Create(Self); - FArrayValue.Assign(Source); - end - else if Source is TJsonValue then - begin - Src := Source as TJsonValue; - FValueType := Src.FValueType; - case FValueType of - jvNone, jvNull: ; - jvString: FStringValue := Src.FStringValue; - jvNumber: FNumberValue := Src.FNumberValue; - jvBoolean: FBooleanValue := Src.FBooleanValue; - jvObject: - begin - FObjectValue := TJsonObject.Create(Self); - FObjectValue.Assign(Src.FObjectValue); - end; - jvArray: - begin - FArrayValue := TJsonArray.Create(Self); - FArrayValue.Assign(Src.FArrayValue); - end; - end; - end; -end; - -procedure TJsonValue.Clear; -begin - case FValueType of - jvNone, jvNull: ; - jvString: FStringValue := ''; - jvNumber: FNumberValue := 0; - jvBoolean: FBooleanValue := False; - jvObject: - begin - FObjectValue.Free; - FObjectValue := nil; - end; - jvArray: - begin - FArrayValue.Free; - FArrayValue := nil; - end; - end; - FValueType := jvNone; -end; - -constructor TJsonValue.Create(AOwner: TJsonBase); -begin - inherited Create(AOwner); - FStringValue := ''; - FNumberValue := 0; - FBooleanValue := False; - FObjectValue := nil; - FArrayValue := nil; - FValueType := jvNone; -end; - -destructor TJsonValue.Destroy; -begin - Clear; - inherited Destroy; -end; - -function TJsonValue.GetAsArray: TJsonArray; -begin - if IsEmpty then - begin - FValueType := jvArray; - FArrayValue := TJsonArray.Create(Self); - end; - if FValueType <> jvArray then RaiseValueTypeError(jvArray); - Result := FArrayValue; -end; - -function TJsonValue.GetAsBoolean: Boolean; -begin - Result := False; - case FValueType of - jvNone, jvNull: Result := False; - jvString: Result := SameText(lowercase(FStringValue), 'true'); - jvNumber: Result := (FNumberValue <> 0); - jvBoolean: Result := FBooleanValue; - jvObject, jvArray: RaiseValueTypeError(jvBoolean); - end; -end; - -function TJsonValue.GetAsInteger: Integer; -begin - Result := 0; - case FValueType of - jvNone, jvNull: Result := 0; - jvString: Result := Trunc(StrToInt(FStringValue)); - jvNumber: Result := Trunc(FNumberValue); - jvBoolean: Result := Ord(FBooleanValue); - jvObject, jvArray: RaiseValueTypeError(jvNumber); - end; -end; - -function TJsonValue.GetAsNumber: Extended; -begin - Result := 0; - case FValueType of - jvNone, jvNull: Result := 0; - jvString: Result := FixedStrToFloat(FStringValue); - jvNumber: Result := FNumberValue; - jvBoolean: Result := Ord(FBooleanValue); - jvObject, jvArray: RaiseValueTypeError(jvNumber); - end; -end; - -function TJsonValue.GetAsObject: TJsonObject; -begin - if IsEmpty then - begin - FValueType := jvObject; - FObjectValue := TJsonObject.Create(Self); - end; - if FValueType <> jvObject then RaiseValueTypeError(jvObject); - Result := FObjectValue; -end; - -function TJsonValue.GetAsString: String; -const - BooleanStr: array[Boolean] of String = ('false', 'true'); -begin - Result := ''; - case FValueType of - jvNone, jvNull: Result := ''; - jvString: Result := FStringValue; - jvNumber: Result := FixedFloatToStr(FNumberValue); - jvBoolean: Result := BooleanStr[FBooleanValue]; - jvObject, jvArray: RaiseValueTypeError(jvString); - end; -end; - -function TJsonValue.GetIsEmpty: Boolean; -begin - Result := (FValueType = jvNone); -end; - -function TJsonValue.GetIsNull: Boolean; -begin - Result := (FValueType = jvNull); -end; - -procedure TJsonValue.Parse(JsonString: String); -begin - Clear; - JsonString := Trim(JsonString); - FValueType := AnalyzeJsonValueType(JsonString); - case FValueType of - jvNone: RaiseParseError(JsonString); - jvNull: ; - jvString: FStringValue := Decode(Copy(JsonString, 2, Length(JsonString) - 2)); - jvNumber: FNumberValue := FixedStrToFloat(JsonString); - jvBoolean: FBooleanValue := SameText(JsonString, 'true'); - jvObject: - begin - FObjectValue := TJsonObject.Create(Self); - FObjectValue.Parse(JsonString); - end; - jvArray: - begin - FArrayValue := TJsonArray.Create(Self); - FArrayValue.Parse(JsonString); - end; - end; -end; - -procedure TJsonValue.RaiseValueTypeError(const AsValueType: TJsonValueType); -const - StrJsonValueType: array[TJsonValueType] of String = ('jvNone', 'jvNull', 'jvString', 'jvNumber', 'jvBoolean', 'jvObject', 'jvArray'); -var - S: String; -begin - S := Format('"%s" value type error: %s to %s', [GetOwnerName, StrJsonValueType[FValueType], StrJsonValueType[AsValueType]]); - RaiseError(S); -end; - -procedure TJsonValue.SetAsArray(const Value: TJsonArray); -begin - if FValueType <> jvArray then - begin - Clear; - FValueType := jvArray; - FArrayValue := TJsonArray.Create(Self); - end; - FArrayValue.Assign(Value); -end; - -procedure TJsonValue.SetAsBoolean(const Value: Boolean); -begin - if FValueType <> jvBoolean then - begin - Clear; - FValueType := jvBoolean; - end; - FBooleanValue := Value; -end; - -procedure TJsonValue.SetAsInteger(const Value: Integer); -begin - SetAsNumber(Value); -end; - -procedure TJsonValue.SetAsNumber(const Value: Extended); -begin - if FValueType <> jvNumber then - begin - Clear; - FValueType := jvNumber; - end; - FNumberValue := Value; -end; - -procedure TJsonValue.SetAsObject(const Value: TJsonObject); -begin - if FValueType <> jvObject then - begin - Clear; - FValueType := jvObject; - FObjectValue := TJsonObject.Create(Self); - end; - FObjectValue.Assign(Value); -end; - -procedure TJsonValue.SetAsString(const Value: String); -begin - if FValueType <> jvString then - begin - Clear; - FValueType := jvString; - end; - FStringValue := Value; -end; - -procedure TJsonValue.SetIsEmpty(const Value: Boolean); -const - EmptyValueType: array[Boolean] of TJsonValueType = (jvNull, jvNone); -begin - if FValueType <> EmptyValueType[Value] then - begin - Clear; - FValueType := EmptyValueType[Value]; - end; -end; - -procedure TJsonValue.SetIsNull(const Value: Boolean); -const - NullValueType: array[Boolean] of TJsonValueType = (jvNone, jvNull); -begin - if FValueType <> NullValueType[Value] then - begin - Clear; - FValueType := NullValueType[Value]; - end; -end; - -{ TJsonArray } - -function TJsonArray.Add: TJsonValue; -begin - Result := TJsonValue.Create(Self); - FList.Add(Result); -end; - -procedure TJsonArray.Assign(Source: TJsonBase); -var - Src: TJsonArray; - I: Integer; -begin - Clear; - if not(Source is TJsonArray) then RaiseAssignError(Source); - Src := Source as TJsonArray; - for I := 0 to Src.Count - 1 do Add.Assign(Src[I]); -end; - -procedure TJsonArray.Clear; -var - I: Integer; - Item: TJsonValue; -begin - for I := 0 to FList.Count - 1 do - begin - Item := TJsonValue(FList[I]); - Item.Free; - end; - FList.Clear; -end; - -constructor TJsonArray.Create(AOwner: TJsonBase); -begin - inherited Create(AOwner); - FList := TList.Create; -end; - -procedure TJsonArray.Delete(const Index: Integer); -var - Item: TJsonValue; -begin - Item := TJsonValue(FList[Index]); - Item.Free; - FList.Delete(Index); -end; - -destructor TJsonArray.Destroy; -begin - Clear; - FList.Free; - inherited; -end; - -function TJsonArray.GetCount: Integer; -begin - Result := FList.Count; -end; - -function TJsonArray.GetItems(Index: Integer): TJsonValue; -begin - Result := TJsonValue(FList[Index]); -end; - -function TJsonArray.Insert(const Index: Integer): TJsonValue; -begin - Result := TJsonValue.Create(Self); - FList.Insert(Index, Result); -end; - -procedure TJsonArray.Merge(Addition: TJsonArray); -var - I: Integer; -begin - for I := 0 to Addition.Count - 1 do Add.Assign(Addition[I]); -end; - -procedure TJsonArray.Parse(JsonString: String); -var - I: Integer; - S: String; - List: TStringList; - Item: TJsonValue; -begin - Clear; - JsonString := Trim(JsonString); - if not IsJsonArray(JsonString) then RaiseParseError(JsonString); - S := Trim(Copy(JsonString, 2, Length(JsonString) - 2)); - List := TStringList.Create; - try - Split(S, ',', List); - for I := 0 to List.Count - 1 do - begin - Item := Add; - Item.Parse(List[I]); - end; - finally - List.Free; - end; -end; - -function TJsonArray.Put(const Value: Boolean): TJsonValue; -begin - Result := Add; - Result.AsBoolean := Value; -end; - -function TJsonArray.Put(const Value: Integer): TJsonValue; -begin - Result := Add; - Result.AsInteger := Value; -end; - -function TJsonArray.Put(const Value: TJsonEmpty): TJsonValue; -begin - Result := Add; - Result.IsEmpty := True; -end; - -function TJsonArray.Put(const Value: TJsonNull): TJsonValue; -begin - Result := Add; - Result.IsNull := True; -end; - -function TJsonArray.Put(const Value: Extended): TJsonValue; -begin - Result := Add; - Result.AsNumber := Value; -end; - -function TJsonArray.Put(const Value: TJsonObject): TJsonValue; -begin - Result := Add; - Result.Assign(Value); -end; - -function TJsonArray.Put(const Value: TJsonValue): TJsonValue; -begin - Result := Add; - Result.Assign(Value); -end; - -function TJsonArray.Put(const Value: String): TJsonValue; -begin - Result := Add; - Result.AsString := Value; -end; - -function TJsonArray.Put(const Value: TJsonArray): TJsonValue; -begin - Result := Add; - Result.Assign(Value); -end; - -{ TJsonPair } - -procedure TJsonPair.Assign(Source: TJsonBase); -var - Src: TJsonPair; -begin - if not(Source is TJsonPair) then RaiseAssignError(Source); - Src := Source as TJsonPair; - FName := Src.FName; - FValue.Assign(Src.FValue); -end; - -constructor TJsonPair.Create(AOwner: TJsonBase; const AName: String); -begin - inherited Create(AOwner); - FName := AName; - FValue := TJsonValue.Create(Self); -end; - -destructor TJsonPair.Destroy; -begin - FValue.Free; - inherited Destroy; -end; - -procedure TJsonPair.Parse(JsonString: String); -var - List: TStringList; - StrName: String; -begin - List := TStringList.Create; - try - Split(JsonString, ':', List); - if List.Count <> 2 then RaiseParseError(JsonString); - StrName := List[0]; - if not IsJsonString(StrName) then RaiseParseError(StrName); - FName := Decode(Copy(StrName, 2, Length(StrName) - 2)); - FValue.Parse(List[1]); - finally - List.Free; - end; -end; - -procedure TJsonPair.SetName(const Value: String); -begin - FName := Value; -end; - -{ TJsonObject } - -function TJsonObject.Add(const Name: String): TJsonPair; -begin - Result := TJsonPair.Create(Self, Name); - FList.Add(Result); -end; - -procedure TJsonObject.Assign(Source: TJsonBase); -var - Src: TJsonObject; - I: Integer; -begin - Clear; - if not(Source is TJsonObject) then RaiseAssignError(Source); - Src := Source as TJsonObject; - for I := 0 to Src.Count - 1 do Add.Assign(Src.Items[I]); -end; - -procedure TJsonObject.Clear; -var - I: Integer; - Item: TJsonPair; -begin - for I := 0 to FList.Count - 1 do - begin - Item := TJsonPair(FList[I]); - Item.Free; - end; - FList.Clear; -end; - -constructor TJsonObject.Create(AOwner: TJsonBase); -begin - inherited Create(AOwner); - FList := TList.Create; - FAutoAdd := True; -end; - -procedure TJsonObject.Delete(const Index: Integer); -var - Item: TJsonPair; -begin - Item := TJsonPair(FList[Index]); - Item.Free; - FList.Delete(Index); -end; - -procedure TJsonObject.Delete(const Name: String); -var - Index: Integer; -begin - Index := Find(Name); - if Index < 0 then RaiseError(Format('"%s" not found', [Name])); - Delete(Index); -end; - -destructor TJsonObject.Destroy; -begin - Clear; - FList.Free; - inherited Destroy; -end; - -function TJsonObject.Find(const Name: String): Integer; -var - I: Integer; - Pair: TJsonPair; -begin - Result := -1; - for I := 0 to FList.Count - 1 do - begin - Pair := TJsonPair(FList[I]); - if SameText(Name, Pair.Name) then - begin - Result := I; - Break; - end; - end; -end; - -function TJsonObject.GetCount: Integer; -begin - Result := FList.Count; -end; - -function TJsonObject.GetItems(Index: Integer): TJsonPair; -begin - Result := TJsonPair(FList[Index]); -end; - -function TJsonObject.GetValues(Name: String): TJsonValue; -var - Index: Integer; - Pair: TJsonPair; -begin - Index := Find(Name); - if Index < 0 then - begin - if not FAutoAdd then RaiseError(Format('%s not found', [Name])); - Pair := Add(Name); - end - else Pair := TJsonPair(FList[Index]); - Result := Pair.Value; -end; - -function TJsonObject.Insert(const Index: Integer; - const Name: String): TJsonPair; -begin - Result := TJsonPair.Create(Self, Name); - FList.Insert(Index, Result); -end; - -procedure TJsonObject.Merge(Addition: TJsonObject); -var - I: Integer; -begin - for I := 0 to Addition.Count - 1 do Add.Assign(Addition.Items[I]); -end; - -procedure TJsonObject.Parse(JsonString: String); -var - I: Integer; - S: String; - List: TStringList; - Item: TJsonPair; -begin - Clear; - JsonString := Trim(JsonString); - if not IsJsonObject(JsonString) then RaiseParseError(JsonString); - S := Trim(Copy(JsonString, 2, Length(JsonString) - 2)); - List := TStringList.Create; - try - Split(S, ',', List); - for I := 0 to List.Count - 1 do - begin - Item := Add; - Item.Parse(List[I]); - end; - finally - List.Free; - end; -end; - -function TJsonObject.Put(const Name: String; - const Value: Integer): TJsonValue; -begin - Result := Add(Name).Value; - Result.AsInteger := Value; -end; - -function TJsonObject.Put(const Name: String; - const Value: Extended): TJsonValue; -begin - Result := Add(Name).Value; - Result.AsNumber := Value; -end; - -function TJsonObject.Put(const Name: String; - const Value: Boolean): TJsonValue; -begin - Result := Add(Name).Value; - Result.AsBoolean := Value; -end; - -function TJsonObject.Put(const Name: String; - const Value: TJsonEmpty): TJsonValue; -begin - Result := Add(Name).Value; - Result.IsEmpty := True; -end; - -function TJsonObject.Put(const Name: String; - const Value: TJsonNull): TJsonValue; -begin - Result := Add(Name).Value; - Result.IsNull := True; -end; - -function TJsonObject.Put(const Name: String; - const Value: TJsonValue): TJsonValue; -begin - Result := Add(Name).Value; - Result.Assign(Value); -end; - -function TJsonObject.Put(const Value: TJsonPair): TJsonValue; -var - Pair: TJsonPair; -begin - Pair := Add; - Pair.Assign(Value); - Result := Pair.Value; -end; - -function TJsonObject.Put(const Name: String; - const Value: TJsonObject): TJsonValue; -begin - Result := Add(Name).Value; - Result.Assign(Value); -end; - -function TJsonObject.Put(const Name, Value: String): TJsonValue; -begin - Result := Add(Name).Value; - Result.AsString := Value; -end; - -function TJsonObject.Put(const Name: String; - const Value: TJsonArray): TJsonValue; -begin - Result := Add(Name).Value; - Result.Assign(Value); -end; - -{ TJson } - -procedure TJson.Assign(Source: TJsonBase); -begin - Clear; - if Source is TJson then - begin - case (Source as TJson).FStructType of - jsNone: ; - jsArray: - begin - CreateArrayIfNone; - FJsonArray.Assign((Source as TJson).FJsonArray); - end; - jsObject: - begin - CreateObjectIfNone; - FJsonObject.Assign((Source as TJson).FJsonObject); - end; - end; - end - else if Source is TJsonArray then - begin - CreateArrayIfNone; - FJsonArray.Assign(Source); - end - else if Source is TJsonObject then - begin - CreateObjectIfNone; - FJsonObject.Assign(Source); - end - else if Source is TJsonValue then - begin - if (Source as TJsonValue).ValueType = jvArray then - begin - CreateArrayIfNone; - FJsonArray.Assign((Source as TJsonValue).AsArray); - end - else if (Source as TJsonValue).ValueType = jvObject then - begin - CreateObjectIfNone; - FJsonObject.Assign((Source as TJsonValue).AsObject); - end - else RaiseAssignError(Source); - end - else RaiseAssignError(Source); -end; - -procedure TJson.CheckJsonArray; -begin - CreateArrayIfNone; - RaiseIfNotArray; -end; - -procedure TJson.CheckJsonObject; -begin - CreateObjectIfNone; - RaiseIfNotObject; -end; - -procedure TJson.Clear; -begin - case FStructType of - jsNone: ; - jsArray: - begin - FJsonArray.Free; - FJsonArray := nil; - end; - jsObject: - begin - FJsonObject.Free; - FJsonObject := nil; - end; - end; - FStructType := jsNone; -end; - -constructor TJson.Create; -begin - inherited Create(nil); - FStructType := jsNone; - FJsonArray := nil; - FJsonObject := nil; -end; - -procedure TJson.CreateArrayIfNone; -begin - if FStructType = jsNone then - begin - FStructType := jsArray; - FJsonArray := TJsonArray.Create(Self); - end; -end; - -procedure TJson.CreateObjectIfNone; -begin - if FStructType = jsNone then - begin - FStructType := jsObject; - FJsonObject := TJsonObject.Create(Self); - end; -end; - -procedure TJson.Delete(const Index: Integer); -begin - RaiseIfNone; - case FStructType of - jsArray: FJsonArray.Delete(Index); - jsObject: FJsonObject.Delete(Index); - end; -end; - -procedure TJson.Delete(const Name: String); -begin - RaiseIfNotObject; - FJsonObject.Delete(Name); -end; - -destructor TJson.Destroy; -begin - Clear; - inherited Destroy; -end; - -function TJson.Get(const Index: Integer): TJsonValue; -begin - Result := nil; - RaiseIfNone; - case FStructType of - jsArray: Result := FJsonArray.Items[Index]; - jsObject: Result := FJsonObject.Items[Index].Value; - end; -end; - -function TJson.Get(const Name: String): TJsonValue; -begin - CheckJsonObject; - Result := FJsonObject.Values[Name]; -end; - -function TJson.GetCount: Integer; -begin - case FStructType of - jsArray: Result := FJsonArray.Count; - jsObject: Result := FJsonObject.Count; - else Result := 0; - end; -end; - -function TJson.GetJsonArray: TJsonArray; -begin - CheckJsonArray; - Result := FJsonArray; -end; - -function TJson.GetJsonObject: TJsonObject; -begin - CheckJsonObject; - Result := FJsonObject; -end; - -function TJson.GetValues(Name: String): TJsonValue; -begin - Result := Get(Name); -end; - -procedure TJson.Parse(JsonString: String); -begin - Clear; - JsonString := Trim(JsonString); - if IsJsonArray(JsonString) then - begin - CreateArrayIfNone; - FJsonArray.Parse(JsonString); - end - else if IsJsonObject(JsonString) then - begin - CreateObjectIfNone; - FJsonObject.Parse(JsonString); - end - else RaiseParseError(JsonString); -end; - -function TJson.Put(const Value: Integer): TJsonValue; -begin - CheckJsonArray; - Result := FJsonArray.Put(Value); -end; - -function TJson.Put(const Value: Extended): TJsonValue; -begin - CheckJsonArray; - Result := FJsonArray.Put(Value); -end; - -function TJson.Put(const Value: Boolean): TJsonValue; -begin - CheckJsonArray; - Result := FJsonArray.Put(Value); -end; - -function TJson.Put(const Value: TJsonEmpty): TJsonValue; -begin - CheckJsonArray; - Result := FJsonArray.Put(Value); -end; - -function TJson.Put(const Value: TJsonNull): TJsonValue; -begin - CheckJsonArray; - Result := FJsonArray.Put(Value); -end; - -function TJson.Put(const Value: String): TJsonValue; -begin - CheckJsonArray; - Result := FJsonArray.Put(Value); -end; - -function TJson.Put(const Value: TJsonValue): TJsonValue; -begin - CheckJsonArray; - Result := FJsonArray.Put(Value); -end; - -function TJson.Put(const Value: TJsonObject): TJsonValue; -begin - CheckJsonArray; - Result := FJsonArray.Put(Value); -end; - -function TJson.Put(const Value: TJsonArray): TJsonValue; -begin - CheckJsonArray; - Result := FJsonArray.Put(Value); -end; - -function TJson.Put(const Name: String; const Value: Integer): TJsonValue; -begin - CheckJsonObject; - Result := FJsonObject.Put(Name, Value); -end; - -function TJson.Put(const Name: String; const Value: Extended): TJsonValue; -begin - CheckJsonObject; - Result := FJsonObject.Put(Name, Value); -end; - -function TJson.Put(const Name: String; const Value: Boolean): TJsonValue; -begin - CheckJsonObject; - Result := FJsonObject.Put(Name, Value); -end; - -function TJson.Put(const Name: String; - const Value: TJsonEmpty): TJsonValue; -begin - CheckJsonObject; - Result := FJsonObject.Put(Name, Value); -end; - -function TJson.Put(const Name: String; const Value: TJsonNull): TJsonValue; -begin - CheckJsonObject; - Result := FJsonObject.Put(Name, Value); -end; - -function TJson.Put(const Name: String; - const Value: TJsonValue): TJsonValue; -begin - CheckJsonObject; - Result := FJsonObject.Put(Name, Value); -end; - -function TJson.Put(const Value: TJsonPair): TJsonValue; -begin - CheckJsonObject; - Result := FJsonObject.Put(Value); -end; - -function TJson.Put(const Name: String; - const Value: TJsonObject): TJsonValue; -begin - CheckJsonObject; - Result := FJsonObject.Put(Name, Value); -end; - -function TJson.Put(const Name, Value: String): TJsonValue; -begin - CheckJsonObject; - Result := FJsonObject.Put(Name, Value); -end; - -function TJson.Put(const Name: String; - const Value: TJsonArray): TJsonValue; -begin - CheckJsonObject; - Result := FJsonObject.Put(Name, Value); -end; - -function TJson.Put(const Value: TJson): TJsonValue; -begin - CheckJsonArray; - case Value.FStructType of - jsArray: Result := Put(Value.FJsonArray); - jsObject: Result := Put(Value.FJsonObject); - else Result := nil; - end; -end; - -function TJson.Put(const Name: String; const Value: TJson): TJsonValue; -begin - CheckJsonObject; - case Value.FStructType of - jsArray: Result := Put(Name, Value.FJsonArray); - jsObject: Result := Put(Name, Value.FJsonObject); - else Result := nil; - end; -end; - -procedure TJson.RaiseIfNone; -begin - if FStructType = jsNone then RaiseError('json struct type is jsNone'); -end; - -procedure TJson.RaiseIfNotArray; -begin - if FStructType <> jsArray then RaiseError('json struct type is not jsArray'); -end; - -procedure TJson.RaiseIfNotObject; -begin - if FStructType <> jsObject then RaiseError('json struct type is not jsObject'); -end; - -function TJson.Stringify: String; -begin - case FStructType of - jsArray: Result := FJsonArray.Stringify; - jsObject: Result := FJsonObject.Stringify; - else Result := ''; - end; -end; - -end. + Stream.Free; +end; +function TJsonBase.IsJsonArray(const S: String): Boolean; +var + Len: Integer; +begin + Len := Length(S); + Result := (Len >= 2) and (S[1] = '[') and (S[Len] = ']'); +end; +function TJsonBase.IsJsonBoolean(const S: String): Boolean; +begin + Result := SameText(lowercase(S), 'true') or SameText(lowercase(S), 'false'); +end; +function TJsonBase.IsJsonNull(const S: String): Boolean; +begin + Result := SameText(S, 'null'); +end; +function TJsonBase.IsJsonNumber(const S: String): Boolean; +var + Number: Extended; +begin + Result := FixedTryStrToFloat(S, Number); +end; +function TJsonBase.IsJsonObject(const S: String): Boolean; +var + Len: Integer; +begin + Len := Length(S); + Result := (Len >= 2) and (S[1] = '{') and (S[Len] = '}'); +end; +function TJsonBase.IsJsonString(const S: String): Boolean; +var + Len: Integer; +begin + Len := Length(S); + Result := (Len >= 2) and (S[1] = '"') and (S[Len] = '"'); +end; +procedure TJsonBase.RaiseAssignError(Source: TJsonBase); +var + SourceClassName: String; +begin + if Source is TObject then SourceClassName := Source.ClassName + else SourceClassName := 'nil'; + RaiseError(Format('assign error: %s to %s', [SourceClassName, ClassName])); +end; +procedure TJsonBase.RaiseError(const Msg: String); +var + S: String; +begin + S := Format('<%s>%s', [ClassName, Msg]); + raise Exception.Create(S); +end; +procedure TJsonBase.RaiseParseError(const JsonString: String); +begin + RaiseError(Format('"%s" parse error: %s', [GetOwnerName, JsonString])); +end; +procedure TJsonBase.Split(const S: String; const Delimiter: Char; + Strings: TStrings); + function IsPairBegin(C: Char): Boolean; + begin + Result := (C = '{') or (C = '[') or (C = '"'); + end; + function GetPairEnd(C: Char): Char; + begin + case C of + '{': Result := '}'; + '[': Result := ']'; + '"': Result := '"'; + else Result := #0; + end; + end; + function MoveToPair(P: PChar): PChar; + var + PairBegin, PairEnd: Char; + C: Char; + begin + PairBegin := P^; + PairEnd := GetPairEnd(PairBegin); + Result := P; + while Result^ <> #0 do + begin + Inc(Result); + C := Result^; + if C = PairEnd then Break + else if (PairBegin = '"') and (C = '\') then Inc(Result) + else if (PairBegin <> '"') and IsPairBegin(C) then Result := MoveToPair(Result); + end; + end; +var + PtrBegin, PtrEnd: PChar; + C: Char; + StrItem: String; +begin + PtrBegin := PChar(S); + PtrEnd := PtrBegin; + while PtrEnd^ <> #0 do + begin + C := PtrEnd^; + if C = Delimiter then + begin + StrItem := Trim(Copy(PtrBegin, 1, PtrEnd - PtrBegin)); + Strings.Add(StrItem); + PtrBegin := PtrEnd + 1; + PtrEnd := PtrBegin; + Continue; + end + else if IsPairBegin(C) then PtrEnd := MoveToPair(PtrEnd); + Inc(PtrEnd); + end; + StrItem := Trim(Copy(PtrBegin, 1, PtrEnd - PtrBegin)); + if StrItem <> '' then Strings.Add(StrItem); +end; +{ TJsonValue } +procedure TJsonValue.Assign(Source: TJsonBase); +var + Src: TJsonValue; +begin + Clear; + if not(Source is TJsonValue) and not(Source is TJsonObject) and not(Source is TJsonArray) then + RaiseAssignError(Source); + if Source is TJsonObject then + begin + FValueType := jvObject; + FObjectValue := TJsonObject.Create(Self); + FObjectValue.Assign(Source); + end + else if Source is TJsonArray then + begin + FValueType := jvArray; + FArrayValue := TJsonArray.Create(Self); + FArrayValue.Assign(Source); + end + else if Source is TJsonValue then + begin + Src := Source as TJsonValue; + FValueType := Src.FValueType; + case FValueType of + jvNone, jvNull: ; + jvString: FStringValue := Src.FStringValue; + jvNumber: FNumberValue := Src.FNumberValue; + jvBoolean: FBooleanValue := Src.FBooleanValue; + jvObject: + begin + FObjectValue := TJsonObject.Create(Self); + FObjectValue.Assign(Src.FObjectValue); + end; + jvArray: + begin + FArrayValue := TJsonArray.Create(Self); + FArrayValue.Assign(Src.FArrayValue); + end; + end; + end; +end; +procedure TJsonValue.Clear; +begin + case FValueType of + jvNone, jvNull: ; + jvString: FStringValue := ''; + jvNumber: FNumberValue := 0; + jvBoolean: FBooleanValue := False; + jvObject: + begin + FObjectValue.Free; + FObjectValue := nil; + end; + jvArray: + begin + FArrayValue.Free; + FArrayValue := nil; + end; + end; + FValueType := jvNone; +end; +constructor TJsonValue.Create(AOwner: TJsonBase); +begin + inherited Create(AOwner); + FStringValue := ''; + FNumberValue := 0; + FBooleanValue := False; + FObjectValue := nil; + FArrayValue := nil; + FValueType := jvNone; +end; +destructor TJsonValue.Destroy; +begin + Clear; + inherited Destroy; +end; +function TJsonValue.GetAsArray: TJsonArray; +begin + if IsEmpty then + begin + FValueType := jvArray; + FArrayValue := TJsonArray.Create(Self); + end; + if FValueType <> jvArray then RaiseValueTypeError(jvArray); + Result := FArrayValue; +end; +function TJsonValue.GetAsBoolean: Boolean; +begin + Result := False; + case FValueType of + jvNone, jvNull: Result := False; + jvString: Result := SameText(lowercase(FStringValue), 'true'); + jvNumber: Result := (FNumberValue <> 0); + jvBoolean: Result := FBooleanValue; + jvObject, jvArray: RaiseValueTypeError(jvBoolean); + end; +end; +function TJsonValue.GetAsInteger: Integer; +begin + Result := 0; + case FValueType of + jvNone, jvNull: Result := 0; + jvString: Result := Trunc(StrToInt(FStringValue)); + jvNumber: Result := Trunc(FNumberValue); + jvBoolean: Result := Ord(FBooleanValue); + jvObject, jvArray: RaiseValueTypeError(jvNumber); + end; +end; +function TJsonValue.GetAsNumber: Extended; +begin + Result := 0; + case FValueType of + jvNone, jvNull: Result := 0; + jvString: Result := FixedStrToFloat(FStringValue); + jvNumber: Result := FNumberValue; + jvBoolean: Result := Ord(FBooleanValue); + jvObject, jvArray: RaiseValueTypeError(jvNumber); + end; +end; +function TJsonValue.GetAsObject: TJsonObject; +begin + if IsEmpty then + begin + FValueType := jvObject; + FObjectValue := TJsonObject.Create(Self); + end; + if FValueType <> jvObject then RaiseValueTypeError(jvObject); + Result := FObjectValue; +end; +function TJsonValue.GetAsString: String; +const + BooleanStr: array[Boolean] of String = ('false', 'true'); +begin + Result := ''; + case FValueType of + jvNone, jvNull: Result := ''; + jvString: Result := FStringValue; + jvNumber: Result := FixedFloatToStr(FNumberValue); + jvBoolean: Result := BooleanStr[FBooleanValue]; + jvObject, jvArray: RaiseValueTypeError(jvString); + end; +end; +function TJsonValue.GetIsEmpty: Boolean; +begin + Result := (FValueType = jvNone); +end; +function TJsonValue.GetIsNull: Boolean; +begin + Result := (FValueType = jvNull); +end; +procedure TJsonValue.Parse(JsonString: String); +begin + Clear; + JsonString := Trim(JsonString); + FValueType := AnalyzeJsonValueType(JsonString); + case FValueType of + jvNone: RaiseParseError(JsonString); + jvNull: ; + jvString: FStringValue := Decode(Copy(JsonString, 2, Length(JsonString) - 2)); + jvNumber: FNumberValue := FixedStrToFloat(JsonString); + jvBoolean: FBooleanValue := SameText(JsonString, 'true'); + jvObject: + begin + FObjectValue := TJsonObject.Create(Self); + FObjectValue.Parse(JsonString); + end; + jvArray: + begin + FArrayValue := TJsonArray.Create(Self); + FArrayValue.Parse(JsonString); + end; + end; +end; +procedure TJsonValue.RaiseValueTypeError(const AsValueType: TJsonValueType); +const + StrJsonValueType: array[TJsonValueType] of String = ('jvNone', 'jvNull', 'jvString', 'jvNumber', 'jvBoolean', 'jvObject', 'jvArray'); +var + S: String; +begin + S := Format('"%s" value type error: %s to %s', [GetOwnerName, StrJsonValueType[FValueType], StrJsonValueType[AsValueType]]); + RaiseError(S); +end; +procedure TJsonValue.SetAsArray(const Value: TJsonArray); +begin + if FValueType <> jvArray then + begin + Clear; + FValueType := jvArray; + FArrayValue := TJsonArray.Create(Self); + end; + FArrayValue.Assign(Value); +end; +procedure TJsonValue.SetAsBoolean(const Value: Boolean); +begin + if FValueType <> jvBoolean then + begin + Clear; + FValueType := jvBoolean; + end; + FBooleanValue := Value; +end; +procedure TJsonValue.SetAsInteger(const Value: Integer); +begin + SetAsNumber(Value); +end; +procedure TJsonValue.SetAsNumber(const Value: Extended); +begin + if FValueType <> jvNumber then + begin + Clear; + FValueType := jvNumber; + end; + FNumberValue := Value; +end; +procedure TJsonValue.SetAsObject(const Value: TJsonObject); +begin + if FValueType <> jvObject then + begin + Clear; + FValueType := jvObject; + FObjectValue := TJsonObject.Create(Self); + end; + FObjectValue.Assign(Value); +end; +procedure TJsonValue.SetAsString(const Value: String); +begin + if FValueType <> jvString then + begin + Clear; + FValueType := jvString; + end; + FStringValue := Value; +end; +procedure TJsonValue.SetIsEmpty(const Value: Boolean); +const + EmptyValueType: array[Boolean] of TJsonValueType = (jvNull, jvNone); +begin + if FValueType <> EmptyValueType[Value] then + begin + Clear; + FValueType := EmptyValueType[Value]; + end; +end; +procedure TJsonValue.SetIsNull(const Value: Boolean); +const + NullValueType: array[Boolean] of TJsonValueType = (jvNone, jvNull); +begin + if FValueType <> NullValueType[Value] then + begin + Clear; + FValueType := NullValueType[Value]; + end; +end; +{ TJsonArray } +function TJsonArray.Add: TJsonValue; +begin + Result := TJsonValue.Create(Self); + FList.Add(Result); +end; +procedure TJsonArray.Assign(Source: TJsonBase); +var + Src: TJsonArray; + I: Integer; +begin + Clear; + if not(Source is TJsonArray) then RaiseAssignError(Source); + Src := Source as TJsonArray; + for I := 0 to Src.Count - 1 do Add.Assign(Src[I]); +end; +procedure TJsonArray.Clear; +var + I: Integer; + Item: TJsonValue; +begin + for I := 0 to FList.Count - 1 do + begin + Item := TJsonValue(FList[I]); + Item.Free; + end; + FList.Clear; +end; +constructor TJsonArray.Create(AOwner: TJsonBase); +begin + inherited Create(AOwner); + FList := TList.Create; +end; +procedure TJsonArray.Delete(const Index: Integer); +var + Item: TJsonValue; +begin + Item := TJsonValue(FList[Index]); + Item.Free; + FList.Delete(Index); +end; +destructor TJsonArray.Destroy; +begin + Clear; + FList.Free; + inherited; +end; +function TJsonArray.GetCount: Integer; +begin + Result := FList.Count; +end; +function TJsonArray.GetItems(Index: Integer): TJsonValue; +begin + Result := TJsonValue(FList[Index]); +end; +function TJsonArray.Insert(const Index: Integer): TJsonValue; +begin + Result := TJsonValue.Create(Self); + FList.Insert(Index, Result); +end; +procedure TJsonArray.Merge(Addition: TJsonArray); +var + I: Integer; +begin + for I := 0 to Addition.Count - 1 do Add.Assign(Addition[I]); +end; +procedure TJsonArray.Parse(JsonString: String); +var + I: Integer; + S: String; + List: TStringList; + Item: TJsonValue; +begin + Clear; + JsonString := Trim(JsonString); + if not IsJsonArray(JsonString) then RaiseParseError(JsonString); + S := Trim(Copy(JsonString, 2, Length(JsonString) - 2)); + List := TStringList.Create; + try + Split(S, ',', List); + for I := 0 to List.Count - 1 do + begin + Item := Add; + Item.Parse(List[I]); + end; + finally + List.Free; + end; +end; +function TJsonArray.Put(const Value: Boolean): TJsonValue; +begin + Result := Add; + Result.AsBoolean := Value; +end; +function TJsonArray.Put(const Value: Integer): TJsonValue; +begin + Result := Add; + Result.AsInteger := Value; +end; +function TJsonArray.Put(const Value: TJsonEmpty): TJsonValue; +begin + Result := Add; + Result.IsEmpty := True; +end; +function TJsonArray.Put(const Value: TJsonNull): TJsonValue; +begin + Result := Add; + Result.IsNull := True; +end; +function TJsonArray.Put(const Value: Extended): TJsonValue; +begin + Result := Add; + Result.AsNumber := Value; +end; +function TJsonArray.Put(const Value: TJsonObject): TJsonValue; +begin + Result := Add; + Result.Assign(Value); +end; +function TJsonArray.Put(const Value: TJsonValue): TJsonValue; +begin + Result := Add; + Result.Assign(Value); +end; +function TJsonArray.Put(const Value: String): TJsonValue; +begin + Result := Add; + Result.AsString := Value; +end; +function TJsonArray.Put(const Value: TJsonArray): TJsonValue; +begin + Result := Add; + Result.Assign(Value); +end; +{ TJsonPair } +procedure TJsonPair.Assign(Source: TJsonBase); +var + Src: TJsonPair; +begin + if not(Source is TJsonPair) then RaiseAssignError(Source); + Src := Source as TJsonPair; + FName := Src.FName; + FValue.Assign(Src.FValue); +end; +constructor TJsonPair.Create(AOwner: TJsonBase; const AName: String); +begin + inherited Create(AOwner); + FName := AName; + FValue := TJsonValue.Create(Self); +end; +destructor TJsonPair.Destroy; +begin + FValue.Free; + inherited Destroy; +end; +procedure TJsonPair.Parse(JsonString: String); +var + List: TStringList; + StrName: String; +begin + List := TStringList.Create; + try + Split(JsonString, ':', List); + if List.Count <> 2 then RaiseParseError(JsonString); + StrName := List[0]; + if not IsJsonString(StrName) then RaiseParseError(StrName); + FName := Decode(Copy(StrName, 2, Length(StrName) - 2)); + FValue.Parse(List[1]); + finally + List.Free; + end; +end; +procedure TJsonPair.SetName(const Value: String); +begin + FName := Value; +end; +{ TJsonObject } +function TJsonObject.Add(const Name: String): TJsonPair; +begin + Result := TJsonPair.Create(Self, Name); + FList.Add(Result); +end; +procedure TJsonObject.Assign(Source: TJsonBase); +var + Src: TJsonObject; + I: Integer; +begin + Clear; + if not(Source is TJsonObject) then RaiseAssignError(Source); + Src := Source as TJsonObject; + for I := 0 to Src.Count - 1 do Add.Assign(Src.Items[I]); +end; +procedure TJsonObject.Clear; +var + I: Integer; + Item: TJsonPair; +begin + for I := 0 to FList.Count - 1 do + begin + Item := TJsonPair(FList[I]); + Item.Free; + end; + FList.Clear; +end; +constructor TJsonObject.Create(AOwner: TJsonBase); +begin + inherited Create(AOwner); + FList := TList.Create; + FAutoAdd := True; +end; +procedure TJsonObject.Delete(const Index: Integer); +var + Item: TJsonPair; +begin + Item := TJsonPair(FList[Index]); + Item.Free; + FList.Delete(Index); +end; +procedure TJsonObject.Delete(const Name: String); +var + Index: Integer; +begin + Index := Find(Name); + if Index < 0 then RaiseError(Format('"%s" not found', [Name])); + Delete(Index); +end; +destructor TJsonObject.Destroy; +begin + Clear; + FList.Free; + inherited Destroy; +end; +function TJsonObject.Find(const Name: String): Integer; +var + I: Integer; + Pair: TJsonPair; +begin + Result := -1; + for I := 0 to FList.Count - 1 do + begin + Pair := TJsonPair(FList[I]); + if SameText(Name, Pair.Name) then + begin + Result := I; + Break; + end; + end; +end; +function TJsonObject.GetCount: Integer; +begin + Result := FList.Count; +end; +function TJsonObject.GetItems(Index: Integer): TJsonPair; +begin + Result := TJsonPair(FList[Index]); +end; +function TJsonObject.GetValues(Name: String): TJsonValue; +var + Index: Integer; + Pair: TJsonPair; +begin + Index := Find(Name); + if Index < 0 then + begin + if not FAutoAdd then RaiseError(Format('%s not found', [Name])); + Pair := Add(Name); + end + else Pair := TJsonPair(FList[Index]); + Result := Pair.Value; +end; +function TJsonObject.Insert(const Index: Integer; + const Name: String): TJsonPair; +begin + Result := TJsonPair.Create(Self, Name); + FList.Insert(Index, Result); +end; +procedure TJsonObject.Merge(Addition: TJsonObject); +var + I: Integer; +begin + for I := 0 to Addition.Count - 1 do Add.Assign(Addition.Items[I]); +end; +procedure TJsonObject.Parse(JsonString: String); +var + I: Integer; + S: String; + List: TStringList; + Item: TJsonPair; +begin + Clear; + JsonString := Trim(JsonString); + if not IsJsonObject(JsonString) then RaiseParseError(JsonString); + S := Trim(Copy(JsonString, 2, Length(JsonString) - 2)); + List := TStringList.Create; + try + Split(S, ',', List); + for I := 0 to List.Count - 1 do + begin + Item := Add; + Item.Parse(List[I]); + end; + finally + List.Free; + end; +end; +function TJsonObject.Put(const Name:String;const Value:Integer):TJsonValue; +begin + Result := Add(Name).Value; + Result.AsInteger := Value; +end; +function TJsonObject.Put(const Name:String;const Value:Extended):TJsonValue; +begin + Result := Add(Name).Value; + Result.AsNumber := Value; +end; +function TJsonObject.Put(const Name:String;const Value:Boolean):TJsonValue; +begin + Result := Add(Name).Value; + Result.AsBoolean := Value; +end; +function TJsonObject.Put(const Name:String;const Value:TJsonEmpty):TJsonValue; +begin + Result := Add(Name).Value; + Result.IsEmpty := True; +end; +function TJsonObject.Put(const Name:String;const Value:TJsonNull):TJsonValue; +begin + Result := Add(Name).Value; + Result.IsNull := True; +end; +function TJsonObject.Put(const Name:String;const Value:TJsonValue):TJsonValue; +begin + Result := Add(Name).Value; + Result.Assign(Value); +end; +function TJsonObject.Put(const Value: TJsonPair): TJsonValue; +var + Pair: TJsonPair; +begin + Pair := Add; + Pair.Assign(Value); + Result := Pair.Value; +end; +function TJsonObject.Put(const Name: String; + const Value: TJsonObject): TJsonValue; +begin + Result := Add(Name).Value; + Result.Assign(Value); +end; +function TJsonObject.Put(const Name, Value: String): TJsonValue; +begin + Result := Add(Name).Value; + Result.AsString := Value; +end; +function TJsonObject.Put(const Name: String; + const Value: TJsonArray): TJsonValue; +begin + Result := Add(Name).Value; + Result.Assign(Value); +end; +{ TJson } +procedure TJson.Assign(Source: TJsonBase); +begin + Clear; + if Source is TJson then + begin + case (Source as TJson).FStructType of + jsNone: ; + jsArray: + begin + CreateArrayIfNone; + FJsonArray.Assign((Source as TJson).FJsonArray); + end; + jsObject: + begin + CreateObjectIfNone; + FJsonObject.Assign((Source as TJson).FJsonObject); + end; + end; + end + else if Source is TJsonArray then + begin + CreateArrayIfNone; + FJsonArray.Assign(Source); + end + else if Source is TJsonObject then + begin + CreateObjectIfNone; + FJsonObject.Assign(Source); + end + else if Source is TJsonValue then + begin + if (Source as TJsonValue).ValueType = jvArray then + begin + CreateArrayIfNone; + FJsonArray.Assign((Source as TJsonValue).AsArray); + end + else if (Source as TJsonValue).ValueType = jvObject then + begin + CreateObjectIfNone; + FJsonObject.Assign((Source as TJsonValue).AsObject); + end + else RaiseAssignError(Source); + end + else RaiseAssignError(Source); +end; +procedure TJson.CheckJsonArray; +begin + CreateArrayIfNone; + RaiseIfNotArray; +end; +procedure TJson.CheckJsonObject; +begin + CreateObjectIfNone; + RaiseIfNotObject; +end; +procedure TJson.Clear; +begin + case FStructType of + jsNone: ; + jsArray: + begin + FJsonArray.Free; + FJsonArray := nil; + end; + jsObject: + begin + FJsonObject.Free; + FJsonObject := nil; + end; + end; + FStructType := jsNone; +end; +constructor TJson.Create; +begin + inherited Create(nil); + FStructType := jsNone; + FJsonArray := nil; + FJsonObject := nil; +end; +procedure TJson.CreateArrayIfNone; +begin + if FStructType = jsNone then + begin + FStructType := jsArray; + FJsonArray := TJsonArray.Create(Self); + end; +end; +procedure TJson.CreateObjectIfNone; +begin + if FStructType = jsNone then + begin + FStructType := jsObject; + FJsonObject := TJsonObject.Create(Self); + end; +end; +procedure TJson.Delete(const Index: Integer); +begin + RaiseIfNone; + case FStructType of + jsArray: FJsonArray.Delete(Index); + jsObject: FJsonObject.Delete(Index); + end; +end; +procedure TJson.Delete(const Name: String); +begin + RaiseIfNotObject; + FJsonObject.Delete(Name); +end; +destructor TJson.Destroy; +begin + Clear; + inherited Destroy; +end; +function TJson.Get(const Index: Integer): TJsonValue; +begin + Result := nil; + RaiseIfNone; + case FStructType of + jsArray: Result := FJsonArray.Items[Index]; + jsObject: Result := FJsonObject.Items[Index].Value; + end; +end; +function TJson.Get(const Name: String): TJsonValue; +begin + CheckJsonObject; + Result := FJsonObject.Values[Name]; +end; +function TJson.GetCount: Integer; +begin + case FStructType of + jsArray: Result := FJsonArray.Count; + jsObject: Result := FJsonObject.Count; + else Result := 0; + end; +end; +function TJson.GetJsonArray: TJsonArray; +begin + CheckJsonArray; + Result := FJsonArray; +end; +function TJson.GetJsonObject: TJsonObject; +begin + CheckJsonObject; + Result := FJsonObject; +end; +function TJson.GetValues(Name: String): TJsonValue; +begin + Result := Get(Name); +end; +procedure TJson.Parse(JsonString: String); +begin + Clear; + JsonString := Trim(JsonString); + if IsJsonArray(JsonString) then + begin + CreateArrayIfNone; + FJsonArray.Parse(JsonString); + end + else if IsJsonObject(JsonString) then + begin + CreateObjectIfNone; + FJsonObject.Parse(JsonString); + end + else RaiseParseError(JsonString); +end; +function TJson.Put(const Value: Integer): TJsonValue; +begin + CheckJsonArray; + Result := FJsonArray.Put(Value); +end; +function TJson.Put(const Value: Extended): TJsonValue; +begin + CheckJsonArray; + Result := FJsonArray.Put(Value); +end; +function TJson.Put(const Value: Boolean): TJsonValue; +begin + CheckJsonArray; + Result := FJsonArray.Put(Value); +end; +function TJson.Put(const Value: TJsonEmpty): TJsonValue; +begin + CheckJsonArray; + Result := FJsonArray.Put(Value); +end; +function TJson.Put(const Value: TJsonNull): TJsonValue; +begin + CheckJsonArray; + Result := FJsonArray.Put(Value); +end; +function TJson.Put(const Value: String): TJsonValue; +begin + CheckJsonArray; + Result := FJsonArray.Put(Value); +end; +function TJson.Put(const Value: TJsonValue): TJsonValue; +begin + CheckJsonArray; + Result := FJsonArray.Put(Value); +end; +function TJson.Put(const Value: TJsonObject): TJsonValue; +begin + CheckJsonArray; + Result := FJsonArray.Put(Value); +end; +function TJson.Put(const Value: TJsonArray): TJsonValue; +begin + CheckJsonArray; + Result := FJsonArray.Put(Value); +end; +function TJson.Put(const Name: String; const Value: Integer): TJsonValue; +begin + CheckJsonObject; + Result := FJsonObject.Put(Name, Value); +end; +function TJson.Put(const Name: String; const Value: Extended): TJsonValue; +begin + CheckJsonObject; + Result := FJsonObject.Put(Name, Value); +end; +function TJson.Put(const Name: String; const Value: Boolean): TJsonValue; +begin + CheckJsonObject; + Result := FJsonObject.Put(Name, Value); +end; +function TJson.Put(const Name: String; + const Value: TJsonEmpty): TJsonValue; +begin + CheckJsonObject; + Result := FJsonObject.Put(Name, Value); +end; +function TJson.Put(const Name: String; const Value: TJsonNull): TJsonValue; +begin + CheckJsonObject; + Result := FJsonObject.Put(Name, Value); +end; +function TJson.Put(const Name: String; + const Value: TJsonValue): TJsonValue; +begin + CheckJsonObject; + Result := FJsonObject.Put(Name, Value); +end; +function TJson.Put(const Value: TJsonPair): TJsonValue; +begin + CheckJsonObject; + Result := FJsonObject.Put(Value); +end; +function TJson.Put(const Name: String; + const Value: TJsonObject): TJsonValue; +begin + CheckJsonObject; + Result := FJsonObject.Put(Name, Value); +end; +function TJson.Put(const Name, Value: String): TJsonValue; +begin + CheckJsonObject; + Result := FJsonObject.Put(Name, Value); +end; +function TJson.Put(const Name: String; + const Value: TJsonArray): TJsonValue; +begin + CheckJsonObject; + Result := FJsonObject.Put(Name, Value); +end; +function TJson.Put(const Value: TJson): TJsonValue; +begin + CheckJsonArray; + case Value.FStructType of + jsArray: Result := Put(Value.FJsonArray); + jsObject: Result := Put(Value.FJsonObject); + else Result := nil; + end; +end; +function TJson.Put(const Name: String; const Value: TJson): TJsonValue; +begin + CheckJsonObject; + case Value.FStructType of + jsArray: Result := Put(Name, Value.FJsonArray); + jsObject: Result := Put(Name, Value.FJsonObject); + else Result := nil; + end; +end; +procedure TJson.RaiseIfNone; +begin + if FStructType = jsNone then RaiseError('json struct type is jsNone'); +end; +procedure TJson.RaiseIfNotArray; +begin + if FStructType <> jsArray then RaiseError('json struct type is not jsArray'); +end; +procedure TJson.RaiseIfNotObject; +begin + if FStructType <> jsObject then RaiseError('json struct type is not jsObject'); +end; +function TJson.Stringify: String; +begin + case FStructType of + jsArray: Result := FJsonArray.Stringify; + jsObject: Result := FJsonObject.Stringify; + else Result := ''; + end; +end; +end. diff --git a/src/JsonsUtilsEx.pas b/src/JsonsUtilsEx.pas index 9600e4e..8b4e9b3 100644 --- a/src/JsonsUtilsEx.pas +++ b/src/JsonsUtilsEx.pas @@ -144,8 +144,8 @@ function FixedTryStrToFloat(const S: string; out Value: Extended): Boolean; else begin FixedS := StringReplace( S, - GLB_JSON_STD_DECIMALSEPARATOR, JsonsUtils_GLB_DECIMALSEPARATOR, + GLB_JSON_STD_DECIMALSEPARATOR, [rfReplaceAll]); Result := TryStrToFloat(FixedS, Value); end; @@ -166,8 +166,8 @@ function FixedStrToFloat(const S: string): Extended; else begin FixedS := StringReplace( S, - GLB_JSON_STD_DECIMALSEPARATOR, JsonsUtils_GLB_DECIMALSEPARATOR, + GLB_JSON_STD_DECIMALSEPARATOR, [rfReplaceAll]); Result := StrToFloat(FixedS); end; From 8e847fee14f68892faae2792993a9a9c1b3b25b1 Mon Sep 17 00:00:00 2001 From: Hafedh TRIMECHE Date: Mon, 13 Sep 2021 23:19:08 +0100 Subject: [PATCH 05/10] --- src/JsonsUtilsEx.pas | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/JsonsUtilsEx.pas b/src/JsonsUtilsEx.pas index 8b4e9b3..31a0b96 100644 --- a/src/JsonsUtilsEx.pas +++ b/src/JsonsUtilsEx.pas @@ -115,6 +115,12 @@ function FixedFloatToStr(const Value: Extended): string; var lS: string; begin + lS := FloatToStr(Frac(Value)); + if LS='0' then + begin + Result := IntToStr(Int64(Trunc(Value))); + Exit; + end; lS := FloatToStr(Value); if JsonsUtils_GLB_DECIMALSEPARATOR = GLB_JSON_STD_DECIMALSEPARATOR then begin From ee0d8c10d9a5fd003b59aacf4831d47aa6871052 Mon Sep 17 00:00:00 2001 From: Hafedh TRIMECHE Date: Mon, 13 Sep 2021 23:27:56 +0100 Subject: [PATCH 06/10] --- src/JsonsUtilsEx.pas | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/JsonsUtilsEx.pas b/src/JsonsUtilsEx.pas index 31a0b96..a55c544 100644 --- a/src/JsonsUtilsEx.pas +++ b/src/JsonsUtilsEx.pas @@ -115,11 +115,14 @@ function FixedFloatToStr(const Value: Extended): string; var lS: string; begin - lS := FloatToStr(Frac(Value)); - if LS='0' then + if Abs(Value)<=High(UInt64) then begin - Result := IntToStr(Int64(Trunc(Value))); - Exit; + lS := FloatToStr(Frac(Value)); + if LS='0' then + begin + Result := IntToStr(Int64(Trunc(Value))); + Exit; + end; end; lS := FloatToStr(Value); if JsonsUtils_GLB_DECIMALSEPARATOR = GLB_JSON_STD_DECIMALSEPARATOR then From 537a89fca8015f5d4d12b6da76ac2ced4d51e517 Mon Sep 17 00:00:00 2001 From: Hafedh TRIMECHE Date: Tue, 14 Sep 2021 15:00:18 +0100 Subject: [PATCH 07/10] --- src/Jsons.pas | 5 ++++- src/JsonsUtilsEx.pas | 8 ++++---- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/src/Jsons.pas b/src/Jsons.pas index 731e2d7..306b574 100644 --- a/src/Jsons.pas +++ b/src/Jsons.pas @@ -25,7 +25,10 @@ {$MODE Delphi} {$ENDIF} interface -uses Classes, SysUtils, jsonsutilsEx; +uses + Classes, SysUtils, jsonsutilsEx; +const + MAX_SAFE_INTEGER = 9007199254740991; type TJsonValueType = (jvNone, jvNull, jvString, jvNumber, jvBoolean, jvObject, jvArray); TJsonStructType = (jsNone, jsArray, jsObject); diff --git a/src/JsonsUtilsEx.pas b/src/JsonsUtilsEx.pas index a55c544..ead0828 100644 --- a/src/JsonsUtilsEx.pas +++ b/src/JsonsUtilsEx.pas @@ -111,14 +111,14 @@ function GetDecimalSeparator : Char; end; -function FixedFloatToStr(const Value: Extended): string; +function FixedFloatToStr(const Value:Extended):string; var - lS: string; + lS : string; begin - if Abs(Value)<=High(UInt64) then + if Abs(Value)<=MAX_SAFE_INTEGER then begin lS := FloatToStr(Frac(Value)); - if LS='0' then + if lS='0' then begin Result := IntToStr(Int64(Trunc(Value))); Exit; From 7dc5e3cad9545d33f4ca692f1d02756ee749bca8 Mon Sep 17 00:00:00 2001 From: Hafedh TRIMECHE Date: Tue, 14 Sep 2021 23:22:27 +0100 Subject: [PATCH 08/10] --- src/JsonsUtilsEx.pas | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/JsonsUtilsEx.pas b/src/JsonsUtilsEx.pas index ead0828..9dea644 100644 --- a/src/JsonsUtilsEx.pas +++ b/src/JsonsUtilsEx.pas @@ -30,6 +30,7 @@ function FixedStrToFloat(const S: string): Extended; implementation Uses TypInfo, + Math, DateUtils, Jsons; @@ -170,7 +171,7 @@ function FixedStrToFloat(const S: string): Extended; begin if JsonsUtils_GLB_DECIMALSEPARATOR = GLB_JSON_STD_DECIMALSEPARATOR then begin - Result := StrToFloat(S); + if not TryStrToFloat(S,Result) then Result := NAN; end else begin @@ -178,7 +179,7 @@ function FixedStrToFloat(const S: string): Extended; JsonsUtils_GLB_DECIMALSEPARATOR, GLB_JSON_STD_DECIMALSEPARATOR, [rfReplaceAll]); - Result := StrToFloat(FixedS); + if not TryStrToFloat(FixedS,Result) then Result := NAN; end; end; From df3fe72b257ac492422143f37a38796557ed159a Mon Sep 17 00:00:00 2001 From: Hafedh TRIMECHE Date: Sun, 6 Nov 2022 12:28:26 +0100 Subject: [PATCH 09/10] TStringStream replaced by a String Builder function: AppendString --- src/Jsons.pas | 1491 +++++++++++++++++++++++++++---------------------- 1 file changed, 836 insertions(+), 655 deletions(-) diff --git a/src/Jsons.pas b/src/Jsons.pas index 306b574..0c9c19e 100644 --- a/src/Jsons.pas +++ b/src/Jsons.pas @@ -18,7 +18,7 @@ THE SOFTWARE. 201804 - Fiy - VGS - Refactor FixedFloatToStr (best use case and optimization) 201805 - Add - VGS - Add OBjectToJson and JsonToObject, rtti based, cross platform Delphi10+ and FPC 3+Refactor -201807 - Fix - VGS - String unicode (\uxxx) encoding and decoding. +201807 - Fix - VGS - string unicode (\uxxx) encoding and decoding. ****************************************************************************} unit Jsons; {$IFDEF FPC} @@ -26,176 +26,186 @@ {$ENDIF} interface uses - Classes, SysUtils, jsonsutilsEx; + Classes,Math,SysUtils,jsonsutilsEx; const MAX_SAFE_INTEGER = 9007199254740991; type - TJsonValueType = (jvNone, jvNull, jvString, jvNumber, jvBoolean, jvObject, jvArray); - TJsonStructType = (jsNone, jsArray, jsObject); - TJsonNull = (null); - TJsonEmpty = (empty); + TJsonValueType = (jvNone,jvNull,jvString,jvNumber,jvBoolean,jvObject,jvArray); + TJsonStructType = (jsNone,jsArray,jsObject); + TJsonNull = (null); + TJsonEmpty = (empty); type TJsonValue = class; - TJsonBase = class(TObject) + TJsonBase = class(TObject) private FOwner : TJsonBase; - function GetOwner: TJsonBase; - procedure InternalStringify(Stream:TStringStream;AName:string;AValue:TJsonValue); + function GetOwner:TJsonBase; + procedure InternalStringify(var Stream:string;var Size:NativeInt;AName:string;AValue:TJsonValue); protected - function GetOwnerName: String; - procedure RaiseError(const Msg: String); - procedure RaiseParseError(const JsonString: String); - procedure RaiseAssignError(Source: TJsonBase); + function GetOwnerName:string; + procedure RaiseError(const Msg:string); + procedure RaiseParseError(const JsonString:string); + procedure RaiseAssignError(Source:TJsonBase); public - constructor Create(AOwner: TJsonBase); - destructor Destroy; override; - procedure Parse(JsonString: String); virtual; abstract; + constructor Create(AOwner:TJsonBase); + public + procedure Parse(JsonString:string);virtual;abstract; function Stringify:string;virtual; - procedure Assign(Source: TJsonBase); virtual; abstract; - function Encode(const S: String): String; - function Decode(const S: String): String; - procedure Split(const S: String; const Delimiter: Char; Strings: TStrings); - function IsJsonObject(const S: String): Boolean; - function IsJsonArray(const S: String): Boolean; - function IsJsonString(const S: String): Boolean; - function IsJsonNumber(const S: String): Boolean; - function IsJsonBoolean(const S: String): Boolean; - function IsJsonNull(const S: String): Boolean; - function AnalyzeJsonValueType(const S: String): TJsonValueType; + procedure Assign(Source:TJsonBase);virtual;abstract; + function Encode(const S:string):string; + function Decode(const S:string):string; + procedure Split(const S:string;const Delimiter:Char;Strings:TStrings); + function IsJsonObject(const S:string):Boolean; + function IsJsonArray(const S:string):Boolean; + function IsJsonString(const S:string):Boolean; + function IsJsonNumber(const S:string):Boolean; + function IsJsonBoolean(const S:string):Boolean; + function IsJsonNull(const S:string):Boolean; + function AnalyzeJsonValueType(const S:string):TJsonValueType; public - property Owner: TJsonBase read GetOwner; + property Owner : TJsonBase read GetOwner; end; + TJsonObject = class; TJsonArray = class; + TJsonValue = class(TJsonBase) private - FValueType: TJsonValueType; - FStringValue: String; - FNumberValue: Extended; - FBooleanValue: Boolean; - FObjectValue: TJsonObject; - FArrayValue: TJsonArray; - function GetAsArray: TJsonArray; - function GetAsBoolean: Boolean; - function GetAsInteger: Integer; - function GetAsNumber: Extended; - function GetAsObject: TJsonObject; - function GetAsString: String; - function GetIsNull: Boolean; - procedure SetAsBoolean(const Value: Boolean); - procedure SetAsInteger(const Value: Integer); - procedure SetAsNumber(const Value: Extended); - procedure SetAsString(const Value: String); - procedure SetIsNull(const Value: Boolean); - procedure SetAsArray(const Value: TJsonArray); - procedure SetAsObject(const Value: TJsonObject); - function GetIsEmpty: Boolean; - procedure SetIsEmpty(const Value: Boolean); + FValueType : TJsonValueType; + FStringValue : string; + FNumberValue : Extended; + FBooleanValue : Boolean; + FObjectValue : TJsonObject; + FArrayValue : TJsonArray; + function GetAsArray:TJsonArray; + function GetAsBoolean:Boolean; + function GetAsInteger:Integer; + function GetAsNumber:Extended; + function GetAsObject:TJsonObject; + function GetAsString:string; + function GetIsNull:Boolean; + procedure SetAsBoolean(const Value:Boolean); + procedure SetAsInteger(const Value:Integer); + procedure SetAsNumber(const Value:Extended); + procedure SetAsString(const Value:string); + procedure SetIsNull(const Value:Boolean); + procedure SetAsArray(const Value:TJsonArray); + procedure SetAsObject(const Value:TJsonObject); + function GetIsEmpty:Boolean; + procedure SetIsEmpty(const Value:Boolean); protected - procedure RaiseValueTypeError(const AsValueType: TJsonValueType); + procedure RaiseValueTypeError(const AsValueType:TJsonValueType); + public + constructor Create(AOwner:TJsonBase); + destructor Destroy;override; public - constructor Create(AOwner: TJsonBase); - destructor Destroy; override; - procedure Parse(JsonString: String); override; - procedure Assign(Source: TJsonBase); override; + procedure Parse(JsonString:string);override; + procedure Assign(Source:TJsonBase);override; procedure Clear; public - property ValueType: TJsonValueType read FValueType; - property AsString: String read GetAsString write SetAsString; - property AsNumber: Extended read GetAsNumber write SetAsNumber; - property AsInteger: Integer read GetAsInteger write SetAsInteger; - property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean; - property AsObject: TJsonObject read GetAsObject write SetAsObject; - property AsArray: TJsonArray read GetAsArray write SetAsArray; - property IsNull: Boolean read GetIsNull write SetIsNull; - property IsEmpty: Boolean read GetIsEmpty write SetIsEmpty; + property ValueType : TJsonValueType read FValueType; + property AsString : string read GetAsString write SetAsString; + property AsNumber : Extended read GetAsNumber write SetAsNumber; + property AsInteger : Integer read GetAsInteger write SetAsInteger; + property AsBoolean : Boolean read GetAsBoolean write SetAsBoolean; + property AsObject : TJsonObject read GetAsObject write SetAsObject; + property AsArray : TJsonArray read GetAsArray write SetAsArray; + property IsNull : Boolean read GetIsNull write SetIsNull; + property IsEmpty : Boolean read GetIsEmpty write SetIsEmpty; end; + TJsonArray = class(TJsonBase) private - FList: TList; - function GetItems(Index: Integer): TJsonValue; - function GetCount: Integer; + FList : TList; + function GetItems(Index:Integer):TJsonValue; + function GetCount:Integer; + public + constructor Create(AOwner:TJsonBase=nil); + destructor Destroy;override; public - constructor Create(AOwner: TJsonBase = nil); - destructor Destroy; override; - procedure Parse(JsonString: String); override; - procedure Assign(Source: TJsonBase); override; - procedure Merge(Addition: TJsonArray); - function Add: TJsonValue; - function Insert(const Index: Integer): TJsonValue; - function Put(const Value: TJsonEmpty): TJsonValue; overload; - function Put(const Value: TJsonNull): TJsonValue; overload; - function Put(const Value: Boolean): TJsonValue; overload; - function Put(const Value: Integer): TJsonValue; overload; - function Put(const Value: Extended): TJsonValue; overload; - function Put(const Value: String): TJsonValue; overload; - function Put(const Value: TJsonArray): TJsonValue; overload; - function Put(const Value: TJsonObject): TJsonValue; overload; - function Put(const Value: TJsonValue): TJsonValue; overload; - procedure Delete(const Index: Integer); + procedure Parse(JsonString:string);override; + procedure Assign(Source:TJsonBase);override; + procedure Merge(Addition:TJsonArray); + function Add:TJsonValue; + function Insert(const Index:Integer):TJsonValue; + function Put(const Value:TJsonEmpty):TJsonValue;overload; + function Put(const Value:TJsonNull):TJsonValue;overload; + function Put(const Value:Boolean):TJsonValue;overload; + function Put(const Value:Integer):TJsonValue;overload; + function Put(const Value:Extended):TJsonValue;overload; + function Put(const Value:string):TJsonValue;overload; + function Put(const Value:TJsonArray):TJsonValue;overload; + function Put(const Value:TJsonObject):TJsonValue;overload; + function Put(const Value:TJsonValue):TJsonValue;overload; + procedure Delete(const Index:Integer); procedure Clear; public - property Count: Integer read GetCount; - property Items[Index: Integer]: TJsonValue read GetItems; default; + property Count : Integer read GetCount; + property Items[Index: Integer] : TJsonValue read GetItems;default; end; + TJsonPair = class(TJsonBase) private - FName: String; - FValue: TJsonValue; - procedure SetName(const Value: String); + FName : string; + FValue : TJsonValue; + procedure SetName(const Value:string); + public + constructor Create(AOwner:TJsonBase;const AName:string=''); + destructor Destroy;override; public - constructor Create(AOwner: TJsonBase; const AName: String = ''); - destructor Destroy; override; - procedure Parse(JsonString: String); override; - procedure Assign(Source: TJsonBase); override; + procedure Parse(JsonString:string);override; + procedure Assign(Source:TJsonBase);override; public - property Name: String read FName write SetName; - property Value: TJsonValue read FValue; + property Name : string read FName write SetName; + property Value : TJsonValue read FValue; end; + TJsonObject = class(TJsonBase) private - FList: TList; - FAutoAdd: Boolean; - function GetCount: Integer; - function GetItems(Index: Integer): TJsonPair; - function GetValues(Name: String): TJsonValue; + FList : TList; + FAutoAdd : Boolean; + function GetCount:Integer; + function GetItems(Index:Integer):TJsonPair; + function GetValues(Name:string):TJsonValue; + public + constructor Create(AOwner:TJsonBase=nil); + destructor Destroy;override; public - constructor Create(AOwner: TJsonBase = nil); - destructor Destroy; override; - procedure Parse(JsonString: String); override; - procedure Assign(Source: TJsonBase); override; - procedure Merge(Addition: TJsonObject); - function Add(const Name: String = ''): TJsonPair; - function Insert(const Index: Integer; const Name: String = ''): TJsonPair; - function Put(const Name: String; const Value: TJsonEmpty): TJsonValue; overload; - function Put(const Name: String; const Value: TJsonNull): TJsonValue; overload; - function Put(const Name: String; const Value: Boolean): TJsonValue; overload; - function Put(const Name: String; const Value: Integer): TJsonValue; overload; - function Put(const Name: String; const Value: Extended): TJsonValue; overload; - function Put(const Name: String; const Value: String): TJsonValue; overload; - function Put(const Name: String; const Value: TJsonArray): TJsonValue; overload; - function Put(const Name: String; const Value: TJsonObject): TJsonValue; overload; - function Put(const Name: String; const Value: TJsonValue): TJsonValue; overload; - function Put(const Value: TJsonPair): TJsonValue; overload; - function Find(const Name: String): Integer; - procedure Delete(const Index: Integer); overload; - procedure Delete(const Name: String); overload; + procedure Parse(JsonString:string);override; + procedure Assign(Source:TJsonBase);override; + procedure Merge(Addition:TJsonObject); + function Add(const Name:string=''):TJsonPair; + function Insert(const Index:Integer;const Name:string=''):TJsonPair; + function Put(const Name:string;const Value:TJsonEmpty):TJsonValue;overload; + function Put(const Name:string;const Value:TJsonNull):TJsonValue;overload; + function Put(const Name:string;const Value:Boolean):TJsonValue;overload; + function Put(const Name:string;const Value:Integer):TJsonValue;overload; + function Put(const Name:string;const Value:Extended):TJsonValue;overload; + function Put(const Name:string;const Value:string):TJsonValue;overload; + function Put(const Name:string;const Value:TJsonArray):TJsonValue;overload; + function Put(const Name:string;const Value:TJsonObject):TJsonValue;overload; + function Put(const Name:string;const Value:TJsonValue):TJsonValue;overload; + function Put(const Value:TJsonPair):TJsonValue;overload; + function Find(const Name:string):Integer; + procedure Delete(const Index:Integer);overload; + procedure Delete(const Name:string);overload; procedure Clear; public - property Count: Integer read GetCount; - property Items[Index: Integer]: TJsonPair read GetItems; - property Values[Name: String]: TJsonValue read GetValues; default; - property AutoAdd: Boolean read FAutoAdd write FAutoAdd; + property Count : Integer read GetCount; + property Items[Index:Integer] : TJsonPair read GetItems; + property Values[Name:string] : TJsonValue read GetValues;default; + property AutoAdd : Boolean read FAutoAdd write FAutoAdd; end; + TJson = class(TJsonBase) private - FStructType: TJsonStructType; - FJsonArray: TJsonArray; - FJsonObject: TJsonObject; - function GetCount: Integer; - function GetJsonArray: TJsonArray; - function GetJsonObject: TJsonObject; - function GetValues(Name: String): TJsonValue; + FStructType : TJsonStructType; + FJsonArray : TJsonArray; + FJsonObject : TJsonObject; + function GetCount:Integer; + function GetJsonArray:TJsonArray; + function GetJsonObject:TJsonObject; + function GetValues(Name:string):TJsonValue; protected procedure CreateArrayIfNone; procedure CreateObjectIfNone; @@ -206,170 +216,198 @@ TJson = class(TJsonBase) procedure CheckJsonObject; public constructor Create; - destructor Destroy; override; - procedure Parse(JsonString: String); override; - function Stringify: String; override; - procedure Assign(Source: TJsonBase); override; - procedure Delete(const Index: Integer); overload; - procedure Delete(const Name: String); overload; + destructor Destroy;override; + public + procedure Parse(JsonString:string);override; + function Stringify:string;override; + procedure Assign(Source:TJsonBase);override; + procedure Delete(const Index:Integer);overload; + procedure Delete(const Name:string);overload; procedure Clear; - function Get(const Index: Integer): TJsonValue; overload; //for both - function Get(const Name: String): TJsonValue; overload; //for JsonObject + function Get(const Index:Integer):TJsonValue;overload; //for both + function Get(const Name:string):TJsonValue;overload; //for JsonObject //for JsonArray - function Put(const Value: TJsonEmpty): TJsonValue; overload; - function Put(const Value: TJsonNull): TJsonValue; overload; - function Put(const Value: Boolean): TJsonValue; overload; - function Put(const Value: Integer): TJsonValue; overload; - function Put(const Value: Extended): TJsonValue; overload; - function Put(const Value: String): TJsonValue; overload; - function Put(const Value: TJsonArray): TJsonValue; overload; - function Put(const Value: TJsonObject): TJsonValue; overload; - function Put(const Value: TJsonValue): TJsonValue; overload; - function Put(const Value: TJson): TJsonValue; overload; + function Put(const Value:TJsonEmpty):TJsonValue;overload; + function Put(const Value:TJsonNull):TJsonValue;overload; + function Put(const Value:Boolean):TJsonValue;overload; + function Put(const Value:Integer):TJsonValue;overload; + function Put(const Value:Extended):TJsonValue;overload; + function Put(const Value:string):TJsonValue;overload; + function Put(const Value:TJsonArray):TJsonValue;overload; + function Put(const Value:TJsonObject):TJsonValue;overload; + function Put(const Value:TJsonValue):TJsonValue;overload; + function Put(const Value:TJson):TJsonValue;overload; //for JsonObject - function Put(const Name: String; const Value: TJsonEmpty): TJsonValue; overload; - function Put(const Name: String; const Value: TJsonNull): TJsonValue; overload; - function Put(const Name: String; const Value: Boolean): TJsonValue; overload; - function Put(const Name: String; const Value: Integer): TJsonValue; overload; - function Put(const Name: String; const Value: Extended): TJsonValue; overload; - function Put(const Name: String; const Value: String): TJsonValue; overload; - function Put(const Name: String; const Value: TJsonArray): TJsonValue; overload; - function Put(const Name: String; const Value: TJsonObject): TJsonValue; overload; - function Put(const Name: String; const Value: TJsonValue): TJsonValue; overload; - function Put(const Name: String; const Value: TJson): TJsonValue; overload; - function Put(const Value: TJsonPair): TJsonValue; overload; + function Put(const Name:string; const Value:TJsonEmpty):TJsonValue;overload; + function Put(const Name:string; const Value:TJsonNull):TJsonValue;overload; + function Put(const Name:string; const Value:Boolean):TJsonValue;overload; + function Put(const Name:string; const Value:Integer):TJsonValue;overload; + function Put(const Name:string; const Value:Extended):TJsonValue;overload; + function Put(const Name:string; const Value:string):TJsonValue;overload; + function Put(const Name:string; const Value:TJsonArray):TJsonValue;overload; + function Put(const Name:string; const Value:TJsonObject):TJsonValue;overload; + function Put(const Name:string; const Value:TJsonValue):TJsonValue;overload; + function Put(const Name:string; const Value:TJson):TJsonValue;overload; + function Put(const Value:TJsonPair):TJsonValue;overload; public - property StructType: TJsonStructType read FStructType; - property JsonObject: TJsonObject read GetJsonObject; - property JsonArray: TJsonArray read GetJsonArray; - property Count: Integer read GetCount; - property Values[Name: String]: TJsonValue read GetValues; default; //for JsonObject + property StructType : TJsonStructType read FStructType; + property JsonObject : TJsonObject read GetJsonObject; + property JsonArray : TJsonArray read GetJsonArray; + property Count : Integer read GetCount; + property Values[Name: string] : TJsonValue read GetValues;default; //for JsonObject + end; + + implementation + +procedure AppendString(var Buffer:string;var Size:NativeInt;const Value:string); +var + Capacity , + DataLen : NativeInt; +begin + if Size<0 then + begin + SetLength(Buffer,Max(1024,Length(Value))); + Size := 0; + end; + DataLen := Length(Value); + Capacity := Length(Buffer); + if Size+DataLen>Capacity then + begin + Capacity := Round(Capacity*1.3)+DataLen; + SetLength(Buffer,Capacity); end; -implementation + if Value<>'' then Move(Value[1],Buffer[Size+1],DataLen*SizeOf(Char)); + Inc(Size,DataLen); +end; + { TJsonBase } -function TJsonBase.AnalyzeJsonValueType(const S: String): TJsonValueType; +function TJsonBase.AnalyzeJsonValueType(const S:string):TJsonValueType; var - Len: Integer; - Number: Extended; + Len : Integer; + Number : Extended; begin Result := jvNone; - Len := Length(S); - if Len >= 2 then + Len := Length(S); + if Len>=2 then begin - if (S[1] = '{') and (S[Len] = '}') then Result := jvObject - else if (S[1] = '[') and (S[Len] = ']') then Result := jvArray - else if (S[1] = '"') and (S[Len] = '"') then Result := jvString - else if SameText(S, 'null') then Result := jvNull - else if SameText(S, 'true') or SameText(S, 'false') then Result := jvBoolean - else if FixedTryStrToFloat(S, Number) then Result := jvNumber; + if (S[1]='{') and (S[Len]='}') then Result := jvObject else + if (S[1]='[') and (S[Len]=']') then Result := jvArray else + if (S[1]='"') and (S[Len]='"') then Result := jvString else + if SameText(S,'null') then Result := jvNull else + if SameText(S,'true') or SameText(S,'false') then Result := jvBoolean else + if FixedTryStrToFloat(S,Number) then Result := jvNumber; end - else if FixedTryStrToFloat(S, Number) then Result := jvNumber; + else + begin + if FixedTryStrToFloat(S,Number) then Result := jvNumber; + end; end; -constructor TJsonBase.Create(AOwner: TJsonBase); + +constructor TJsonBase.Create(AOwner:TJsonBase); begin FOwner := AOwner; end; -function TJsonBase.Decode(const S: String): String; - function HexValue(C: Char): Byte; - begin - case C of - '0'..'9': Result := Byte(C) - Byte('0'); - 'a'..'f': Result := (Byte(C) - Byte('a')) + 10; - 'A'..'F': Result := (Byte(C) - Byte('A')) + 10; - else raise Exception.Create('Illegal hexadecimal characters "' + C + '"'); - end; + +function TJsonBase.Decode(const S:string):string; +function HexValue(C:Char):Byte; +begin + case C of + '0'..'9': Result := Byte(C)-Byte('0'); + 'a'..'f': Result := (Byte(C)-Byte('a')) + 10; + 'A'..'F': Result := (Byte(C)-Byte('A')) + 10; + else raise Exception.Create('Illegal hexadecimal characters "'+C+'"'); end; +end; var - I : Integer; - C : Char; - ubuf : integer; - Stream : TStringStream; -begin - Stream := TStringStream.Create; - I := 1; - while I <= Length(S) do + I : Integer; + C : Char; + ubuf : Integer; + Size : NativeInt; +begin + Size := -1; + AppendString(Result,Size,''); + I := 1; + while I<=Length(S) do begin C := S[I]; Inc(I); - if C = '\' then + if C='\' then begin C := S[I]; Inc(I); case C of - 'b': Stream.WriteString(#8); - 't': Stream.WriteString(#9); - 'n': Stream.WriteString(#10); - 'f': Stream.WriteString(#12); - 'r': Stream.WriteString(#13); + 'b': AppendString(Result,Size,#8); + 't': AppendString(Result,Size,#9); + 'n': AppendString(Result,Size,#10); + 'f': AppendString(Result,Size,#12); + 'r': AppendString(Result,Size,#13); 'u': begin - if not TryStrToInt('$' + Copy(S, I, 4), ubuf) then - raise Exception.Create(format('Invalid unicode \u%s',[Copy(S, I, 4)])); - Stream.WriteString(WideChar(ubuf)); - Inc(I, 4); + if not TryStrToInt('$'+Copy(S,I,4),ubuf) then raise Exception.Create(format('Invalid unicode \u%s',[Copy(S,I,4)])); + AppendString(Result,Size,WideChar(ubuf)); + Inc(I,4); end; - else Stream.WriteString(C); + else + AppendString(Result,Size,C); end; end - else Stream.WriteString(C); + else AppendString(Result,Size,C); end; - Result := Stream.DataString; - Stream.Free; -end; -destructor TJsonBase.Destroy; -begin - inherited Destroy; + SetLength(Result,Size); end; -function TJsonBase.Encode(const S: String): String; + +function TJsonBase.Encode(const S:string):string; var I , UnicodeValue : Integer; C : Char; - Stream : TStringStream; + Size : NativeInt; begin - Stream := TStringStream.Create; - for I := 1 to Length(S) do + Size := -1; + AppendString(Result,Size,''); + for I:=1 to Length(S) do begin C := S[I]; case C of - '"': Stream.WriteString('\'+C); - '\': Stream.WriteString('\'+C); - '/': Stream.WriteString('\'+C); - #8: Stream.WriteString('\b'); - #9: Stream.WriteString('\t'); - #10: Stream.WriteString('\n'); - #12: Stream.WriteString('\f'); - #13: Stream.WriteString('\r'); - else - if (C < WideChar(32)) or (C > WideChar(127)) then + '"' : AppendString(Result,Size,'\'+C); + '\' : AppendString(Result,Size,'\'+C); + '/' : AppendString(Result,Size,'\'+C); + #8 : AppendString(Result,Size,'\b'); + #9 : AppendString(Result,Size,'\t'); + #10 : AppendString(Result,Size,'\n'); + #12 : AppendString(Result,Size,'\f'); + #13 : AppendString(Result,Size,'\r'); + else + if (CWideChar(127)) then begin - Stream.WriteString('\u'); + AppendString(Result,Size,'\u'); UnicodeValue := Ord(C); - Stream.WriteString(lowercase(IntToHex((UnicodeValue and 61440) shr 12,1))); - Stream.WriteString(lowercase(IntToHex((UnicodeValue and 3840) shr 8,1))); - Stream.WriteString(lowercase(IntToHex((UnicodeValue and 240) shr 4,1))); - Stream.WriteString(lowercase(IntToHex((UnicodeValue and 15),1))); + AppendString(Result,Size,lowercase(IntToHex((UnicodeValue and 61440) shr 12,1))); + AppendString(Result,Size,lowercase(IntToHex((UnicodeValue and 3840) shr 8,1))); + AppendString(Result,Size,lowercase(IntToHex((UnicodeValue and 240) shr 4,1))); + AppendString(Result,Size,lowercase(IntToHex((UnicodeValue and 15),1))); end - else Stream.WriteString(C); + else AppendString(Result,Size,C); end; end; - Result := Stream.DataString; - Stream.Free; + SetLength(Result,Size); end; -function TJsonBase.GetOwner: TJsonBase; + +function TJsonBase.GetOwner:TJsonBase; begin Result := FOwner; end; -function TJsonBase.GetOwnerName: String; + +function TJsonBase.GetOwnerName:string; var - TheOwner: TJsonBase; + TheOwner : TJsonBase; begin - Result := ''; + Result := ''; TheOwner := Owner; while True do begin - if not Assigned(TheOwner) then Break - else if TheOwner is TJsonPair then + if not Assigned(TheOwner) then Break else + if TheOwner is TJsonPair then begin Result := (TheOwner as TJsonPair).Name; Break; @@ -377,9 +415,10 @@ function TJsonBase.GetOwnerName: String; else TheOwner := TheOwner.Owner; end; end; -procedure TJsonBase.InternalStringify(Stream:TStringStream;AName:string;AValue:TJsonValue); + +procedure TJsonBase.InternalStringify(var Stream:string;var Size:NativeInt;AName:string;AValue:TJsonValue); const - StrBoolean : array[Boolean] of string = ('false', 'true'); + StrBoolean : array[Boolean] of string = ('false','true'); procedure ObjectStringify(JsonObject:Jsons.TJsonObject); var i , @@ -387,18 +426,18 @@ procedure ObjectStringify(JsonObject:Jsons.TJsonObject); Item : TJsonPair; begin cnt := 0; - Stream.WriteString('{'); + AppendString(Stream,Size,'{'); for i:=0 to JsonObject.Count-1 do begin Item := JsonObject.Items[i]; if Item.Value.ValueType<>jvNone then begin - if cnt>0 then Stream.WriteString(','); - InternalStringify(Stream,Item.Name,Item.Value); + if cnt>0 then AppendString(Stream,Size,','); + InternalStringify(Stream,Size,Item.Name,Item.Value); Inc(cnt); end; end; - Stream.WriteString('}'); + AppendString(Stream,Size,'}'); end; procedure ArrayStringify(JsonArray:Jsons.TJsonArray); var @@ -407,28 +446,28 @@ procedure ArrayStringify(JsonArray:Jsons.TJsonArray); Item : TJsonValue; begin cnt := 0; - Stream.WriteString('['); + AppendString(Stream,Size,'['); for i:=0 to JsonArray.Count-1 do begin Item := JsonArray.Items[i]; if Item.ValueType<>jvNone then begin - if cnt>0 then Stream.WriteString(','); - InternalStringify(Stream,'',Item); + if cnt>0 then AppendString(Stream,Size,','); + InternalStringify(Stream,Size,'',Item); Inc(cnt); end; end; - Stream.WriteString(']'); + AppendString(Stream,Size,']'); end; begin if AValue.IsEmpty then Exit; - if AName<>'' then Stream.WriteString('"'+AValue.Encode(AName)+'":'); + if AName<>'' then AppendString(Stream,Size,'"'+AValue.Encode(AName)+'":'); case AValue.ValueType of jvNone : ; - jvNull : Stream.WriteString('null'); - jvString : Stream.WriteString('"'+AValue.Encode(AValue.AsString)+'"'); - jvNumber : Stream.WriteString(FixedFloatToStr(AValue.AsNumber)); - jvBoolean : Stream.WriteString(StrBoolean[AValue.AsBoolean]); + jvNull : AppendString(Stream,Size,'null'); + jvString : AppendString(Stream,Size,'"'+AValue.Encode(AValue.AsString)+'"'); + jvNumber : AppendString(Stream,Size,FixedFloatToStr(AValue.AsNumber)); + jvBoolean : AppendString(Stream,Size,StrBoolean[AValue.AsBoolean]); jvObject : ObjectStringify(AValue.AsObject); jvArray : ArrayStringify(AValue.AsArray); end; @@ -436,458 +475,518 @@ procedure ArrayStringify(JsonArray:Jsons.TJsonArray); function TJsonBase.Stringify:string; var - Stream : TStringStream; + Size : NativeInt; begin - Stream := TStringStream.Create; - InternalStringify(Stream,'',TJsonValue(Self)); - Result := Stream.DataString; - Stream.Free; + Size := -1; + AppendString(Result,Size,''); + InternalStringify(Result,Size,'',TJsonValue(Self)); + SetLength(Result,Size); end; -function TJsonBase.IsJsonArray(const S: String): Boolean; + +function TJsonBase.IsJsonArray(const S: string): Boolean; var - Len: Integer; + Len : Integer; begin - Len := Length(S); - Result := (Len >= 2) and (S[1] = '[') and (S[Len] = ']'); + Len := Length(S); + Result := (Len>=2) and (S[1]='[') and (S[Len]=']'); end; -function TJsonBase.IsJsonBoolean(const S: String): Boolean; + +function TJsonBase.IsJsonBoolean(const S:string):Boolean; begin - Result := SameText(lowercase(S), 'true') or SameText(lowercase(S), 'false'); + Result := SameText(S,'true') or SameText(S,'false'); end; -function TJsonBase.IsJsonNull(const S: String): Boolean; + +function TJsonBase.IsJsonNull(const S:string):Boolean; begin - Result := SameText(S, 'null'); + Result := SameText(S,'null'); end; -function TJsonBase.IsJsonNumber(const S: String): Boolean; + +function TJsonBase.IsJsonNumber(const S:string):Boolean; var - Number: Extended; + Number : Extended; begin - Result := FixedTryStrToFloat(S, Number); + Result := FixedTryStrToFloat(S,Number); end; -function TJsonBase.IsJsonObject(const S: String): Boolean; + +function TJsonBase.IsJsonObject(const S:string):Boolean; var - Len: Integer; + Len : Integer; begin - Len := Length(S); - Result := (Len >= 2) and (S[1] = '{') and (S[Len] = '}'); + Len := Length(S); + Result := (Len>=2) and (S[1]='{') and (S[Len]='}'); end; -function TJsonBase.IsJsonString(const S: String): Boolean; + +function TJsonBase.IsJsonString(const S:string):Boolean; var - Len: Integer; + Len : Integer; begin - Len := Length(S); - Result := (Len >= 2) and (S[1] = '"') and (S[Len] = '"'); + Len := Length(S); + Result := (Len>=2) and (S[1]='"') and (S[Len]='"'); end; -procedure TJsonBase.RaiseAssignError(Source: TJsonBase); + +procedure TJsonBase.RaiseAssignError(Source:TJsonBase); var - SourceClassName: String; + SourceClassName : string; begin if Source is TObject then SourceClassName := Source.ClassName - else SourceClassName := 'nil'; - RaiseError(Format('assign error: %s to %s', [SourceClassName, ClassName])); + else SourceClassName := 'nil'; + RaiseError(Format('assign error: %s to %s',[SourceClassName,ClassName])); end; -procedure TJsonBase.RaiseError(const Msg: String); + +procedure TJsonBase.RaiseError(const Msg:string); var - S: String; + S : string; begin - S := Format('<%s>%s', [ClassName, Msg]); + S := Format('<%s>%s',[ClassName,Msg]); raise Exception.Create(S); end; -procedure TJsonBase.RaiseParseError(const JsonString: String); + +procedure TJsonBase.RaiseParseError(const JsonString:string); begin - RaiseError(Format('"%s" parse error: %s', [GetOwnerName, JsonString])); + RaiseError(Format('"%s" parse error: %s',[GetOwnerName,JsonString])); end; -procedure TJsonBase.Split(const S: String; const Delimiter: Char; - Strings: TStrings); - function IsPairBegin(C: Char): Boolean; - begin - Result := (C = '{') or (C = '[') or (C = '"'); - end; - function GetPairEnd(C: Char): Char; - begin - case C of - '{': Result := '}'; - '[': Result := ']'; - '"': Result := '"'; - else Result := #0; - end; + +procedure TJsonBase.Split(const S:string;const Delimiter:Char;Strings:TStrings); + +function IsPairBegin(C:Char):Boolean; +begin + Result := (C='{') or (C='[') or (C='"'); +end; +function GetPairEnd(C:Char):Char; +begin + case C of + '{': Result := '}'; + '[': Result := ']'; + '"': Result := '"'; + else + Result := #0; end; - function MoveToPair(P: PChar): PChar; - var - PairBegin, PairEnd: Char; - C: Char; +end; +function MoveToPair(P:PChar):PChar; +var + PairBegin , + PairEnd : Char; + C : Char; +begin + PairBegin := P^; + PairEnd := GetPairEnd(PairBegin); + Result := P; + while Result^<>#0 do begin - PairBegin := P^; - PairEnd := GetPairEnd(PairBegin); - Result := P; - while Result^ <> #0 do - begin - Inc(Result); - C := Result^; - if C = PairEnd then Break - else if (PairBegin = '"') and (C = '\') then Inc(Result) - else if (PairBegin <> '"') and IsPairBegin(C) then Result := MoveToPair(Result); - end; + Inc(Result); + C := Result^; + if C=PairEnd then Break else + if (PairBegin='"') and (C='\') then Inc(Result) else + if (PairBegin<>'"') and IsPairBegin(C) then Result := MoveToPair(Result); end; +end; var - PtrBegin, PtrEnd: PChar; - C: Char; - StrItem: String; + PtrBegin , + PtrEnd : PChar; + C : Char; + StrItem : string; begin PtrBegin := PChar(S); - PtrEnd := PtrBegin; - while PtrEnd^ <> #0 do + PtrEnd := PtrBegin; + while PtrEnd^<>#0 do begin C := PtrEnd^; - if C = Delimiter then + if C=Delimiter then begin - StrItem := Trim(Copy(PtrBegin, 1, PtrEnd - PtrBegin)); + StrItem := Trim(Copy(PtrBegin,1,PtrEnd-PtrBegin)); Strings.Add(StrItem); - PtrBegin := PtrEnd + 1; - PtrEnd := PtrBegin; + PtrBegin := PtrEnd+1; + PtrEnd := PtrBegin; Continue; end - else if IsPairBegin(C) then PtrEnd := MoveToPair(PtrEnd); + else + begin + if IsPairBegin(C) then PtrEnd := MoveToPair(PtrEnd); + end; Inc(PtrEnd); end; - StrItem := Trim(Copy(PtrBegin, 1, PtrEnd - PtrBegin)); - if StrItem <> '' then Strings.Add(StrItem); + StrItem := Trim(Copy(PtrBegin,1,PtrEnd-PtrBegin)); + if StrItem<>'' then Strings.Add(StrItem); end; + { TJsonValue } -procedure TJsonValue.Assign(Source: TJsonBase); +procedure TJsonValue.Assign(Source:TJsonBase); var - Src: TJsonValue; + Src : TJsonValue; begin Clear; - if not(Source is TJsonValue) and not(Source is TJsonObject) and not(Source is TJsonArray) then - RaiseAssignError(Source); + if not(Source is TJsonValue) and not(Source is TJsonObject) and not(Source is TJsonArray) then RaiseAssignError(Source); if Source is TJsonObject then begin - FValueType := jvObject; + FValueType := jvObject; FObjectValue := TJsonObject.Create(Self); FObjectValue.Assign(Source); end - else if Source is TJsonArray then + else + if Source is TJsonArray then begin - FValueType := jvArray; + FValueType := jvArray; FArrayValue := TJsonArray.Create(Self); FArrayValue.Assign(Source); end - else if Source is TJsonValue then + else + if Source is TJsonValue then begin - Src := Source as TJsonValue; + Src := Source as TJsonValue; FValueType := Src.FValueType; case FValueType of - jvNone, jvNull: ; - jvString: FStringValue := Src.FStringValue; - jvNumber: FNumberValue := Src.FNumberValue; - jvBoolean: FBooleanValue := Src.FBooleanValue; - jvObject: - begin - FObjectValue := TJsonObject.Create(Self); - FObjectValue.Assign(Src.FObjectValue); - end; - jvArray: - begin - FArrayValue := TJsonArray.Create(Self); - FArrayValue.Assign(Src.FArrayValue); - end; + jvNone , + jvNull : ; + jvString : FStringValue := Src.FStringValue; + jvNumber : FNumberValue := Src.FNumberValue; + jvBoolean : FBooleanValue := Src.FBooleanValue; + jvObject : + begin + FObjectValue := TJsonObject.Create(Self); + FObjectValue.Assign(Src.FObjectValue); + end; + jvArray : + begin + FArrayValue := TJsonArray.Create(Self); + FArrayValue.Assign(Src.FArrayValue); + end; end; end; end; + procedure TJsonValue.Clear; begin case FValueType of - jvNone, jvNull: ; - jvString: FStringValue := ''; - jvNumber: FNumberValue := 0; - jvBoolean: FBooleanValue := False; - jvObject: - begin - FObjectValue.Free; - FObjectValue := nil; - end; - jvArray: - begin - FArrayValue.Free; - FArrayValue := nil; - end; + jvNone , + jvNull : ; + jvString : FStringValue := ''; + jvNumber : FNumberValue := 0; + jvBoolean : FBooleanValue := False; + jvObject : + begin + FObjectValue.Free; + FObjectValue := nil; + end; + jvArray : + begin + FArrayValue.Free; + FArrayValue := nil; + end; end; FValueType := jvNone; end; -constructor TJsonValue.Create(AOwner: TJsonBase); + +constructor TJsonValue.Create(AOwner:TJsonBase); begin inherited Create(AOwner); - FStringValue := ''; - FNumberValue := 0; + FStringValue := ''; + FNumberValue := 0; FBooleanValue := False; - FObjectValue := nil; - FArrayValue := nil; - FValueType := jvNone; + FObjectValue := nil; + FArrayValue := nil; + FValueType := jvNone; end; + destructor TJsonValue.Destroy; begin Clear; inherited Destroy; end; -function TJsonValue.GetAsArray: TJsonArray; + +function TJsonValue.GetAsArray:TJsonArray; begin if IsEmpty then begin - FValueType := jvArray; + FValueType := jvArray; FArrayValue := TJsonArray.Create(Self); end; - if FValueType <> jvArray then RaiseValueTypeError(jvArray); + if FValueType<>jvArray then RaiseValueTypeError(jvArray); Result := FArrayValue; end; -function TJsonValue.GetAsBoolean: Boolean; + +function TJsonValue.GetAsBoolean:Boolean; begin Result := False; case FValueType of - jvNone, jvNull: Result := False; - jvString: Result := SameText(lowercase(FStringValue), 'true'); - jvNumber: Result := (FNumberValue <> 0); - jvBoolean: Result := FBooleanValue; - jvObject, jvArray: RaiseValueTypeError(jvBoolean); + jvNone , + jvNull : Result := False; + jvString : Result := SameText(FStringValue,'true'); + jvNumber : Result := (FNumberValue<>0); + jvBoolean : Result := FBooleanValue; + jvObject , + jvArray : RaiseValueTypeError(jvBoolean); end; end; -function TJsonValue.GetAsInteger: Integer; + +function TJsonValue.GetAsInteger:Integer; begin Result := 0; case FValueType of - jvNone, jvNull: Result := 0; - jvString: Result := Trunc(StrToInt(FStringValue)); - jvNumber: Result := Trunc(FNumberValue); - jvBoolean: Result := Ord(FBooleanValue); - jvObject, jvArray: RaiseValueTypeError(jvNumber); + jvNone , + jvNull : Result := 0; + jvString : Result := Trunc(StrToInt(FStringValue)); + jvNumber : Result := Trunc(FNumberValue); + jvBoolean : Result := Ord(FBooleanValue); + jvObject , + jvArray : RaiseValueTypeError(jvNumber); end; end; -function TJsonValue.GetAsNumber: Extended; + +function TJsonValue.GetAsNumber:Extended; begin Result := 0; case FValueType of - jvNone, jvNull: Result := 0; - jvString: Result := FixedStrToFloat(FStringValue); - jvNumber: Result := FNumberValue; - jvBoolean: Result := Ord(FBooleanValue); - jvObject, jvArray: RaiseValueTypeError(jvNumber); + jvNone , + jvNull : Result := 0; + jvString : Result := FixedStrToFloat(FStringValue); + jvNumber : Result := FNumberValue; + jvBoolean : Result := Ord(FBooleanValue); + jvObject , + jvArray : RaiseValueTypeError(jvNumber); end; end; -function TJsonValue.GetAsObject: TJsonObject; + +function TJsonValue.GetAsObject:TJsonObject; begin if IsEmpty then begin - FValueType := jvObject; + FValueType := jvObject; FObjectValue := TJsonObject.Create(Self); end; - if FValueType <> jvObject then RaiseValueTypeError(jvObject); + if FValueType<>jvObject then RaiseValueTypeError(jvObject); Result := FObjectValue; end; -function TJsonValue.GetAsString: String; + +function TJsonValue.GetAsString:string; const - BooleanStr: array[Boolean] of String = ('false', 'true'); + BooleanStr: array[Boolean] of string = ('false','true'); begin Result := ''; case FValueType of - jvNone, jvNull: Result := ''; - jvString: Result := FStringValue; - jvNumber: Result := FixedFloatToStr(FNumberValue); - jvBoolean: Result := BooleanStr[FBooleanValue]; - jvObject, jvArray: RaiseValueTypeError(jvString); + jvNone , + jvNull : Result := ''; + jvString : Result := FStringValue; + jvNumber : Result := FixedFloatToStr(FNumberValue); + jvBoolean : Result := BooleanStr[FBooleanValue]; + jvObject , + jvArray : RaiseValueTypeError(jvString); end; end; -function TJsonValue.GetIsEmpty: Boolean; + +function TJsonValue.GetIsEmpty:Boolean; begin - Result := (FValueType = jvNone); + Result := (FValueType=jvNone); end; -function TJsonValue.GetIsNull: Boolean; + +function TJsonValue.GetIsNull:Boolean; begin - Result := (FValueType = jvNull); + Result := (FValueType=jvNull); end; -procedure TJsonValue.Parse(JsonString: String); + +procedure TJsonValue.Parse(JsonString:string); begin Clear; JsonString := Trim(JsonString); FValueType := AnalyzeJsonValueType(JsonString); case FValueType of - jvNone: RaiseParseError(JsonString); - jvNull: ; - jvString: FStringValue := Decode(Copy(JsonString, 2, Length(JsonString) - 2)); - jvNumber: FNumberValue := FixedStrToFloat(JsonString); - jvBoolean: FBooleanValue := SameText(JsonString, 'true'); - jvObject: - begin - FObjectValue := TJsonObject.Create(Self); - FObjectValue.Parse(JsonString); - end; - jvArray: - begin - FArrayValue := TJsonArray.Create(Self); - FArrayValue.Parse(JsonString); - end; + jvNone : RaiseParseError(JsonString); + jvNull : ; + jvString : FStringValue := Decode(Copy(JsonString,2,Length(JsonString)-2)); + jvNumber : FNumberValue := FixedStrToFloat(JsonString); + jvBoolean : FBooleanValue := SameText(JsonString,'true'); + jvObject : + begin + FObjectValue := TJsonObject.Create(Self); + FObjectValue.Parse(JsonString); + end; + jvArray : + begin + FArrayValue := TJsonArray.Create(Self); + FArrayValue.Parse(JsonString); + end; end; end; -procedure TJsonValue.RaiseValueTypeError(const AsValueType: TJsonValueType); + +procedure TJsonValue.RaiseValueTypeError(const AsValueType:TJsonValueType); const - StrJsonValueType: array[TJsonValueType] of String = ('jvNone', 'jvNull', 'jvString', 'jvNumber', 'jvBoolean', 'jvObject', 'jvArray'); + StrJsonValueType : array[TJsonValueType] of string = ('jvNone','jvNull','jvString','jvNumber','jvBoolean','jvObject','jvArray'); var - S: String; + S : string; begin - S := Format('"%s" value type error: %s to %s', [GetOwnerName, StrJsonValueType[FValueType], StrJsonValueType[AsValueType]]); + S := Format('"%s" value type error: %s to %s',[GetOwnerName,StrJsonValueType[FValueType],StrJsonValueType[AsValueType]]); RaiseError(S); end; -procedure TJsonValue.SetAsArray(const Value: TJsonArray); + +procedure TJsonValue.SetAsArray(const Value:TJsonArray); begin - if FValueType <> jvArray then + if FValueType<>jvArray then begin Clear; - FValueType := jvArray; + FValueType := jvArray; FArrayValue := TJsonArray.Create(Self); end; FArrayValue.Assign(Value); end; -procedure TJsonValue.SetAsBoolean(const Value: Boolean); + +procedure TJsonValue.SetAsBoolean(const Value:Boolean); begin - if FValueType <> jvBoolean then + if FValueType<>jvBoolean then begin Clear; FValueType := jvBoolean; end; FBooleanValue := Value; end; -procedure TJsonValue.SetAsInteger(const Value: Integer); + +procedure TJsonValue.SetAsInteger(const Value:Integer); begin SetAsNumber(Value); end; -procedure TJsonValue.SetAsNumber(const Value: Extended); + +procedure TJsonValue.SetAsNumber(const Value:Extended); begin - if FValueType <> jvNumber then + if FValueType<>jvNumber then begin Clear; FValueType := jvNumber; end; FNumberValue := Value; end; -procedure TJsonValue.SetAsObject(const Value: TJsonObject); + +procedure TJsonValue.SetAsObject(const Value:TJsonObject); begin - if FValueType <> jvObject then + if FValueType<>jvObject then begin Clear; - FValueType := jvObject; + FValueType := jvObject; FObjectValue := TJsonObject.Create(Self); end; FObjectValue.Assign(Value); end; -procedure TJsonValue.SetAsString(const Value: String); + +procedure TJsonValue.SetAsString(const Value:string); begin - if FValueType <> jvString then + if FValueType<>jvString then begin Clear; FValueType := jvString; end; FStringValue := Value; end; -procedure TJsonValue.SetIsEmpty(const Value: Boolean); + +procedure TJsonValue.SetIsEmpty(const Value:Boolean); const - EmptyValueType: array[Boolean] of TJsonValueType = (jvNull, jvNone); + EmptyValueType: array[Boolean] of TJsonValueType = (jvNull,jvNone); begin - if FValueType <> EmptyValueType[Value] then + if FValueType<>EmptyValueType[Value] then begin Clear; FValueType := EmptyValueType[Value]; end; end; -procedure TJsonValue.SetIsNull(const Value: Boolean); + +procedure TJsonValue.SetIsNull(const Value:Boolean); const - NullValueType: array[Boolean] of TJsonValueType = (jvNone, jvNull); + NullValueType: array[Boolean] of TJsonValueType = (jvNone,jvNull); begin - if FValueType <> NullValueType[Value] then + if FValueType<>NullValueType[Value] then begin Clear; FValueType := NullValueType[Value]; end; end; + { TJsonArray } -function TJsonArray.Add: TJsonValue; +function TJsonArray.Add:TJsonValue; begin Result := TJsonValue.Create(Self); FList.Add(Result); end; -procedure TJsonArray.Assign(Source: TJsonBase); + +procedure TJsonArray.Assign(Source:TJsonBase); var - Src: TJsonArray; - I: Integer; + Src : TJsonArray; + I : Integer; begin Clear; if not(Source is TJsonArray) then RaiseAssignError(Source); Src := Source as TJsonArray; - for I := 0 to Src.Count - 1 do Add.Assign(Src[I]); + for I:=0 to Src.Count-1 do Add.Assign(Src[I]); end; + procedure TJsonArray.Clear; var - I: Integer; - Item: TJsonValue; + I : Integer; + Item : TJsonValue; begin - for I := 0 to FList.Count - 1 do + for I:=0 to FList.Count-1 do begin Item := TJsonValue(FList[I]); Item.Free; end; FList.Clear; end; -constructor TJsonArray.Create(AOwner: TJsonBase); + +constructor TJsonArray.Create(AOwner:TJsonBase); begin inherited Create(AOwner); FList := TList.Create; end; -procedure TJsonArray.Delete(const Index: Integer); + +procedure TJsonArray.Delete(const Index:Integer); var - Item: TJsonValue; + Item : TJsonValue; begin Item := TJsonValue(FList[Index]); Item.Free; FList.Delete(Index); end; + destructor TJsonArray.Destroy; begin Clear; FList.Free; inherited; end; -function TJsonArray.GetCount: Integer; + +function TJsonArray.GetCount:Integer; begin Result := FList.Count; end; -function TJsonArray.GetItems(Index: Integer): TJsonValue; + +function TJsonArray.GetItems(Index:Integer):TJsonValue; begin Result := TJsonValue(FList[Index]); end; -function TJsonArray.Insert(const Index: Integer): TJsonValue; + +function TJsonArray.Insert(const Index:Integer):TJsonValue; begin Result := TJsonValue.Create(Self); FList.Insert(Index, Result); end; -procedure TJsonArray.Merge(Addition: TJsonArray); + +procedure TJsonArray.Merge(Addition:TJsonArray); var - I: Integer; + I : Integer; begin - for I := 0 to Addition.Count - 1 do Add.Assign(Addition[I]); + for I:=0 to Addition.Count-1 do Add.Assign(Addition[I]); end; -procedure TJsonArray.Parse(JsonString: String); + +procedure TJsonArray.Parse(JsonString:string); var - I: Integer; - S: String; - List: TStringList; - Item: TJsonValue; + I : Integer; + S : string; + List : TStringList; + Item : TJsonValue; begin Clear; JsonString := Trim(JsonString); if not IsJsonArray(JsonString) then RaiseParseError(JsonString); - S := Trim(Copy(JsonString, 2, Length(JsonString) - 2)); + S := Trim(Copy(JsonString,2,Length(JsonString)-2)); List := TStringList.Create; try - Split(S, ',', List); - for I := 0 to List.Count - 1 do + Split(S,',',List); + for I:=0 to List.Count-1 do begin Item := Add; Item.Parse(List[I]); @@ -896,214 +995,241 @@ procedure TJsonArray.Parse(JsonString: String); List.Free; end; end; -function TJsonArray.Put(const Value: Boolean): TJsonValue; + +function TJsonArray.Put(const Value:Boolean):TJsonValue; begin - Result := Add; + Result := Add; Result.AsBoolean := Value; end; -function TJsonArray.Put(const Value: Integer): TJsonValue; + +function TJsonArray.Put(const Value:Integer):TJsonValue; begin - Result := Add; + Result := Add; Result.AsInteger := Value; end; -function TJsonArray.Put(const Value: TJsonEmpty): TJsonValue; + +function TJsonArray.Put(const Value:TJsonEmpty):TJsonValue; begin - Result := Add; + Result := Add; Result.IsEmpty := True; end; -function TJsonArray.Put(const Value: TJsonNull): TJsonValue; + +function TJsonArray.Put(const Value:TJsonNull):TJsonValue; begin - Result := Add; + Result := Add; Result.IsNull := True; end; -function TJsonArray.Put(const Value: Extended): TJsonValue; + +function TJsonArray.Put(const Value:Extended):TJsonValue; begin - Result := Add; + Result := Add; Result.AsNumber := Value; end; -function TJsonArray.Put(const Value: TJsonObject): TJsonValue; + +function TJsonArray.Put(const Value:TJsonObject):TJsonValue; begin Result := Add; Result.Assign(Value); end; -function TJsonArray.Put(const Value: TJsonValue): TJsonValue; + +function TJsonArray.Put(const Value:TJsonValue):TJsonValue; begin Result := Add; Result.Assign(Value); end; -function TJsonArray.Put(const Value: String): TJsonValue; + +function TJsonArray.Put(const Value:string):TJsonValue; begin - Result := Add; + Result := Add; Result.AsString := Value; end; -function TJsonArray.Put(const Value: TJsonArray): TJsonValue; + +function TJsonArray.Put(const Value:TJsonArray):TJsonValue; begin Result := Add; Result.Assign(Value); end; + { TJsonPair } -procedure TJsonPair.Assign(Source: TJsonBase); +procedure TJsonPair.Assign(Source:TJsonBase); var - Src: TJsonPair; + Src : TJsonPair; begin if not(Source is TJsonPair) then RaiseAssignError(Source); - Src := Source as TJsonPair; + Src := Source as TJsonPair; FName := Src.FName; FValue.Assign(Src.FValue); end; -constructor TJsonPair.Create(AOwner: TJsonBase; const AName: String); + +constructor TJsonPair.Create(AOwner:TJsonBase;const AName:string); begin inherited Create(AOwner); - FName := AName; + FName := AName; FValue := TJsonValue.Create(Self); end; + destructor TJsonPair.Destroy; begin FValue.Free; inherited Destroy; end; -procedure TJsonPair.Parse(JsonString: String); + +procedure TJsonPair.Parse(JsonString:string); var - List: TStringList; - StrName: String; + List : TStringList; + StrName : string; begin List := TStringList.Create; try - Split(JsonString, ':', List); - if List.Count <> 2 then RaiseParseError(JsonString); + Split(JsonString,':',List); + if List.Count<>2 then RaiseParseError(JsonString); StrName := List[0]; if not IsJsonString(StrName) then RaiseParseError(StrName); - FName := Decode(Copy(StrName, 2, Length(StrName) - 2)); + FName := Decode(Copy(StrName,2,Length(StrName)-2)); FValue.Parse(List[1]); finally List.Free; end; end; -procedure TJsonPair.SetName(const Value: String); + +procedure TJsonPair.SetName(const Value:string); begin FName := Value; end; + { TJsonObject } -function TJsonObject.Add(const Name: String): TJsonPair; +function TJsonObject.Add(const Name:string):TJsonPair; begin Result := TJsonPair.Create(Self, Name); FList.Add(Result); end; -procedure TJsonObject.Assign(Source: TJsonBase); + +procedure TJsonObject.Assign(Source:TJsonBase); var - Src: TJsonObject; - I: Integer; + Src : TJsonObject; + I : Integer; begin Clear; if not(Source is TJsonObject) then RaiseAssignError(Source); Src := Source as TJsonObject; - for I := 0 to Src.Count - 1 do Add.Assign(Src.Items[I]); + for I:=0 to Src.Count-1 do Add.Assign(Src.Items[I]); end; + procedure TJsonObject.Clear; var - I: Integer; - Item: TJsonPair; + I : Integer; + Item : TJsonPair; begin - for I := 0 to FList.Count - 1 do + for I:=0 to FList.Count-1 do begin Item := TJsonPair(FList[I]); Item.Free; end; FList.Clear; end; -constructor TJsonObject.Create(AOwner: TJsonBase); + +constructor TJsonObject.Create(AOwner:TJsonBase); begin inherited Create(AOwner); - FList := TList.Create; + FList := TList.Create; FAutoAdd := True; end; -procedure TJsonObject.Delete(const Index: Integer); + +procedure TJsonObject.Delete(const Index:Integer); var - Item: TJsonPair; + Item : TJsonPair; begin Item := TJsonPair(FList[Index]); Item.Free; FList.Delete(Index); end; -procedure TJsonObject.Delete(const Name: String); + +procedure TJsonObject.Delete(const Name:string); var - Index: Integer; + Index : Integer; begin Index := Find(Name); - if Index < 0 then RaiseError(Format('"%s" not found', [Name])); + if Index<0 then RaiseError(Format('"%s" not found', [Name])); Delete(Index); end; + destructor TJsonObject.Destroy; begin Clear; FList.Free; inherited Destroy; end; -function TJsonObject.Find(const Name: String): Integer; + +function TJsonObject.Find(const Name:string):Integer; var - I: Integer; - Pair: TJsonPair; + I : Integer; + Pair : TJsonPair; begin Result := -1; - for I := 0 to FList.Count - 1 do + for I:=0 to FList.Count-1 do begin Pair := TJsonPair(FList[I]); - if SameText(Name, Pair.Name) then + if SameText(Name,Pair.Name) then begin Result := I; Break; end; end; end; -function TJsonObject.GetCount: Integer; + +function TJsonObject.GetCount:Integer; begin Result := FList.Count; end; -function TJsonObject.GetItems(Index: Integer): TJsonPair; + +function TJsonObject.GetItems(Index:Integer):TJsonPair; begin Result := TJsonPair(FList[Index]); end; -function TJsonObject.GetValues(Name: String): TJsonValue; + +function TJsonObject.GetValues(Name:string):TJsonValue; var - Index: Integer; - Pair: TJsonPair; + Index : Integer; + Pair : TJsonPair; begin Index := Find(Name); - if Index < 0 then + if Index<0 then begin - if not FAutoAdd then RaiseError(Format('%s not found', [Name])); + if not FAutoAdd then RaiseError(Format('%s not found',[Name])); Pair := Add(Name); end else Pair := TJsonPair(FList[Index]); Result := Pair.Value; end; -function TJsonObject.Insert(const Index: Integer; - const Name: String): TJsonPair; + +function TJsonObject.Insert(const Index:Integer;const Name:string):TJsonPair; begin - Result := TJsonPair.Create(Self, Name); + Result := TJsonPair.Create(Self,Name); FList.Insert(Index, Result); end; -procedure TJsonObject.Merge(Addition: TJsonObject); + +procedure TJsonObject.Merge(Addition:TJsonObject); var - I: Integer; + I : Integer; begin - for I := 0 to Addition.Count - 1 do Add.Assign(Addition.Items[I]); + for I:=0 to Addition.Count-1 do Add.Assign(Addition.Items[I]); end; -procedure TJsonObject.Parse(JsonString: String); + +procedure TJsonObject.Parse(JsonString:string); var - I: Integer; - S: String; - List: TStringList; - Item: TJsonPair; + I : Integer; + S : string; + List : TStringList; + Item : TJsonPair; begin Clear; JsonString := Trim(JsonString); if not IsJsonObject(JsonString) then RaiseParseError(JsonString); - S := Trim(Copy(JsonString, 2, Length(JsonString) - 2)); + S := Trim(Copy(JsonString,2,Length(JsonString)-2)); List := TStringList.Create; try - Split(S, ',', List); - for I := 0 to List.Count - 1 do + Split(S,',',List); + for I:=0 to List.Count-1 do begin Item := Add; Item.Parse(List[I]); @@ -1112,99 +1238,111 @@ procedure TJsonObject.Parse(JsonString: String); List.Free; end; end; -function TJsonObject.Put(const Name:String;const Value:Integer):TJsonValue; + +function TJsonObject.Put(const Name:string;const Value:Integer):TJsonValue; begin - Result := Add(Name).Value; + Result := Add(Name).Value; Result.AsInteger := Value; end; -function TJsonObject.Put(const Name:String;const Value:Extended):TJsonValue; + +function TJsonObject.Put(const Name:string;const Value:Extended):TJsonValue; begin - Result := Add(Name).Value; + Result := Add(Name).Value; Result.AsNumber := Value; end; -function TJsonObject.Put(const Name:String;const Value:Boolean):TJsonValue; + +function TJsonObject.Put(const Name:string;const Value:Boolean):TJsonValue; begin - Result := Add(Name).Value; + Result := Add(Name).Value; Result.AsBoolean := Value; end; -function TJsonObject.Put(const Name:String;const Value:TJsonEmpty):TJsonValue; + +function TJsonObject.Put(const Name:string;const Value:TJsonEmpty):TJsonValue; begin - Result := Add(Name).Value; + Result := Add(Name).Value; Result.IsEmpty := True; end; -function TJsonObject.Put(const Name:String;const Value:TJsonNull):TJsonValue; + +function TJsonObject.Put(const Name:string;const Value:TJsonNull):TJsonValue; begin - Result := Add(Name).Value; + Result := Add(Name).Value; Result.IsNull := True; end; -function TJsonObject.Put(const Name:String;const Value:TJsonValue):TJsonValue; + +function TJsonObject.Put(const Name:string;const Value:TJsonValue):TJsonValue; begin Result := Add(Name).Value; Result.Assign(Value); end; -function TJsonObject.Put(const Value: TJsonPair): TJsonValue; + +function TJsonObject.Put(const Value:TJsonPair):TJsonValue; var - Pair: TJsonPair; + Pair : TJsonPair; begin Pair := Add; Pair.Assign(Value); Result := Pair.Value; end; -function TJsonObject.Put(const Name: String; - const Value: TJsonObject): TJsonValue; + +function TJsonObject.Put(const Name:string;const Value:TJsonObject):TJsonValue; begin Result := Add(Name).Value; Result.Assign(Value); end; -function TJsonObject.Put(const Name, Value: String): TJsonValue; + +function TJsonObject.Put(const Name,Value:string):TJsonValue; begin - Result := Add(Name).Value; + Result := Add(Name).Value; Result.AsString := Value; end; -function TJsonObject.Put(const Name: String; - const Value: TJsonArray): TJsonValue; + +function TJsonObject.Put(const Name:string;const Value:TJsonArray):TJsonValue; begin Result := Add(Name).Value; Result.Assign(Value); end; + { TJson } -procedure TJson.Assign(Source: TJsonBase); +procedure TJson.Assign(Source:TJsonBase); begin Clear; if Source is TJson then begin case (Source as TJson).FStructType of - jsNone: ; - jsArray: - begin - CreateArrayIfNone; - FJsonArray.Assign((Source as TJson).FJsonArray); - end; - jsObject: - begin - CreateObjectIfNone; - FJsonObject.Assign((Source as TJson).FJsonObject); - end; + jsNone : ; + jsArray : + begin + CreateArrayIfNone; + FJsonArray.Assign((Source as TJson).FJsonArray); + end; + jsObject : + begin + CreateObjectIfNone; + FJsonObject.Assign((Source as TJson).FJsonObject); + end; end; end - else if Source is TJsonArray then + else + if Source is TJsonArray then begin CreateArrayIfNone; FJsonArray.Assign(Source); end - else if Source is TJsonObject then + else + if Source is TJsonObject then begin CreateObjectIfNone; FJsonObject.Assign(Source); end - else if Source is TJsonValue then + else + if Source is TJsonValue then begin - if (Source as TJsonValue).ValueType = jvArray then + if (Source as TJsonValue).ValueType=jvArray then begin CreateArrayIfNone; FJsonArray.Assign((Source as TJsonValue).AsArray); end - else if (Source as TJsonValue).ValueType = jvObject then + else if (Source as TJsonValue).ValueType=jvObject then begin CreateObjectIfNone; FJsonObject.Assign((Source as TJsonValue).AsObject); @@ -1213,111 +1351,128 @@ procedure TJson.Assign(Source: TJsonBase); end else RaiseAssignError(Source); end; + procedure TJson.CheckJsonArray; begin CreateArrayIfNone; RaiseIfNotArray; end; + procedure TJson.CheckJsonObject; begin CreateObjectIfNone; RaiseIfNotObject; end; + procedure TJson.Clear; begin case FStructType of - jsNone: ; - jsArray: - begin - FJsonArray.Free; - FJsonArray := nil; - end; - jsObject: - begin - FJsonObject.Free; - FJsonObject := nil; - end; + jsNone : ; + jsArray : + begin + FJsonArray.Free; + FJsonArray := nil; + end; + jsObject : + begin + FJsonObject.Free; + FJsonObject := nil; + end; end; FStructType := jsNone; end; + constructor TJson.Create; begin inherited Create(nil); FStructType := jsNone; - FJsonArray := nil; + FJsonArray := nil; FJsonObject := nil; end; + procedure TJson.CreateArrayIfNone; begin - if FStructType = jsNone then + if FStructType=jsNone then begin FStructType := jsArray; - FJsonArray := TJsonArray.Create(Self); + FJsonArray := TJsonArray.Create(Self); end; end; + procedure TJson.CreateObjectIfNone; begin - if FStructType = jsNone then + if FStructType=jsNone then begin FStructType := jsObject; FJsonObject := TJsonObject.Create(Self); end; end; -procedure TJson.Delete(const Index: Integer); + +procedure TJson.Delete(const Index:Integer); begin RaiseIfNone; case FStructType of - jsArray: FJsonArray.Delete(Index); - jsObject: FJsonObject.Delete(Index); + jsArray : FJsonArray.Delete(Index); + jsObject : FJsonObject.Delete(Index); end; end; -procedure TJson.Delete(const Name: String); + +procedure TJson.Delete(const Name:string); begin RaiseIfNotObject; FJsonObject.Delete(Name); end; + destructor TJson.Destroy; begin Clear; inherited Destroy; end; -function TJson.Get(const Index: Integer): TJsonValue; + +function TJson.Get(const Index:Integer):TJsonValue; begin Result := nil; RaiseIfNone; case FStructType of - jsArray: Result := FJsonArray.Items[Index]; - jsObject: Result := FJsonObject.Items[Index].Value; + jsArray : Result := FJsonArray.Items[Index]; + jsObject : Result := FJsonObject.Items[Index].Value; end; end; -function TJson.Get(const Name: String): TJsonValue; + +function TJson.Get(const Name:string):TJsonValue; begin CheckJsonObject; Result := FJsonObject.Values[Name]; end; -function TJson.GetCount: Integer; + +function TJson.GetCount:Integer; begin case FStructType of - jsArray: Result := FJsonArray.Count; - jsObject: Result := FJsonObject.Count; - else Result := 0; + jsArray : Result := FJsonArray.Count; + jsObject : Result := FJsonObject.Count; + else + Result := 0; end; end; -function TJson.GetJsonArray: TJsonArray; + +function TJson.GetJsonArray:TJsonArray; begin CheckJsonArray; Result := FJsonArray; end; -function TJson.GetJsonObject: TJsonObject; + +function TJson.GetJsonObject:TJsonObject; begin CheckJsonObject; Result := FJsonObject; end; -function TJson.GetValues(Name: String): TJsonValue; + +function TJson.GetValues(Name:string):TJsonValue; begin Result := Get(Name); end; -procedure TJson.Parse(JsonString: String); + +procedure TJson.Parse(JsonString:string); begin Clear; JsonString := Trim(JsonString); @@ -1326,148 +1481,174 @@ procedure TJson.Parse(JsonString: String); CreateArrayIfNone; FJsonArray.Parse(JsonString); end - else if IsJsonObject(JsonString) then + else + if IsJsonObject(JsonString) then begin CreateObjectIfNone; FJsonObject.Parse(JsonString); end else RaiseParseError(JsonString); end; -function TJson.Put(const Value: Integer): TJsonValue; + +function TJson.Put(const Value:Integer):TJsonValue; begin CheckJsonArray; Result := FJsonArray.Put(Value); end; -function TJson.Put(const Value: Extended): TJsonValue; + +function TJson.Put(const Value:Extended):TJsonValue; begin CheckJsonArray; Result := FJsonArray.Put(Value); end; -function TJson.Put(const Value: Boolean): TJsonValue; + +function TJson.Put(const Value:Boolean):TJsonValue; begin CheckJsonArray; Result := FJsonArray.Put(Value); end; -function TJson.Put(const Value: TJsonEmpty): TJsonValue; + +function TJson.Put(const Value:TJsonEmpty):TJsonValue; begin CheckJsonArray; Result := FJsonArray.Put(Value); end; -function TJson.Put(const Value: TJsonNull): TJsonValue; + +function TJson.Put(const Value:TJsonNull):TJsonValue; begin CheckJsonArray; Result := FJsonArray.Put(Value); end; -function TJson.Put(const Value: String): TJsonValue; + +function TJson.Put(const Value:string):TJsonValue; begin CheckJsonArray; Result := FJsonArray.Put(Value); end; -function TJson.Put(const Value: TJsonValue): TJsonValue; + +function TJson.Put(const Value:TJsonValue):TJsonValue; begin CheckJsonArray; Result := FJsonArray.Put(Value); end; -function TJson.Put(const Value: TJsonObject): TJsonValue; + +function TJson.Put(const Value:TJsonObject):TJsonValue; begin CheckJsonArray; Result := FJsonArray.Put(Value); end; -function TJson.Put(const Value: TJsonArray): TJsonValue; + +function TJson.Put(const Value:TJsonArray):TJsonValue; begin CheckJsonArray; Result := FJsonArray.Put(Value); end; -function TJson.Put(const Name: String; const Value: Integer): TJsonValue; + +function TJson.Put(const Name:string;const Value:Integer):TJsonValue; begin CheckJsonObject; - Result := FJsonObject.Put(Name, Value); + Result := FJsonObject.Put(Name,Value); end; -function TJson.Put(const Name: String; const Value: Extended): TJsonValue; + +function TJson.Put(const Name:string;const Value:Extended):TJsonValue; begin CheckJsonObject; Result := FJsonObject.Put(Name, Value); end; -function TJson.Put(const Name: String; const Value: Boolean): TJsonValue; + +function TJson.Put(const Name:string;const Value:Boolean):TJsonValue; begin CheckJsonObject; - Result := FJsonObject.Put(Name, Value); + Result := FJsonObject.Put(Name,Value); end; -function TJson.Put(const Name: String; - const Value: TJsonEmpty): TJsonValue; + +function TJson.Put(const Name:string;const Value:TJsonEmpty):TJsonValue; begin CheckJsonObject; - Result := FJsonObject.Put(Name, Value); + Result := FJsonObject.Put(Name,Value); end; -function TJson.Put(const Name: String; const Value: TJsonNull): TJsonValue; + +function TJson.Put(const Name:string;const Value:TJsonNull):TJsonValue; begin CheckJsonObject; - Result := FJsonObject.Put(Name, Value); + Result := FJsonObject.Put(Name,Value); end; -function TJson.Put(const Name: String; - const Value: TJsonValue): TJsonValue; + +function TJson.Put(const Name:string;const Value:TJsonValue):TJsonValue; begin CheckJsonObject; - Result := FJsonObject.Put(Name, Value); + Result := FJsonObject.Put(Name,Value); end; -function TJson.Put(const Value: TJsonPair): TJsonValue; + +function TJson.Put(const Value:TJsonPair):TJsonValue; begin CheckJsonObject; Result := FJsonObject.Put(Value); end; -function TJson.Put(const Name: String; - const Value: TJsonObject): TJsonValue; + +function TJson.Put(const Name:string;const Value:TJsonObject):TJsonValue; begin CheckJsonObject; - Result := FJsonObject.Put(Name, Value); + Result := FJsonObject.Put(Name,Value); end; -function TJson.Put(const Name, Value: String): TJsonValue; + +function TJson.Put(const Name,Value:string):TJsonValue; begin CheckJsonObject; - Result := FJsonObject.Put(Name, Value); + Result := FJsonObject.Put(Name,Value); end; -function TJson.Put(const Name: String; - const Value: TJsonArray): TJsonValue; + +function TJson.Put(const Name:string;const Value:TJsonArray):TJsonValue; begin CheckJsonObject; - Result := FJsonObject.Put(Name, Value); + Result := FJsonObject.Put(Name,Value); end; -function TJson.Put(const Value: TJson): TJsonValue; + +function TJson.Put(const Value:TJson):TJsonValue; begin CheckJsonArray; case Value.FStructType of - jsArray: Result := Put(Value.FJsonArray); - jsObject: Result := Put(Value.FJsonObject); - else Result := nil; + jsArray : Result := Put(Value.FJsonArray); + jsObject : Result := Put(Value.FJsonObject); + else + Result := nil; end; end; -function TJson.Put(const Name: String; const Value: TJson): TJsonValue; + +function TJson.Put(const Name:string;const Value:TJson):TJsonValue; begin CheckJsonObject; case Value.FStructType of - jsArray: Result := Put(Name, Value.FJsonArray); - jsObject: Result := Put(Name, Value.FJsonObject); - else Result := nil; + jsArray : Result := Put(Name, Value.FJsonArray); + jsObject : Result := Put(Name, Value.FJsonObject); + else + Result := nil; end; end; + procedure TJson.RaiseIfNone; begin - if FStructType = jsNone then RaiseError('json struct type is jsNone'); + if FStructType=jsNone then RaiseError('json struct type is jsNone'); end; + procedure TJson.RaiseIfNotArray; begin - if FStructType <> jsArray then RaiseError('json struct type is not jsArray'); + if FStructType<>jsArray then RaiseError('json struct type is not jsArray'); end; + procedure TJson.RaiseIfNotObject; begin - if FStructType <> jsObject then RaiseError('json struct type is not jsObject'); + if FStructType<>jsObject then RaiseError('json struct type is not jsObject'); end; -function TJson.Stringify: String; + +function TJson.Stringify:string; begin case FStructType of - jsArray: Result := FJsonArray.Stringify; - jsObject: Result := FJsonObject.Stringify; - else Result := ''; + jsArray : Result := FJsonArray.Stringify; + jsObject : Result := FJsonObject.Stringify; + else + Result := ''; end; end; + end. From 4b1300da02bc79c9611147808716956556029bd2 Mon Sep 17 00:00:00 2001 From: Hafedh TRIMECHE Date: Wed, 9 Nov 2022 00:06:34 +0100 Subject: [PATCH 10/10] TStringBuilder more efficient! --- src/Jsons.pas | 184 +++++++++----------- src/JsonsUtilsEx.pas | 404 +------------------------------------------ 2 files changed, 80 insertions(+), 508 deletions(-) diff --git a/src/Jsons.pas b/src/Jsons.pas index 0c9c19e..acb0a3d 100644 --- a/src/Jsons.pas +++ b/src/Jsons.pas @@ -40,7 +40,7 @@ TJsonBase = class(TObject) private FOwner : TJsonBase; function GetOwner:TJsonBase; - procedure InternalStringify(var Stream:string;var Size:NativeInt;AName:string;AValue:TJsonValue); + procedure InternalStringify(Stream:TStringBuilder;AName:string;AValue:TJsonValue); protected function GetOwnerName:string; procedure RaiseError(const Msg:string); @@ -52,7 +52,7 @@ TJsonBase = class(TObject) procedure Parse(JsonString:string);virtual;abstract; function Stringify:string;virtual; procedure Assign(Source:TJsonBase);virtual;abstract; - function Encode(const S:string):string; + procedure Encode(Stream:TStringBuilder;const S:string); function Decode(const S:string):string; procedure Split(const S:string;const Delimiter:Char;Strings:TStrings); function IsJsonObject(const S:string):Boolean; @@ -259,27 +259,6 @@ TJson = class(TJsonBase) implementation -procedure AppendString(var Buffer:string;var Size:NativeInt;const Value:string); -var - Capacity , - DataLen : NativeInt; -begin - if Size<0 then - begin - SetLength(Buffer,Max(1024,Length(Value))); - Size := 0; - end; - DataLen := Length(Value); - Capacity := Length(Buffer); - if Size+DataLen>Capacity then - begin - Capacity := Round(Capacity*1.3)+DataLen; - SetLength(Buffer,Capacity); - end; - if Value<>'' then Move(Value[1],Buffer[Size+1],DataLen*SizeOf(Char)); - Inc(Size,DataLen); -end; - { TJsonBase } function TJsonBase.AnalyzeJsonValueType(const S:string):TJsonValueType; var @@ -305,6 +284,7 @@ function TJsonBase.AnalyzeJsonValueType(const S:string):TJsonValueType; constructor TJsonBase.Create(AOwner:TJsonBase); begin + inherited Create; FOwner := AOwner; end; @@ -319,14 +299,13 @@ function HexValue(C:Char):Byte; end; end; var - I : Integer; - C : Char; - ubuf : Integer; - Size : NativeInt; + I : Integer; + C : Char; + ubuf : Integer; + Stream : TStringBuilder; begin - Size := -1; - AppendString(Result,Size,''); - I := 1; + Stream := TStringBuilder.Create(Length(S)); + I := 1; while I<=Length(S) do begin C := S[I]; @@ -336,61 +315,58 @@ function HexValue(C:Char):Byte; C := S[I]; Inc(I); case C of - 'b': AppendString(Result,Size,#8); - 't': AppendString(Result,Size,#9); - 'n': AppendString(Result,Size,#10); - 'f': AppendString(Result,Size,#12); - 'r': AppendString(Result,Size,#13); + 'b': Stream.Append(#8); + 't': Stream.Append(#9); + 'n': Stream.Append(#10); + 'f': Stream.Append(#12); + 'r': Stream.Append(#13); 'u': begin if not TryStrToInt('$'+Copy(S,I,4),ubuf) then raise Exception.Create(format('Invalid unicode \u%s',[Copy(S,I,4)])); - AppendString(Result,Size,WideChar(ubuf)); + Stream.Append(WideChar(ubuf)); Inc(I,4); end; else - AppendString(Result,Size,C); + Stream.Append(C); end; end - else AppendString(Result,Size,C); + else Stream.Append(C); end; - SetLength(Result,Size); + Result := Stream.ToString; + FreeAndNil(Stream); end; -function TJsonBase.Encode(const S:string):string; +procedure TJsonBase.Encode(Stream:TStringBuilder;const S:string); var I , UnicodeValue : Integer; C : Char; - Size : NativeInt; begin - Size := -1; - AppendString(Result,Size,''); for I:=1 to Length(S) do begin C := S[I]; case C of - '"' : AppendString(Result,Size,'\'+C); - '\' : AppendString(Result,Size,'\'+C); - '/' : AppendString(Result,Size,'\'+C); - #8 : AppendString(Result,Size,'\b'); - #9 : AppendString(Result,Size,'\t'); - #10 : AppendString(Result,Size,'\n'); - #12 : AppendString(Result,Size,'\f'); - #13 : AppendString(Result,Size,'\r'); + '"' : Stream.Append('\'+C); + '\' : Stream.Append('\'+C); + '/' : Stream.Append('\'+C); + #8 : Stream.Append('\b'); + #9 : Stream.Append('\t'); + #10 : Stream.Append('\n'); + #12 : Stream.Append('\f'); + #13 : Stream.Append('\r'); else if (CWideChar(127)) then begin - AppendString(Result,Size,'\u'); + Stream.Append('\u'); UnicodeValue := Ord(C); - AppendString(Result,Size,lowercase(IntToHex((UnicodeValue and 61440) shr 12,1))); - AppendString(Result,Size,lowercase(IntToHex((UnicodeValue and 3840) shr 8,1))); - AppendString(Result,Size,lowercase(IntToHex((UnicodeValue and 240) shr 4,1))); - AppendString(Result,Size,lowercase(IntToHex((UnicodeValue and 15),1))); + Stream.Append(lowercase(IntToHex((UnicodeValue and 61440) shr 12,1))); + Stream.Append(lowercase(IntToHex((UnicodeValue and 3840) shr 8,1))); + Stream.Append(lowercase(IntToHex((UnicodeValue and 240) shr 4,1))); + Stream.Append(lowercase(IntToHex((UnicodeValue and 15),1))); end - else AppendString(Result,Size,C); + else Stream.Append(C); end; end; - SetLength(Result,Size); end; function TJsonBase.GetOwner:TJsonBase; @@ -416,7 +392,7 @@ function TJsonBase.GetOwnerName:string; end; end; -procedure TJsonBase.InternalStringify(var Stream:string;var Size:NativeInt;AName:string;AValue:TJsonValue); +procedure TJsonBase.InternalStringify(Stream:TStringBuilder;AName:string;AValue:TJsonValue); const StrBoolean : array[Boolean] of string = ('false','true'); procedure ObjectStringify(JsonObject:Jsons.TJsonObject); @@ -426,18 +402,18 @@ procedure ObjectStringify(JsonObject:Jsons.TJsonObject); Item : TJsonPair; begin cnt := 0; - AppendString(Stream,Size,'{'); + Stream.Append('{'); for i:=0 to JsonObject.Count-1 do begin Item := JsonObject.Items[i]; if Item.Value.ValueType<>jvNone then begin - if cnt>0 then AppendString(Stream,Size,','); - InternalStringify(Stream,Size,Item.Name,Item.Value); + if cnt>0 then Stream.Append(','); + InternalStringify(Stream,Item.Name,Item.Value); Inc(cnt); end; end; - AppendString(Stream,Size,'}'); + Stream.Append('}'); end; procedure ArrayStringify(JsonArray:Jsons.TJsonArray); var @@ -446,28 +422,38 @@ procedure ArrayStringify(JsonArray:Jsons.TJsonArray); Item : TJsonValue; begin cnt := 0; - AppendString(Stream,Size,'['); + Stream.Append('['); for i:=0 to JsonArray.Count-1 do begin Item := JsonArray.Items[i]; if Item.ValueType<>jvNone then begin - if cnt>0 then AppendString(Stream,Size,','); - InternalStringify(Stream,Size,'',Item); + if cnt>0 then Stream.Append(','); + InternalStringify(Stream,'',Item); Inc(cnt); end; end; - AppendString(Stream,Size,']'); + Stream.Append(']'); end; begin if AValue.IsEmpty then Exit; - if AName<>'' then AppendString(Stream,Size,'"'+AValue.Encode(AName)+'":'); + if AName<>'' then + begin + Stream.Append('"'); + AValue.Encode(Stream,AName); + Stream.Append('":'); + end; case AValue.ValueType of jvNone : ; - jvNull : AppendString(Stream,Size,'null'); - jvString : AppendString(Stream,Size,'"'+AValue.Encode(AValue.AsString)+'"'); - jvNumber : AppendString(Stream,Size,FixedFloatToStr(AValue.AsNumber)); - jvBoolean : AppendString(Stream,Size,StrBoolean[AValue.AsBoolean]); + jvNull : Stream.Append('null'); + jvString : + begin + Stream.Append('"'); + AValue.Encode(Stream,AValue.AsString); + Stream.Append('"'); + end; + jvNumber : Stream.Append(FixedFloatToStr(AValue.AsNumber)); + jvBoolean : Stream.Append(StrBoolean[AValue.AsBoolean]); jvObject : ObjectStringify(AValue.AsObject); jvArray : ArrayStringify(AValue.AsArray); end; @@ -475,12 +461,12 @@ procedure ArrayStringify(JsonArray:Jsons.TJsonArray); function TJsonBase.Stringify:string; var - Size : NativeInt; + Stream : TStringBuilder; begin - Size := -1; - AppendString(Result,Size,''); - InternalStringify(Result,Size,'',TJsonValue(Self)); - SetLength(Result,Size); + Stream := TStringBuilder.Create; + InternalStringify(Stream,'',TJsonValue(Self)); + Result := Stream.ToString; + FreeAndNil(Stream); end; function TJsonBase.IsJsonArray(const S: string): Boolean; @@ -662,16 +648,8 @@ procedure TJsonValue.Clear; jvString : FStringValue := ''; jvNumber : FNumberValue := 0; jvBoolean : FBooleanValue := False; - jvObject : - begin - FObjectValue.Free; - FObjectValue := nil; - end; - jvArray : - begin - FArrayValue.Free; - FArrayValue := nil; - end; + jvObject : FreeAndNil(FObjectValue); + jvArray : FreeAndNil(FArrayValue); end; FValueType := jvNone; end; @@ -922,7 +900,7 @@ procedure TJsonArray.Clear; for I:=0 to FList.Count-1 do begin Item := TJsonValue(FList[I]); - Item.Free; + FreeAndNil(Item); end; FList.Clear; end; @@ -938,14 +916,14 @@ procedure TJsonArray.Delete(const Index:Integer); Item : TJsonValue; begin Item := TJsonValue(FList[Index]); - Item.Free; + FreeAndNil(Item); FList.Delete(Index); end; destructor TJsonArray.Destroy; begin Clear; - FList.Free; + FreeAndNil(FList); inherited; end; @@ -992,7 +970,7 @@ procedure TJsonArray.Parse(JsonString:string); Item.Parse(List[I]); end; finally - List.Free; + FreeAndNil(List); end; end; @@ -1070,7 +1048,7 @@ constructor TJsonPair.Create(AOwner:TJsonBase;const AName:string); destructor TJsonPair.Destroy; begin - FValue.Free; + FreeAndNil(FValue); inherited Destroy; end; @@ -1088,7 +1066,7 @@ procedure TJsonPair.Parse(JsonString:string); FName := Decode(Copy(StrName,2,Length(StrName)-2)); FValue.Parse(List[1]); finally - List.Free; + FreeAndNil(List); end; end; @@ -1123,7 +1101,7 @@ procedure TJsonObject.Clear; for I:=0 to FList.Count-1 do begin Item := TJsonPair(FList[I]); - Item.Free; + FreeAndNil(Item); end; FList.Clear; end; @@ -1140,7 +1118,7 @@ procedure TJsonObject.Delete(const Index:Integer); Item : TJsonPair; begin Item := TJsonPair(FList[Index]); - Item.Free; + FreeAndNil(Item); FList.Delete(Index); end; @@ -1156,7 +1134,7 @@ procedure TJsonObject.Delete(const Name:string); destructor TJsonObject.Destroy; begin Clear; - FList.Free; + FreeAndNil(FList); inherited Destroy; end; @@ -1235,7 +1213,7 @@ procedure TJsonObject.Parse(JsonString:string); Item.Parse(List[I]); end; finally - List.Free; + FreeAndNil(List); end; end; @@ -1368,16 +1346,8 @@ procedure TJson.Clear; begin case FStructType of jsNone : ; - jsArray : - begin - FJsonArray.Free; - FJsonArray := nil; - end; - jsObject : - begin - FJsonObject.Free; - FJsonObject := nil; - end; + jsArray : FreeAndNil(FJsonArray); + jsObject : FreeAndNil(FJsonObject); end; FStructType := jsNone; end; diff --git a/src/JsonsUtilsEx.pas b/src/JsonsUtilsEx.pas index 9dea644..5deaf46 100644 --- a/src/JsonsUtilsEx.pas +++ b/src/JsonsUtilsEx.pas @@ -14,9 +14,6 @@ function FixedFloatToStr(const Value: Extended): string; function FixedTryStrToFloat(const S: string; out Value: Extended): Boolean; function FixedStrToFloat(const S: string): Extended; -Function __ObjectToJson(aObject : TObject) : String; -Procedure __jsonToObject(Const aJSONString : String; Var aObject : TObject); - Type TObjectDynArray = array of TObject; TStringDynArray = array of string; @@ -31,9 +28,10 @@ implementation Uses TypInfo, Math, - DateUtils, - Jsons; + DateUtils; +const + MAX_SAFE_INTEGER = 9007199254740991; Type PPPTypeInfo = ^PPTypeInfo; @@ -198,402 +196,6 @@ function InArray(Str : string; ary : array of String) : boolean; end; end; - - -function InternalObjectToJSON(Obj : Tobject; PropList : array of String; WriteClass : boolean = false) : String; overload; -const lcst_exceptheader = 'ObjectToJson : '; -var - pl : PPropList; - iCnt : integer; - i: Integer; - sVal : string; - o : TObject; - //dyn array. - lTypeData: PTypeData; - {$IFDEF FPC} - P : Pointer; - lTypeInfoFPC : PTypeInfo; - {$ENDIF} - lTypeInfo: PPTypeInfo; - lpTypeInfo: PPPTypeInfo; - j : integeR; - arrobj : TObjectDynArray; - arrstr : TStringDynArray; - arrint : TIntegerDynArray; - jc : Integer; - jcs : String; - - js : TJson; - - Procedure RT; - begin - raise Exception.Create(lcst_exceptheader + 'Type must be implemented'); - end; - - -begin - if not Assigned(obj) then - raise Exception.Create(lcst_exceptheader + 'Input object is null'); - - iCnt := GetPropList(Obj, pl); - js := TJSon.Create; - try - Result := '{' {$IFDEF LINEBREAKJSONFORMAT}+ sLineBreak {$ENDIF}; - if WriteClass then - begin - Result := Result+'"class" : "'+js.Encode(obj.ClassName)+'"'; - end; - for i := 0 to iCnt-1 do - begin - if not InArray(string(pl[i]^.Name), PropList) then - Continue; - sVal := ''; - case pl[i]^.PropType^.Kind of - tkInteger: sVal := IntToStr(GetOrdProp(obj,pl[i])); - tkFloat : - begin - if pl[i]^.PropType^.Name = 'TDateTime' then - sVal := JSONDateToString(GetFloatProp(obj,pl[i])) - else if pl[i]^.PropType^.Name = 'TDate' then - sVal := JSONDateToString(GetFloatProp(obj,pl[i])) - else if pl[i]^.PropType^.Name = 'TTime' then - sVal := JSONDateToString(GetFloatProp(obj,pl[i])) - else - sVal := FixedFloatToStr(GetFloatProp(obj,pl[i])); - end; - tkInt64 : sVal := IntToStr(GetInt64Prop(obj,pl[i])); - - tkChar : sVal := '"'+js.Encode(Char(GetOrdProp(obj,pl[i])))+'"'; - {$IFDEF FPC} - tkAString, - {$ENDIF} - tkLString, - tkString, - tkUString: sVal := '"'+js.Encode(GetStrProp(obj,pl[i]))+'"'; - tkWChar : sVal := '"'+js.Encode(WideChar(GetOrdProp(obj,pl[i])))+'"'; - tkWString: sVal := '"'+js.Encode(GetWideStrProp(obj,pl[i]))+'"'; - tkEnumeration: - begin - sVal := GetEnumProp(obj,string(pl[i].Name)); - sVal := '"'+js.Encode(IntToStr(GetEnumValue(pl[i]^.PropType^,sVal)))+'"'; //GetEnumValue(pl[i]^.PropType^,GetEnumProp(obj,pl[i].Name)) - end; - tkClass: - begin - o := GetObjectProp(Obj,pl[i]); - if o is TObject then - sVal := InternalObjectToJSON(TObject(o),PropList) - else - Continue; - end; - tkDynArray : - begin - sVal := '[ '; - jcs :=','; - - lTypeData := GetTypeData(pl[i]^.PropType{$IFNDEF FPC}^{$ENDIF}); - {$IFNDEF FPC} - lpTypeInfo := PPPTypeInfo(lTypeData^.DynUnitNameFld.Tail); - lTypeInfo := lpTypeInfo^; - case lTypeInfo^.Kind of - {$ELSE} - lTypeInfoFPC := lTypeData^.ElType2; - case lTypeInfoFPC^.Kind of - tkAString, - {$ENDIF} - tkUString, tkString : //Warning, take care of {$IFDEF} just upside :) - begin - arrstr := TStringDynArray(GetDynArrayProp(Obj, pl[i])); - jc := Length(arrstr)-1; - for j := 0 to Length(arrstr)-1 do - begin - if j=jc then - jcs := EmptyStr; - sVal := sVal + js.Encode(arrstr[j]) + jcs; - end; - end; - tkInteger : - begin - arrint := TIntegerDynArray(GetDynArrayProp(Obj, pl[i])); - jc := Length(arrint)-1; - for j := 0 to Length(arrint)-1 do - begin - if j=jc then - jcs := EmptyStr; - sVal := sVal + js.Encode(IntToStr(arrint[j])) + jcs; - end; - end; - tkClass : - begin - arrobj := TObjectDynArray(GetDynArrayProp(Obj, pl[i])); - jc := Length(arrobj)-1; - for j := 0 to Length(arrobj)-1 do - begin - if j=jc then - jcs := EmptyStr; - sVal := sVal + InternalObjectToJSON(TObject(arrobj[j]),[]) + jcs; - end; - end; - end; - sVal :=sval + ' ]'; - end; - tkArray, - tkUnknown, - tkSet, - tkMethod, - tkVariant, - tkRecord, //Record will not be supported because of discrepeancy between delphi and FPC for record rtti processing. - tkInterface : RT; - end; - - Result := Result + '"' + js.Encode(string(pl[i]^.Name))+'" : '+sVal; - if Trim(Result) <> '{' then - begin - if i< icnt-1 then - begin - Result := Result+' , ' {$IFDEF LINEBREAKJSONFORMAT}+ sLineBreak {$ENDIF}; - end - else - begin - if Trim(Result) <> '{' then - Result := Result {$IFDEF LINEBREAKJSONFORMAT}+ sLineBreak {$ENDIF}; - end; - end; - end; - finally - FreeMem(pl); - FreeAndNil(js); - end; - Result := Result+'}'; -end; - -Procedure InternalJsonToObject(Const aJsonString : String; Var aObject : TObject); -const lcst_exceptheader = 'JsonToObject : '; -var //Json stuffs - lJSON : TJson; - lJsValue : TJsonValue; - lJsArray : TJsonArray; - - //rtti - lpl : PPropList; - lTypeData: PTypeData; - {$IFDEF FPC} - lTypeInfoFPC : PTypeInfo; - {$ENDIF} - lTypeInfo: PPTypeInfo; - lpTypeInfo: PPPTypeInfo; - - //General - lo : TObject; - loClass : TClass; - lDynObjArray : TObjectDynArray; - lIntegerArray : TIntegerDynArray; - lstringArray : TStringDynArray; - lpc : Cardinal; - i,j : integer; - lsTemp : String; - - Procedure RT; - begin - raise Exception.Create(lcst_exceptheader + 'Type must be implemented'); - end; - -begin - Assert((assigned(aObject))); - lJSON := TJson.Create; - try - lJSON.Parse(aJsonString); - if Not(lJSON.StructType = TJsonStructType.jsObject) then - begin - raise Exception.Create(lcst_exceptheader + 'JSON Parser fails : Json file is not an object representation.'); - end; - - //JSON will drive by object structure. - lpc := GetPropList(aObject, lpl); - for i := 0 to lpc-1 do - begin - lJsValue := lJSON[string(lpl[i].Name)]; - - if lJsValue.IsNull then - begin - if lJsValue.IsEmpty then - begin - //JSON Porpety null, but exists. - Continue; - end - else - begin - //Property is not in JSON, - Continue; - end; - end; - - case lpl[i]^.PropType^.Kind of - tkFloat : - begin - if lJsValue.ValueType = jvString then //According to JSON, it is parhaps a date ? Rtti reconize date as float. - begin - lsTemp := lJSON[string(lpl[i].Name)].AsString; - if JSONStringIsCompatibleDate(lsTemp) then - begin - SetFloatProp(aObject,string(lpl[i].Name),JSONStringToDate(lsTemp)); - end - Else - begin - raise Exception.Create(lcst_exceptheader + 'Incompatible type (Perhaps unknow date format) Property "'+string(lpl[i].Name)+'"'); - end; - end - else - begin - SetFloatProp(aObject,string(lpl[i].Name),lJSON[string(lpl[i].Name)].AsNumber); - end; - end; - tkInt64 : SetInt64Prop(aObject,string(lpl[i].Name),lJSON[string(lpl[i].Name)].AsInteger); - tkInteger: SetOrdProp(aObject,string(lpl[i].Name),lJSON[string(lpl[i].Name)].AsInteger); - tkLString, - tkString, - tkUString, - tkChar, - tkWChar, - {$IFDEF FPC} - tkAString, - {$ENDIF} - tkWString: - begin - SetStrProp(aObject,string(lpl[i].Name),lJSON[string(lpl[i].Name)].AsString); - end; - tkEnumeration: SetOrdProp(aObject,string(lpl[i].Name),Integer(lJSON[string(lpl[i].Name)].AsInteger)); - tkClass: - begin - if (lJsValue.ValueType = TJsonValueType.jvObject) or (lJsValue.ValueType = TJsonValueType.jvNone) then - begin - //In jvNone case, we do nothing (JSON has not this property, but it is object which driven our build. - if (lJsValue.ValueType = TJsonValueType.jvObject) then - begin - lTypeData := GetTypeData(lpl[i]^.PropType{$IFNDEF FPC}^{$ENDIF}); - loClass := lTypeData^.ClassType; - lo := loClass.Create; - try - InternalJsonToObject(lJsValue.Stringify, lo); - Except - On E: Exception do - raise Exception.Create(lcst_exceptheader + '[InternalJsonToObject reentrance single object] (Property '+string(lpl[i].Name)+') ' + E.Message); - end; - SetObjectProp(aObject,string(lpl[i]^.Name),lo); - end; - end - else - begin - raise Exception.Create(lcst_exceptheader + 'Original JSON type not match with class type : Property "'+string(lpl[i].Name)+'"'); - end; - end; - tkDynArray : - begin - if lJsValue.ValueType = TJsonValueType.jvArray then - begin - ljsArray := lJsValue.AsArray; - for j := 0 to lJsArray.Count-1 do - begin - case lJsArray[j].ValueType of - jvString : - begin - SetLength(lstringArray,Length(lstringArray)+1); - lstringArray[Length(lstringArray)-1] := lJsArray[j].AsString; - end; - jvObject : - begin - lTypeData := GetTypeData(lpl[i]^.PropType{$IFNDEF FPC}^{$ENDIF}); - {$IFNDEF FPC} - //Delphi compiler : RTTI permit to get automaticaly dependance class. - lpTypeInfo := PPPTypeInfo(lTypeData^.DynUnitNameFld.Tail); - lTypeInfo := lpTypeInfo^; - if (lTypeInfo^.Kind = tkClass) then - begin - loClass := lTypeInfo^.TypeData^.ClassType; - //loClass := TGSJson.Configuration.GetPropertyConfiguration(lpl[i]^.Name).ItemArrayType; //as FPC ? switch ? - end - else - begin - raise Exception.Create(lcst_exceptheader + ' Delphi Class resolving : Not object Error : Property "'+string(lpl[i].Name)+'"'); - end; - {$ELSE} - //FPC side : first view not possible :( Use kind of marshaller config instead. - lTypeInfoFPC := lTypeData^.ElType2; - if (lTypeInfoFPC^.Kind = tkClass) then - begin - loClass := TGSJson.Configuration.GetPropertyConfiguration(lpl[i]^.Name).ItemArrayType; - end - else - begin - raise Exception.Create(lcst_exceptheader + ' FPC Class resolving : Not object Error : Property "'+lpl[i].Name+'"'); - end; - {$ENDIF} - lo := loClass.Create; - try - InternalJsonToObject(lJsArray[j].Stringify, lo); - SetLength(lDynObjArray,Length(lDynObjArray)+1); - lDynObjArray[Length(lDynObjArray)-1] := lo; - Except - On E: EXception do - raise Exception.Create(lcst_exceptheader +'[InternalJsonToObject reentrance] : Property "'+string(lpl[i].Name)+'" - ' + E.Message); - end; - end; - jvNumber: - begin - SetLength(lIntegerArray,Length(lIntegerArray)+1); - lIntegerArray[Length(lIntegerArray)-1] := lJsArray[j].AsInteger; - end - else - begin - raise Exception.Create(lcst_exceptheader + 'type not implemented or supported : Property "'+string(lpl[i].Name)+'"'); - end; - end; - end; - if lJsArray.Count>0 then - begin - case lJsArray[0].ValueType of - jvString : SetDynArrayProp(aObject,string(lpl[i].Name),lstringArray); - jvObject : SetDynArrayProp(aObject,string(lpl[i].Name),lDynObjArray); - jvNumber : SetDynArrayProp(aObject,string(lpl[i].Name),lIntegerArray); - end; - end; - end - else - begin - //empty element. - if Not(lJsValue.IsNull) then - begin - //element does not exists in JSON. error ? - //Todo : Property like "StrictElementCorrespondaceCheck" something like that ? - //raise Exception.Create('type Error Message'); - end; - end; - end; - tkArray, - tkUnknown, - tkSet, - tkMethod, - tkVariant, - tkRecord, - tkInterface : RT; - end; - end; - finally - Dispose(lpl); - FreeAndNil(lJSON); - end; -end; - -function __ObjectToJson(aObject: TObject): String; -begin - Result := InternalObjectToJSON(aObject,[]); -end; - -Procedure __jsonToObject(Const aJSONString : String; Var aObject : TObject); -begin - InternalJsonToObject(aJSONString, aObject); -end; - - Initialization JsonsUtils_GLB_DECIMALSEPARATOR := GetDecimalSeparator;