From 6eca4f86960ca9a75e1e0ee9f6e12635365f513f Mon Sep 17 00:00:00 2001 From: Maicon Fernando Date: Mon, 17 Aug 2020 15:06:56 -0300 Subject: [PATCH 1/5] Skip Delphi temporary files --- .gitignore | 7 +++++++ 1 file changed, 7 insertions(+) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b0d3cb8 --- /dev/null +++ b/.gitignore @@ -0,0 +1,7 @@ + +*.identcache +*.local +*.dcu +*.exe +test/TestJson.res +test/TestJson.dproj From d44fb067cf4e35f5d4168608ef676e80f9f5c199 Mon Sep 17 00:00:00 2001 From: Maicon Fernando Date: Mon, 17 Aug 2020 15:11:40 -0300 Subject: [PATCH 2/5] Revert "Skip Delphi temporary files" This reverts commit 6eca4f86960ca9a75e1e0ee9f6e12635365f513f. --- .gitignore | 7 ------- 1 file changed, 7 deletions(-) delete mode 100644 .gitignore diff --git a/.gitignore b/.gitignore deleted file mode 100644 index b0d3cb8..0000000 --- a/.gitignore +++ /dev/null @@ -1,7 +0,0 @@ - -*.identcache -*.local -*.dcu -*.exe -test/TestJson.res -test/TestJson.dproj From 366be0ba173d236d62504c548f97da6ee10eb150 Mon Sep 17 00:00:00 2001 From: Maicon Fernando Date: Mon, 17 Aug 2020 15:15:21 -0300 Subject: [PATCH 3/5] Skip Delphi temporary files --- .gitignore | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b34c081 --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ + +*.dcu +*.exe +*.res +*.identcache +*.local From d544ff004218b1494dd2830e8fc825b7378da25f Mon Sep 17 00:00:00 2001 From: Maicon Fernando Date: Fri, 21 Aug 2020 16:16:48 -0300 Subject: [PATCH 4/5] Enhancements - Add Pretty format for Stringify; - JsonArray.Put support multiples values at same time; - Put without parameter will be 'empty' by default; --- src/Jsons.pas | 1031 +++++++++++++++++++++++++++++--------------- test/TestJson2.dpr | 48 +++ 2 files changed, 743 insertions(+), 336 deletions(-) create mode 100644 test/TestJson2.dpr diff --git a/src/Jsons.pas b/src/Jsons.pas index 5669f8b..7715d8b 100644 --- a/src/Jsons.pas +++ b/src/Jsons.pas @@ -21,9 +21,13 @@ 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) +201804 - Fix - 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. +202008 - Add - MaiconSoft - Constructor "New" for fast initialize Objects +202008 - Add - MaiconSoft - JsonArray.Put support multiples values at same time +202008 - Fix - MaiconSoft - Put without parameter will be 'empty' by default +202008 - Add - MaiconSoft - Add 'Pretty', stringify version for human read ****************************************************************************} @@ -35,12 +39,16 @@ interface -uses Classes, SysUtils, jsonsutilsEx; +uses + Classes, SysUtils, jsonsutilsEx; type TJsonValueType = (jvNone, jvNull, jvString, jvNumber, jvBoolean, jvObject, jvArray); + TJsonStructType = (jsNone, jsArray, jsObject); + TJsonNull = (null); + TJsonEmpty = (empty); type @@ -48,86 +56,73 @@ TJsonBase = class(TObject) private FOwner: TJsonBase; function GetOwner: TJsonBase; - protected - function GetOwnerName: String; - procedure RaiseError(const Msg: String); - procedure RaiseParseError(const JsonString: String); + 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; abstract; - + procedure Parse(JsonString: string); virtual; abstract; + function Stringify: string; virtual; abstract; + function Pretty(IdentLevel: Integer = 0): string; virtual; abstract; 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; - + 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; + 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 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 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; - function Stringify: String; override; - + procedure Parse(JsonString: string); override; + function Stringify: string; override; + function Pretty(IdentLevel: Integer = 0): string; override; procedure Assign(Source: TJsonBase); override; - procedure Clear; - public property ValueType: TJsonValueType read FValueType; - property AsString: String read GetAsString write SetAsString; + 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; @@ -135,7 +130,6 @@ TJsonValue = class(TJsonBase) 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) @@ -146,55 +140,65 @@ TJsonArray = class(TJsonBase) public constructor Create(AOwner: TJsonBase = nil); destructor Destroy; override; - - procedure Parse(JsonString: String); override; - function Stringify: String; override; - + procedure Parse(JsonString: string); override; + function Stringify: string; override; + function Pretty(IdentLevel: Integer = 0): string; override; procedure Assign(Source: TJsonBase); override; procedure Merge(Addition: TJsonArray); - function Add: TJsonValue; function Insert(const Index: Integer): TJsonValue; - + function Put(): 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: 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 Args: array of const; FreeOrphanObj: Boolean = True): + TJsonArray; 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; + FName: string; FValue: TJsonValue; - - procedure SetName(const Value: String); - + procedure SetName(const Value: string); + procedure Assign(Source: TJsonBase); public - constructor Create(AOwner: TJsonBase; const AName: String = ''); + constructor Create(AOwner: TJsonBase; const AName: string = ''); destructor Destroy; override; - - procedure Parse(JsonString: String); override; - function Stringify: String; override; - - procedure Assign(Source: TJsonBase); override; - + procedure Parse(JsonString: string); override; + function Stringify: string; override; + function Pretty(IdentLevel: Integer = 0): string; override; + class function New(Name: string; Value: TJsonEmpty; AOwner: TJsonBase = nil): + TJsonObject; overload; static; + class function New(Name: string; Value: TJsonNull; AOwner: TJsonBase = nil): + TJsonObject; overload; static; + class function New(Name: string; Value: Boolean; AOwner: TJsonBase = nil): + TJsonObject; overload; static; + class function New(Name: string; Value: Integer; AOwner: TJsonBase = nil): + TJsonObject; overload; static; + class function New(Name: string; Value: Extended; AOwner: TJsonBase = nil): + TJsonObject; overload; static; + class function New(Name: string; Value: string; AOwner: TJsonBase = nil): + TJsonObject; overload; static; + class function New(Name: string; Value: TJsonArray; AOwner: TJsonBase = nil): + TJsonObject; overload; static; + class function New(Name: string; Value: TJsonObject; AOwner: TJsonBase = nil): + TJsonObject; overload; static; + class function New(Name: string; Value: TJsonValue; AOwner: TJsonBase = nil): + TJsonObject; overload; static; public - property Name: String read FName write SetName; + property Name: string read FName write SetName; property Value: TJsonValue read FValue; - end; TJsonObject = class(TJsonBase) @@ -203,44 +207,38 @@ TJsonObject = class(TJsonBase) FAutoAdd: Boolean; function GetCount: Integer; function GetItems(Index: Integer): TJsonPair; - function GetValues(Name: String): TJsonValue; + function GetValues(Name: string): TJsonValue; + procedure Assign(Source: TJsonBase); public constructor Create(AOwner: TJsonBase = nil); destructor Destroy; override; - - procedure Parse(JsonString: String); override; - function Stringify: String; override; - - procedure Assign(Source: TJsonBase); override; + procedure Parse(JsonString: string); override; + function Stringify: string; override; + function Pretty(IdentLevel: Integer = 0): string; 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 Add(const Name: string = ''): TJsonPair; + function Insert(const Index: Integer; const Name: string = ''): TJsonPair; + function Put(const Name: string): 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: array of const): TJsonValue; overload; function Put(const Value: TJsonPair): TJsonValue; overload; - - function Find(const Name: String): Integer; - + function Find(const Name: string): Integer; procedure Delete(const Index: Integer); overload; - procedure Delete(const Name: String); 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 Values[Name: string]: TJsonValue read GetValues; default; property AutoAdd: Boolean read FAutoAdd write FAutoAdd; - end; TJson = class(TJsonBase) @@ -248,79 +246,79 @@ TJson = class(TJsonBase) FStructType: TJsonStructType; FJsonArray: TJsonArray; FJsonObject: TJsonObject; - function GetCount: Integer; function GetJsonArray: TJsonArray; function GetJsonObject: TJsonObject; - function GetValues(Name: String): TJsonValue; + function GetValues(Name: string): TJsonValue; + function FixIdent(Data: string): string; 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 Parse(JsonString: string); override; + function Stringify: string; override; + function Pretty(IdentLevel: Integer = -1): string; override; procedure Assign(Source: TJsonBase); override; - procedure Delete(const Index: Integer); overload; - procedure Delete(const Name: String); 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 Name: string): TJsonValue; overload; //for JsonObject //for JsonArray + function Put(): 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: 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 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 Name: string; const Value: array of const): 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 Values[Name: string]: TJsonValue read GetValues; default; //for JsonObject end; implementation +function Ident(level: Integer): string; +begin + if level < 0 then + exit(''); + Result := string.Create(' ', level * 4); +end; + { TJsonBase } -function TJsonBase.AnalyzeJsonValueType(const S: String): TJsonValueType; +function TJsonBase.AnalyzeJsonValueType(const S: string): TJsonValueType; var Len: Integer; Number: Extended; @@ -329,14 +327,21 @@ function TJsonBase.AnalyzeJsonValueType(const S: String): TJsonValueType; 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 if FixedTryStrToFloat(S, Number) then + Result := jvNumber; end; constructor TJsonBase.Create(AOwner: TJsonBase); @@ -344,22 +349,26 @@ constructor TJsonBase.Create(AOwner: TJsonBase); FOwner := AOwner; end; -function TJsonBase.Decode(const S: String): String; +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 + '"'); + '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; + ubuf: integer; begin Result := ''; I := 1; @@ -372,22 +381,29 @@ function TJsonBase.Decode(const S: String): String; C := S[I]; Inc(I); case C of - 'b': Result := Result + #8; - 't': Result := Result + #9; - 'n': Result := Result + #10; - 'f': Result := Result + #12; - 'r': Result := Result + #13; + 'b': + Result := Result + #8; + 't': + Result := Result + #9; + 'n': + Result := Result + #10; + 'f': + Result := Result + #12; + 'r': + Result := Result + #13; 'u': - begin - if not TryStrToInt('$' + Copy(S, I, 4), ubuf) then - raise Exception.Create(format('Invalid unicode \u%s',[Copy(S, I, 4)])); - result := result + WideChar(ubuf); - Inc(I, 4); - end; - else Result := Result + C; + begin + if not TryStrToInt('$' + Copy(S, I, 4), ubuf) then + raise Exception.Create(format('Invalid unicode \u%s', [Copy(S, I, 4)])); + result := result + WideChar(ubuf); + Inc(I, 4); + end; + else + Result := Result + C; end; end - else Result := Result + C; + else + Result := Result + C; end; end; @@ -396,9 +412,9 @@ destructor TJsonBase.Destroy; inherited Destroy; end; -function TJsonBase.Encode(const S: String): String; +function TJsonBase.Encode(const S: string): string; var - I, UnicodeValue : Integer; + I, UnicodeValue: Integer; C: Char; begin Result := ''; @@ -406,26 +422,34 @@ function TJsonBase.Encode(const S: String): String; begin C := S[I]; case C of - '"':Result := Result + '\' + C; - '\': Result := Result + '\' + C; - '/': Result := Result + '\' + C; - #8: Result := Result + '\b'; - #9: Result := Result + '\t'; - #10: Result := Result + '\n'; - #12: Result := Result + '\f'; - #13: Result := Result + '\r'; - else + '"': + Result := Result + '\' + C; + '\': + Result := Result + '\' + C; + '/': + Result := Result + '\' + C; + #8: + Result := Result + '\b'; + #9: + Result := Result + '\t'; + #10: + Result := Result + '\n'; + #12: + Result := Result + '\f'; + #13: + Result := Result + '\r'; + else if (C < WideChar(32)) or (C > WideChar(127)) then begin Result := result + '\u'; UnicodeValue := Ord(C); - Result := result + lowercase(IntToHex((UnicodeValue and 61440) shr 12,1)); - Result := result + lowercase(IntToHex((UnicodeValue and 3840) shr 8,1)); - Result := result + lowercase(IntToHex((UnicodeValue and 240) shr 4,1)); - Result := result + lowercase(IntToHex((UnicodeValue and 15),1)); + Result := result + lowercase(IntToHex((UnicodeValue and 61440) shr 12, 1)); + Result := result + lowercase(IntToHex((UnicodeValue and 3840) shr 8, 1)); + Result := result + lowercase(IntToHex((UnicodeValue and 240) shr 4, 1)); + Result := result + lowercase(IntToHex((UnicodeValue and 15), 1)); end else - Result := Result + C; + Result := Result + C; end; end; @@ -436,7 +460,7 @@ function TJsonBase.GetOwner: TJsonBase; Result := FOwner; end; -function TJsonBase.GetOwnerName: String; +function TJsonBase.GetOwnerName: string; var TheOwner: TJsonBase; begin @@ -444,17 +468,19 @@ function TJsonBase.GetOwnerName: String; TheOwner := Owner; while True do begin - if not Assigned(TheOwner) then Break + if not Assigned(TheOwner) then + Break else if TheOwner is TJsonPair then begin Result := (TheOwner as TJsonPair).Name; Break; end - else TheOwner := TheOwner.Owner; + else + TheOwner := TheOwner.Owner; end; end; -function TJsonBase.IsJsonArray(const S: String): Boolean; +function TJsonBase.IsJsonArray(const S: string): Boolean; var Len: Integer; begin @@ -462,24 +488,24 @@ function TJsonBase.IsJsonArray(const S: String): Boolean; 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'); end; -function TJsonBase.IsJsonNull(const S: String): Boolean; +function TJsonBase.IsJsonNull(const S: string): Boolean; begin Result := SameText(S, 'null'); end; -function TJsonBase.IsJsonNumber(const S: String): Boolean; +function TJsonBase.IsJsonNumber(const S: string): Boolean; var Number: Extended; begin Result := FixedTryStrToFloat(S, Number); end; -function TJsonBase.IsJsonObject(const S: String): Boolean; +function TJsonBase.IsJsonObject(const S: string): Boolean; var Len: Integer; begin @@ -487,7 +513,7 @@ function TJsonBase.IsJsonObject(const S: String): Boolean; 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; begin @@ -497,28 +523,29 @@ function TJsonBase.IsJsonString(const S: String): Boolean; procedure TJsonBase.RaiseAssignError(Source: TJsonBase); var - SourceClassName: String; + SourceClassName: string; begin - if Source is TObject then SourceClassName := Source.ClassName - else SourceClassName := 'nil'; + 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); +procedure TJsonBase.RaiseError(const Msg: string); var - S: String; + S: string; begin 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])); end; -procedure TJsonBase.Split(const S: String; const Delimiter: Char; - Strings: TStrings); +procedure TJsonBase.Split(const S: string; const Delimiter: Char; Strings: TStrings); function IsPairBegin(C: Char): Boolean; begin @@ -528,10 +555,14 @@ procedure TJsonBase.Split(const S: String; const Delimiter: Char; function GetPairEnd(C: Char): Char; begin case C of - '{': Result := '}'; - '[': Result := ']'; - '"': Result := '"'; - else Result := #0; + '{': + Result := '}'; + '[': + Result := ']'; + '"': + Result := '"'; + else + Result := #0; end; end; @@ -547,16 +578,19 @@ procedure TJsonBase.Split(const S: String; const Delimiter: Char; 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); + 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; + StrItem: string; begin PtrBegin := PChar(S); PtrEnd := PtrBegin; @@ -571,11 +605,13 @@ procedure TJsonBase.Split(const S: String; const Delimiter: Char; PtrEnd := PtrBegin; Continue; end - else if IsPairBegin(C) then PtrEnd := MoveToPair(PtrEnd); + else if IsPairBegin(C) then + PtrEnd := MoveToPair(PtrEnd); Inc(PtrEnd); end; StrItem := Trim(Copy(PtrBegin, 1, PtrEnd - PtrBegin)); - if StrItem <> '' then Strings.Add(StrItem); + if StrItem <> '' then + Strings.Add(StrItem); end; { TJsonValue } @@ -585,7 +621,8 @@ procedure TJsonValue.Assign(Source: TJsonBase); Src: TJsonValue; begin Clear; - if not(Source is TJsonValue) and not(Source is TJsonObject) and not(Source is TJsonArray) then + if not (Source is TJsonValue) and not (Source is TJsonObject) and not (Source + is TJsonArray) then RaiseAssignError(Source); if Source is TJsonObject then begin @@ -604,10 +641,14 @@ procedure TJsonValue.Assign(Source: TJsonBase); Src := Source as TJsonValue; FValueType := Src.FValueType; case FValueType of - jvNone, jvNull: ; - jvString: FStringValue := Src.FStringValue; - jvNumber: FNumberValue := Src.FNumberValue; - jvBoolean: FBooleanValue := Src.FBooleanValue; + jvNone, jvNull: + ; + jvString: + FStringValue := Src.FStringValue; + jvNumber: + FNumberValue := Src.FNumberValue; + jvBoolean: + FBooleanValue := Src.FBooleanValue; jvObject: begin FObjectValue := TJsonObject.Create(Self); @@ -625,10 +666,14 @@ procedure TJsonValue.Assign(Source: TJsonBase); procedure TJsonValue.Clear; begin case FValueType of - jvNone, jvNull: ; - jvString: FStringValue := ''; - jvNumber: FNumberValue := 0; - jvBoolean: FBooleanValue := False; + jvNone, jvNull: + ; + jvString: + FStringValue := ''; + jvNumber: + FNumberValue := 0; + jvBoolean: + FBooleanValue := False; jvObject: begin FObjectValue.Free; @@ -667,7 +712,8 @@ function TJsonValue.GetAsArray: TJsonArray; FValueType := jvArray; FArrayValue := TJsonArray.Create(Self); end; - if FValueType <> jvArray then RaiseValueTypeError(jvArray); + if FValueType <> jvArray then + RaiseValueTypeError(jvArray); Result := FArrayValue; end; @@ -675,11 +721,16 @@ 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(lowercase(FStringValue), 'true'); + jvNumber: + Result := (FNumberValue <> 0); + jvBoolean: + Result := FBooleanValue; + jvObject, jvArray: + RaiseValueTypeError(jvBoolean); end; end; @@ -687,11 +738,16 @@ 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; @@ -699,11 +755,16 @@ 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; @@ -714,21 +775,27 @@ function TJsonValue.GetAsObject: TJsonObject; 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; @@ -742,16 +809,21 @@ function TJsonValue.GetIsNull: Boolean; Result := (FValueType = jvNull); end; -procedure TJsonValue.Parse(JsonString: String); +procedure TJsonValue.Parse(JsonString: string); begin Clear; 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'); + 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); @@ -765,13 +837,36 @@ procedure TJsonValue.Parse(JsonString: String); end; end; +function TJsonValue.Pretty(IdentLevel: Integer): string; +const + StrBoolean: array[Boolean] of string = ('false', 'true'); +begin + Result := ''; + case FValueType of + jvNone, jvNull: + Result := Ident(IdentLevel + 1) + 'null'; + jvString: + Result := ident(IdentLevel + 1) + '"' + Encode(FStringValue) + '"'; + jvNumber: + Result := ident(IdentLevel + 1) + FixedFloatToStr(FNumberValue); + jvBoolean: + Result := ident(IdentLevel + 1) + StrBoolean[FBooleanValue]; + jvObject: + Result := FObjectValue.Pretty(IdentLevel + 1); + jvArray: + Result := FArrayValue.Pretty(IdentLevel + 1); + end; +end; + 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; @@ -822,7 +917,7 @@ procedure TJsonValue.SetAsObject(const Value: TJsonObject); FObjectValue.Assign(Value); end; -procedure TJsonValue.SetAsString(const Value: String); +procedure TJsonValue.SetAsString(const Value: string); begin if FValueType <> jvString then begin @@ -854,18 +949,24 @@ procedure TJsonValue.SetIsNull(const Value: Boolean); end; end; -function TJsonValue.Stringify: String; +function TJsonValue.Stringify: string; const - StrBoolean: array[Boolean] of String = ('false', 'true'); + StrBoolean: array[Boolean] of string = ('false', 'true'); begin Result := ''; case FValueType of - jvNone, jvNull: Result := 'null'; - jvString: Result := '"' + Encode(FStringValue) + '"'; - jvNumber: Result := FixedFloatToStr(FNumberValue); - jvBoolean: Result := StrBoolean[FBooleanValue]; - jvObject: Result := FObjectValue.Stringify; - jvArray: Result := FArrayValue.Stringify; + jvNone, jvNull: + Result := 'null'; + jvString: + Result := '"' + Encode(FStringValue) + '"'; + jvNumber: + Result := FixedFloatToStr(FNumberValue); + jvBoolean: + Result := StrBoolean[FBooleanValue]; + jvObject: + Result := FObjectValue.Stringify; + jvArray: + Result := FArrayValue.Stringify; end; end; @@ -883,9 +984,11 @@ procedure TJsonArray.Assign(Source: TJsonBase); I: Integer; begin Clear; - if not(Source is TJsonArray) then RaiseAssignError(Source); + 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; @@ -943,19 +1046,21 @@ procedure TJsonArray.Merge(Addition: TJsonArray); var 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; + S: string; List: TStringList; Item: TJsonValue; begin Clear; JsonString := Trim(JsonString); - if not IsJsonArray(JsonString) then RaiseParseError(JsonString); + if not IsJsonArray(JsonString) then + RaiseParseError(JsonString); S := Trim(Copy(JsonString, 2, Length(JsonString) - 2)); List := TStringList.Create; try @@ -970,6 +1075,26 @@ procedure TJsonArray.Parse(JsonString: String); end; end; +function TJsonArray.Pretty(IdentLevel: Integer): string; +var + I: Integer; + Item: TJsonValue; + ItemList: string; +begin + if FList.Count = 0 then + Exit(Ident(IdentLevel) + '[]'); + Result := Ident(IdentLevel) + '[' + #10; + ItemList := ''; + for I := 0 to FList.Count - 1 do + begin + Item := TJsonValue(FList[I]); + if I > 0 then + ItemList := ItemList + ','#10; + ItemList := ItemList + Item.Pretty(IdentLevel); + end; + Result := Result + ItemList + #10 + Ident(IdentLevel) + ']'; +end; + function TJsonArray.Put(const Value: Boolean): TJsonValue; begin Result := Add; @@ -1012,7 +1137,7 @@ function TJsonArray.Put(const Value: TJsonValue): TJsonValue; Result.Assign(Value); end; -function TJsonArray.Put(const Value: String): TJsonValue; +function TJsonArray.Put(const Value: string): TJsonValue; begin Result := Add; Result.AsString := Value; @@ -1024,7 +1149,7 @@ function TJsonArray.Put(const Value: TJsonArray): TJsonValue; Result.Assign(Value); end; -function TJsonArray.Stringify: String; +function TJsonArray.Stringify: string; var I: Integer; Item: TJsonValue; @@ -1033,25 +1158,94 @@ function TJsonArray.Stringify: String; for I := 0 to FList.Count - 1 do begin Item := TJsonValue(FList[I]); - if I > 0 then Result := Result + ','; + if I > 0 then + Result := Result + ','; Result := Result + Item.Stringify; end; Result := Result + ']'; end; +function TJsonArray.Put(const Args: array of const; FreeOrphanObj: Boolean): TJsonArray; +var + rec: TVarRec; + JsonObj: TJsonObject; + JsonVal: TJsonValue; +begin + Result := self; + + for rec in Args do + begin + with rec do + begin + case VType of + vtInteger: + Put(VInteger); + vtBoolean: + Put(VBoolean); + vtChar, vtWideChar: + Put(VChar); + vtExtended: + Put(VExtended^); + vtString: + Put(VString^); + vtPChar: + Put(VPChar); + vtPointer: + if VPointer = nil then + Put(null); + vtObject: + begin + if VObject.ClassName = 'TJsonValue' then + begin + JsonVal := TJsonValue(VObject); + Put(JsonVal); + if (JsonVal.Owner = nil) and (FreeOrphanObj) then + JsonVal.Free; + Continue; + end; + if VObject.ClassName = 'TJsonObject' then + begin + JsonObj := TJsonObject(VObject); + Put(JsonObj); + if (JsonObj.Owner = nil) and (FreeOrphanObj) then + JsonObj.Free; + Continue; + end; + end; + vtAnsiString: + Put(string(VAnsiString)); + vtCurrency: + Put(VCurrency^); + vtVariant: + Put(string(VVariant^)); + vtInt64: + Put(VInt64^); + vtUnicodeString: + Put(string(VUnicodeString)); + end; + end; + end; +end; + +function TJsonArray.Put: TJsonValue; +begin + Result := put(empty); +end; + { TJsonPair } procedure TJsonPair.Assign(Source: TJsonBase); var Src: TJsonPair; begin - if not(Source is TJsonPair) then RaiseAssignError(Source); + 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); +constructor TJsonPair.Create(AOwner: TJsonBase; const AName: string); begin inherited Create(AOwner); FName := AName; @@ -1064,17 +1258,61 @@ destructor TJsonPair.Destroy; inherited Destroy; end; -procedure TJsonPair.Parse(JsonString: String); +class function TJsonPair.New(Name: string; Value: TJsonEmpty; AOwner: TJsonBase): + TJsonObject; +begin + Result := TJsonObject.Create(AOwner); + Result.Put(Name, Value); +end; + +class function TJsonPair.New(Name: string; Value: TJsonNull; AOwner: TJsonBase): + TJsonObject; +begin + Result := TJsonObject.Create(AOwner); + Result.Put(Name, Value); +end; + +class function TJsonPair.New(Name: string; Value: Boolean; AOwner: TJsonBase): + TJsonObject; +begin + Result := TJsonObject.Create(AOwner); + Result.Put(Name, Value); +end; + +class function TJsonPair.New(Name: string; Value: Extended; AOwner: TJsonBase): + TJsonObject; +begin + Result := TJsonObject.Create(AOwner); + Result.Put(Name, Value); +end; + +class function TJsonPair.New(Name: string; Value: Integer; AOwner: TJsonBase): + TJsonObject; +begin + Result := TJsonObject.Create(AOwner); + Result.Put(Name, Value); +end; + +class function TJsonPair.New(Name: string; Value: string; AOwner: TJsonBase = + nil): TJsonObject; +begin + Result := TJsonObject.Create(AOwner); + Result.Put(Name, Value); +end; + +procedure TJsonPair.Parse(JsonString: string); var List: TStringList; - StrName: String; + StrName: string; begin List := TStringList.Create; try Split(JsonString, ':', List); - if List.Count <> 2 then RaiseParseError(JsonString); + if List.Count <> 2 then + RaiseParseError(JsonString); StrName := List[0]; - if not IsJsonString(StrName) then RaiseParseError(StrName); + if not IsJsonString(StrName) then + RaiseParseError(StrName); FName := Decode(Copy(StrName, 2, Length(StrName) - 2)); FValue.Parse(List[1]); finally @@ -1082,19 +1320,45 @@ procedure TJsonPair.Parse(JsonString: String); end; end; -procedure TJsonPair.SetName(const Value: String); +function TJsonPair.Pretty(IdentLevel: Integer): string; +begin + Result := Ident(IdentLevel) + Format('"%s": %s', [Encode(FName), FValue.Pretty()]); +end; + +procedure TJsonPair.SetName(const Value: string); begin FName := Value; end; -function TJsonPair.Stringify: String; +function TJsonPair.Stringify: string; begin Result := Format('"%s":%s', [Encode(FName), FValue.Stringify]); end; +class function TJsonPair.New(Name: string; Value: TJsonArray; AOwner: TJsonBase): + TJsonObject; +begin + Result := TJsonObject.Create(AOwner); + Result.Put(Name, Value); +end; + +class function TJsonPair.New(Name: string; Value: TJsonObject; AOwner: TJsonBase): + TJsonObject; +begin + Result := TJsonObject.Create(AOwner); + Result.Put(Name, Value); +end; + +class function TJsonPair.New(Name: string; Value: TJsonValue; AOwner: TJsonBase): + TJsonObject; +begin + Result := TJsonObject.Create(AOwner); + Result.Put(Name, 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); @@ -1106,9 +1370,11 @@ procedure TJsonObject.Assign(Source: TJsonBase); I: Integer; begin Clear; - if not(Source is TJsonObject) then RaiseAssignError(Source); + 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; @@ -1140,12 +1406,13 @@ procedure TJsonObject.Delete(const Index: Integer); FList.Delete(Index); end; -procedure TJsonObject.Delete(const Name: String); +procedure TJsonObject.Delete(const Name: string); var 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; @@ -1156,7 +1423,7 @@ destructor TJsonObject.Destroy; inherited Destroy; end; -function TJsonObject.Find(const Name: String): Integer; +function TJsonObject.Find(const Name: string): Integer; var I: Integer; Pair: TJsonPair; @@ -1183,7 +1450,7 @@ function TJsonObject.GetItems(Index: Integer): TJsonPair; Result := TJsonPair(FList[Index]); end; -function TJsonObject.GetValues(Name: String): TJsonValue; +function TJsonObject.GetValues(Name: string): TJsonValue; var Index: Integer; Pair: TJsonPair; @@ -1191,15 +1458,16 @@ function TJsonObject.GetValues(Name: String): TJsonValue; Index := Find(Name); 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]); + 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); FList.Insert(Index, Result); @@ -1209,19 +1477,21 @@ procedure TJsonObject.Merge(Addition: TJsonObject); var 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; + S: string; List: TStringList; Item: TJsonPair; begin Clear; JsonString := Trim(JsonString); - if not IsJsonObject(JsonString) then RaiseParseError(JsonString); + if not IsJsonObject(JsonString) then + RaiseParseError(JsonString); S := Trim(Copy(JsonString, 2, Length(JsonString) - 2)); List := TStringList.Create; try @@ -1236,43 +1506,69 @@ procedure TJsonObject.Parse(JsonString: String); end; end; -function TJsonObject.Put(const Name: String; - const Value: Integer): TJsonValue; +function TJsonObject.Pretty(IdentLevel: Integer): string; +var + I: Integer; + Item: TJsonPair; + ItemList: string; +begin + if FList.Count = 0 then + begin + exit(Ident(IdentLevel) + '{}'); + end; + + // short single objects + if (FList.Count = 1) then + begin + Item := TJsonPair(FList[0]); + if not (Item.Value.FValueType in [jvArray, jvArray]) then + exit(Ident(IdentLevel) + '{ ' + Item.Pretty(-1) + ' }'); + end; + + Result := Ident(IdentLevel) + '{'#10; + ItemList := ''; + + for I := 0 to FList.Count - 1 do + begin + Item := TJsonPair(FList[I]); + if I > 0 then + ItemList := ItemList + ','#10; + ItemList := ItemList + Item.Pretty(IdentLevel + 1); + end; + Result := Result + ItemList + #10 + Ident(IdentLevel) + '}'; +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; +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; +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; +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; +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; +function TJsonObject.Put(const Name: string; const Value: TJsonValue): TJsonValue; begin Result := Add(Name).Value; Result.Assign(Value); @@ -1287,27 +1583,36 @@ function TJsonObject.Put(const Value: TJsonPair): TJsonValue; Result := Pair.Value; end; -function TJsonObject.Put(const Name: String; - const Value: TJsonObject): TJsonValue; +function TJsonObject.Put(const Name: string; const Value: array of const): TJsonValue; +begin + Result := Put(Name, empty); + Result.AsArray.Put(Value); +end; + +function TJsonObject.Put(const Name: string): TJsonValue; +begin + Result := put(Name, empty); +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; +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; +function TJsonObject.Put(const Name: string; const Value: TJsonArray): TJsonValue; begin Result := Add(Name).Value; Result.Assign(Value); end; -function TJsonObject.Stringify: String; +function TJsonObject.Stringify: string; var I: Integer; Item: TJsonPair; @@ -1316,7 +1621,8 @@ function TJsonObject.Stringify: String; for I := 0 to FList.Count - 1 do begin Item := TJsonPair(FList[I]); - if I > 0 then Result := Result + ','; + if I > 0 then + Result := Result + ','; Result := Result + Item.Stringify; end; Result := Result + '}'; @@ -1330,12 +1636,13 @@ procedure TJson.Assign(Source: TJsonBase); if Source is TJson then begin case (Source as TJson).FStructType of - jsNone: ; + jsNone: + ; jsArray: begin CreateArrayIfNone; FJsonArray.Assign((Source as TJson).FJsonArray); - end; + end; jsObject: begin CreateObjectIfNone; @@ -1365,9 +1672,11 @@ procedure TJson.Assign(Source: TJsonBase); CreateObjectIfNone; FJsonObject.Assign((Source as TJsonValue).AsObject); end - else RaiseAssignError(Source); + else + RaiseAssignError(Source); end - else RaiseAssignError(Source); + else + RaiseAssignError(Source); end; procedure TJson.CheckJsonArray; @@ -1385,7 +1694,8 @@ procedure TJson.CheckJsonObject; procedure TJson.Clear; begin case FStructType of - jsNone: ; + jsNone: + ; jsArray: begin FJsonArray.Free; @@ -1430,12 +1740,14 @@ 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); @@ -1447,17 +1759,27 @@ destructor TJson.Destroy; inherited Destroy; end; +function TJson.FixIdent(Data: string): string; +var + WrongIdent: string; +begin + WrongIdent := ':' + Ident(1); + Result := Data.Replace(WrongIdent, ': ', [rfReplaceAll]); +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; + 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]; @@ -1466,9 +1788,12 @@ function TJson.Get(const Name: String): TJsonValue; 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; @@ -1484,12 +1809,12 @@ function TJson.GetJsonObject: TJsonObject; 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); @@ -1503,7 +1828,21 @@ procedure TJson.Parse(JsonString: String); CreateObjectIfNone; FJsonObject.Parse(JsonString); end - else RaiseParseError(JsonString); + else + RaiseParseError(JsonString); +end; + +function TJson.Pretty(IdentLevel: Integer): string; +begin + case FStructType of + jsArray: + Result := FJsonArray.Pretty(IdentLevel + 1); + jsObject: + Result := FJsonObject.Pretty(IdentLevel + 1); + else + Result := ''; + end; + Result := FixIdent(Result); end; function TJson.Put(const Value: Integer): TJsonValue; @@ -1536,7 +1875,7 @@ function TJson.Put(const Value: TJsonNull): TJsonValue; 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); @@ -1560,39 +1899,37 @@ function TJson.Put(const Value: TJsonArray): TJsonValue; 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); 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); 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); 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); 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); @@ -1604,21 +1941,30 @@ function TJson.Put(const Value: TJsonPair): TJsonValue; Result := FJsonObject.Put(Value); end; -function TJson.Put(const Name: String; - const Value: TJsonObject): TJsonValue; +function TJson.Put(const Name: string; const Value: array of const): TJsonValue; +begin + CheckJsonObject; + Result := FJsonObject.Put(Name, Value); +end; + +function TJson.Put: TJsonValue; +begin + Result := Put(empty); +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; +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; +function TJson.Put(const Name: string; const Value: TJsonArray): TJsonValue; begin CheckJsonObject; Result := FJsonObject.Put(Name, Value); @@ -1628,44 +1974,57 @@ 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. + diff --git a/test/TestJson2.dpr b/test/TestJson2.dpr new file mode 100644 index 0000000..32d82fb --- /dev/null +++ b/test/TestJson2.dpr @@ -0,0 +1,48 @@ +program TestJson2; + +{$APPTYPE CONSOLE} + +uses + System.SysUtils, + Jsons in '..\src\Jsons.pas'; + +procedure RunTest; +var + Json: TJson; + Str: string; +begin + Json := TJson.Create; + + try + + Json.Put('null-field', null); + Json.Put('boolean-field-true', True); + + Json['boolean-field-false'].AsBoolean := not Json.Get('boolean-field-true').AsBoolean; + Json['number-field'].AsNumber := 3.1415926535; + Json['number-field-integer'].AsInteger := Json['number-field'].AsInteger; + Json['string-field'].AsString := 'Hello world'; + + Json.Put('array-field', [nil, False, True, 299792458, 2.7182818284, + 'The magic words are squeamish ossifrage', TJsonPair.New('array-object-field-1', + null), TJsonPair.New('array-object-field-2', 'json4delphi')]); + + with Json.Put('object-field', empty).AsObject do + begin + Put('object-field-1', True); + Put('object-field-2', 6.6260755e-34); + Put('object-field-3'); + end; + + Str := Json.Pretty; + Writeln(Str); + finally + Json.Free; + end; +end; + +begin + RunTest; + ReadLn; +end. + From 120eb7e50aae751ad7874c54697d748506460224 Mon Sep 17 00:00:00 2001 From: Maicon Fernando Date: Sat, 22 Aug 2020 11:35:52 -0300 Subject: [PATCH 5/5] Add TJsonArray new function - Add 'Foreatch' in TJsonArray; - Add TJsonArray export to TArray (filter invalid values) --- .gitignore | 6 ++- src/Jsons.pas | 112 +++++++++++++++++++++++++++++++++++++++++++++ test/TestJson2.dpr | 15 ++++++ 3 files changed, 132 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index b34c081..8a6a80f 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,10 @@ - +test/__recovery/ +test/__history/ +src/__recovery/ +src/__history/ *.dcu *.exe *.res *.identcache *.local +*.dproj \ No newline at end of file diff --git a/src/Jsons.pas b/src/Jsons.pas index 7715d8b..a7f3743 100644 --- a/src/Jsons.pas +++ b/src/Jsons.pas @@ -28,6 +28,8 @@ 202008 - Add - MaiconSoft - JsonArray.Put support multiples values at same time 202008 - Fix - MaiconSoft - Put without parameter will be 'empty' by default 202008 - Add - MaiconSoft - Add 'Pretty', stringify version for human read +202008 - Add - MaiconSoft - Add 'Foreatch' in TJsonArray +202008 - Add - MaiconSoft - Add TJsonArray export to TArray (filter invalid values) ****************************************************************************} @@ -161,6 +163,11 @@ TJsonArray = class(TJsonBase) TJsonArray; overload; procedure Delete(const Index: Integer); procedure Clear; + procedure Foreatch(func: TProc); + function AsInteger: TArray; + function AsString: TArray; + function AsBoolean: TArray; + function AsExtended: TArray; public property Count: Integer read GetCount; property Items[Index: Integer]: TJsonValue read GetItems; default; @@ -978,6 +985,78 @@ function TJsonArray.Add: TJsonValue; FList.Add(Result); end; +function TJsonArray.AsBoolean: TArray; +var + Acount: Integer; + buffer: TArray; +begin + if count = 0 then + exit; + + SetLength(buffer, count); + + Acount := 0; + Foreatch( + procedure(Index: integer; Item: TJsonValue) + begin + if Item.ValueType = jvBoolean then + begin + buffer[Acount] := Item.AsBoolean; + inc(Acount); + end; + end); + SetLength(buffer, Acount); + Result := buffer; +end; + +function TJsonArray.AsExtended: TArray; +var + Acount: Integer; + buffer: TArray; +begin + if count = 0 then + exit; + + SetLength(buffer, count); + + Acount := 0; + Foreatch( + procedure(Index: integer; Item: TJsonValue) + begin + if Item.ValueType = jvNumber then + begin + buffer[Acount] := Item.AsNumber; + inc(Acount); + end; + end); + SetLength(buffer, Acount); + Result := buffer; +end; + +function TJsonArray.AsInteger: TArray; +var + Acount: Integer; + buffer: TArray; +begin + if count = 0 then + exit; + + SetLength(buffer, count); + + Acount := 0; + Foreatch( + procedure(Index: integer; Item: TJsonValue) + begin + if Item.ValueType = jvNumber then + begin + buffer[Acount] := Item.AsInteger; + inc(Acount); + end; + end); + SetLength(buffer, Acount); + Result := buffer; +end; + procedure TJsonArray.Assign(Source: TJsonBase); var Src: TJsonArray; @@ -991,6 +1070,30 @@ procedure TJsonArray.Assign(Source: TJsonBase); Add.Assign(Src[I]); end; +function TJsonArray.AsString: TArray; +var + Acount: Integer; + buffer: TArray; +begin + if count = 0 then + exit; + + SetLength(buffer, count); + + Acount := 0; + Foreatch( + procedure(Index: integer; Item: TJsonValue) + begin + if Item.ValueType = jvString then + begin + buffer[Acount] := Item.Asstring; + inc(Acount); + end; + end); + SetLength(buffer, Acount); + Result := buffer; +end; + procedure TJsonArray.Clear; var I: Integer; @@ -1026,6 +1129,15 @@ destructor TJsonArray.Destroy; inherited; end; +procedure TJsonArray.Foreatch(func: TProc); +var + i: Integer; +begin + if Assigned(func) then + for i := 0 to FList.Count - 1 do + func(i, TJsonValue(FList[i])); +end; + function TJsonArray.GetCount: Integer; begin Result := FList.Count; diff --git a/test/TestJson2.dpr b/test/TestJson2.dpr index 32d82fb..ac5273b 100644 --- a/test/TestJson2.dpr +++ b/test/TestJson2.dpr @@ -27,6 +27,21 @@ begin 'The magic words are squeamish ossifrage', TJsonPair.New('array-object-field-1', null), TJsonPair.New('array-object-field-2', 'json4delphi')]); + Json['array-field'].AsArray.Foreatch( + procedure(Index: Integer; Item: TJsonValue) + begin + Writeln(Item.Stringify); + end); + + Writeln; + + for Str in Json['array-field'].AsArray.AsString do + begin + Writeln(Str); + end; + + Writeln; + with Json.Put('object-field', empty).AsObject do begin Put('object-field-1', True);