{ This file is part of the Free Component Library JSON Data structures Copyright (c) 2007 by Michael Van Canneyt michael@freepascal.org See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} {$mode objfpc} {$h+} unit fpjson; interface uses variants, SysUtils, classes, contnrs; type TJSONtype = (jtUnknown, jtNumber, jtString, jtBoolean, jtNull, jtArray, jtObject); TJSONInstanceType = (jitUnknown, jitNumberInteger,jitNumberInt64,jitNumberFloat, jitString, jitBoolean, jitNull, jitArray, jitObject); TJSONFloat = Double; TJSONStringType = AnsiString; TJSONCharType = AnsiChar; PJSONCharType = ^TJSONCharType; TFormatOption = (foSingleLineArray, // Array without CR/LF : all on one line foSingleLineObject, // Object without CR/LF : all on one line foDoNotQuoteMembers, // Do not quote object member names. foUseTabchar); // Use tab characters instead of spaces. TFormatOptions = set of TFormatOption; Const DefaultIndentSize = 2; DefaultFormat = []; AsJSONFormat = [foSingleLineArray,foSingleLineObject]; // These options make FormatJSON behave as AsJSON Type TJSONData = Class; { TMJBaseObjectEnumerator } TJSONEnum = Record Key : TJSONStringType; KeyNum : Integer; Value : TJSONData; end; TBaseJSONEnumerator = class public function GetCurrent: TJSONEnum; virtual; abstract; function MoveNext : Boolean; virtual; abstract; property Current: TJSONEnum read GetCurrent; end; { TMJObjectEnumerator } { TJSONData } TJSONData = class(TObject) protected Class Procedure DoError(Const Msg : String); Class Procedure DoError(Const Fmt : String; Args : Array of const); Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; virtual; function GetAsBoolean: Boolean; virtual; abstract; function GetAsFloat: TJSONFloat; virtual; abstract; function GetAsInteger: Integer; virtual; abstract; function GetAsInt64: Int64; virtual; abstract; function GetIsNull: Boolean; virtual; procedure SetAsBoolean(const AValue: Boolean); virtual; abstract; procedure SetAsFloat(const AValue: TJSONFloat); virtual; abstract; procedure SetAsInteger(const AValue: Integer); virtual; abstract; procedure SetAsInt64(const AValue: Int64); virtual; abstract; function GetAsJSON: TJSONStringType; virtual; abstract; function GetAsString: TJSONStringType; virtual; abstract; procedure SetAsString(const AValue: TJSONStringType); virtual; abstract; function GetValue: variant; virtual; abstract; procedure SetValue(const AValue: variant); virtual; abstract; function GetItem(Index : Integer): TJSONData; virtual; procedure SetItem(Index : Integer; const AValue: TJSONData); virtual; Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; virtual; function GetCount: Integer; virtual; public Constructor Create; virtual; Class function JSONType: TJSONType; virtual; Procedure Clear; virtual; Abstract; // Get enumerator function GetEnumerator: TBaseJSONEnumerator; virtual; Function FindPath(Const APath : TJSONStringType) : TJSONdata; Function GetPath(Const APath : TJSONStringType) : TJSONdata; Function Clone : TJSONData; virtual; abstract; Function FormatJSON(Options : TFormatOptions = DefaultFormat; Indentsize : Integer = DefaultIndentSize) : TJSONStringType; property Count: Integer read GetCount; property Items[Index: Integer]: TJSONData read GetItem write SetItem; property Value: variant read GetValue write SetValue; Property AsString : TJSONStringType Read GetAsString Write SetAsString; Property AsFloat : TJSONFloat Read GetAsFloat Write SetAsFloat; Property AsInteger : Integer Read GetAsInteger Write SetAsInteger; Property AsInt64 : Int64 Read GetAsInt64 Write SetAsInt64; Property AsBoolean : Boolean Read GetAsBoolean Write SetAsBoolean; Property IsNull : Boolean Read GetIsNull; Property AsJSON : TJSONStringType Read GetAsJSON; end; TJSONDataClass = Class of TJSONData; TJSONNumberType = (ntFloat,ntInteger,ntInt64); TJSONNumber = class(TJSONData) protected public class function JSONType: TJSONType; override; class function NumberType : TJSONNumberType; virtual; abstract; end; { TJSONFloatNumber } TJSONFloatNumber = class(TJSONNumber) Private FValue : TJSONFloat; protected function GetAsBoolean: Boolean; override; function GetAsFloat: TJSONFloat; override; function GetAsInteger: Integer; override; function GetAsInt64: Int64; override; procedure SetAsBoolean(const AValue: Boolean); override; procedure SetAsFloat(const AValue: TJSONFloat); override; procedure SetAsInteger(const AValue: Integer); override; procedure SetAsInt64(const AValue: Int64); override; function GetAsJSON: TJSONStringType; override; function GetAsString: TJSONStringType; override; procedure SetAsString(const AValue: TJSONStringType); override; function GetValue: variant; override; procedure SetValue(const AValue: variant); override; public Constructor Create(AValue : TJSONFloat); reintroduce; class function NumberType : TJSONNumberType; override; Procedure Clear; override; Function Clone : TJSONData; override; end; TJSONFloatNumberClass = Class of TJSONFloatNumber; { TJSONIntegerNumber } TJSONIntegerNumber = class(TJSONNumber) Private FValue : Integer; protected function GetAsBoolean: Boolean; override; function GetAsFloat: TJSONFloat; override; function GetAsInteger: Integer; override; function GetAsInt64: Int64; override; procedure SetAsBoolean(const AValue: Boolean); override; procedure SetAsFloat(const AValue: TJSONFloat); override; procedure SetAsInteger(const AValue: Integer); override; procedure SetAsInt64(const AValue: Int64); override; function GetAsJSON: TJSONStringType; override; function GetAsString: TJSONStringType; override; procedure SetAsString(const AValue: TJSONStringType); override; function GetValue: variant; override; procedure SetValue(const AValue: variant); override; public Constructor Create(AValue : Integer); reintroduce; class function NumberType : TJSONNumberType; override; Procedure Clear; override; Function Clone : TJSONData; override; end; TJSONIntegerNumberClass = Class of TJSONIntegerNumber; { TJSONInt64Number } TJSONInt64Number = class(TJSONNumber) Private FValue : Int64; protected function GetAsBoolean: Boolean; override; function GetAsFloat: TJSONFloat; override; function GetAsInteger: Integer; override; function GetAsInt64: Int64; override; procedure SetAsBoolean(const AValue: Boolean); override; procedure SetAsFloat(const AValue: TJSONFloat); override; procedure SetAsInteger(const AValue: Integer); override; procedure SetAsInt64(const AValue: Int64); override; function GetAsJSON: TJSONStringType; override; function GetAsString: TJSONStringType; override; procedure SetAsString(const AValue: TJSONStringType); override; function GetValue: variant; override; procedure SetValue(const AValue: variant); override; public Constructor Create(AValue : Int64); reintroduce; class function NumberType : TJSONNumberType; override; Procedure Clear; override; Function Clone : TJSONData; override; end; TJSONInt64NumberClass = Class of TJSONInt64Number; { TJSONString } TJSONString = class(TJSONData) Private FValue: TJSONStringType; protected function GetValue: Variant; override; procedure SetValue(const AValue: Variant); override; function GetAsBoolean: Boolean; override; function GetAsFloat: TJSONFloat; override; function GetAsInteger: Integer; override; function GetAsInt64: Int64; override; procedure SetAsBoolean(const AValue: Boolean); override; procedure SetAsFloat(const AValue: TJSONFloat); override; procedure SetAsInteger(const AValue: Integer); override; procedure SetAsInt64(const AValue: Int64); override; function GetAsJSON: TJSONStringType; override; function GetAsString: TJSONStringType; override; procedure SetAsString(const AValue: TJSONStringType); override; public Constructor Create(const AValue : TJSONStringType); reintroduce; class function JSONType: TJSONType; override; Procedure Clear; override; Function Clone : TJSONData; override; end; TJSONStringClass = Class of TJSONString; { TJSONboolean } TJSONBoolean = class(TJSONData) Private FValue: Boolean; protected function GetValue: Variant; override; procedure SetValue(const AValue: Variant); override; function GetAsBoolean: Boolean; override; function GetAsFloat: TJSONFloat; override; function GetAsInteger: Integer; override; function GetAsInt64: Int64; override; procedure SetAsBoolean(const AValue: Boolean); override; procedure SetAsFloat(const AValue: TJSONFloat); override; procedure SetAsInteger(const AValue: Integer); override; procedure SetAsInt64(const AValue: Int64); override; function GetAsJSON: TJSONStringType; override; function GetAsString: TJSONStringType; override; procedure SetAsString(const AValue: TJSONStringType); override; public Constructor Create(AValue : Boolean); reintroduce; class function JSONType: TJSONType; override; Procedure Clear; override; Function Clone : TJSONData; override; end; TJSONBooleanClass = Class of TJSONBoolean; { TJSONnull } TJSONNull = class(TJSONData) protected Procedure Converterror(From : Boolean); function GetAsBoolean: Boolean; override; function GetAsFloat: TJSONFloat; override; function GetAsInteger: Integer; override; function GetAsInt64: Int64; override; function GetIsNull: Boolean; override; procedure SetAsBoolean(const AValue: Boolean); override; procedure SetAsFloat(const AValue: TJSONFloat); override; procedure SetAsInteger(const AValue: Integer); override; procedure SetAsInt64(const AValue: Int64); override; function GetAsJSON: TJSONStringType; override; function GetAsString: TJSONStringType; override; procedure SetAsString(const AValue: TJSONStringType); override; function GetValue: variant; override; procedure SetValue(const AValue: variant); override; public class function JSONType: TJSONType; override; Procedure Clear; override; Function Clone : TJSONData; override; end; TJSONNullClass = Class of TJSONNull; TJSONArrayIterator = procedure(Item: TJSONData; Data: TObject; var Continue: Boolean) of object; { TJSONArray } TJSONObject = Class; TJSONArray = class(TJSONData) Private FList : TFPObjectList; function GetArrays(Index : Integer): TJSONArray; function GetBooleans(Index : Integer): Boolean; function GetFloats(Index : Integer): TJSONFloat; function GetIntegers(Index : Integer): Integer; function GetInt64s(Index : Integer): Int64; function GetNulls(Index : Integer): Boolean; function GetObjects(Index : Integer): TJSONObject; function GetStrings(Index : Integer): TJSONStringType; function GetTypes(Index : Integer): TJSONType; procedure SetArrays(Index : Integer; const AValue: TJSONArray); procedure SetBooleans(Index : Integer; const AValue: Boolean); procedure SetFloats(Index : Integer; const AValue: TJSONFloat); procedure SetIntegers(Index : Integer; const AValue: Integer); procedure SetInt64s(Index : Integer; const AValue: Int64); procedure SetObjects(Index : Integer; const AValue: TJSONObject); procedure SetStrings(Index : Integer; const AValue: TJSONStringType); protected Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; override; Procedure Converterror(From : Boolean); function GetAsBoolean: Boolean; override; function GetAsFloat: TJSONFloat; override; function GetAsInteger: Integer; override; function GetAsInt64: Int64; override; procedure SetAsBoolean(const AValue: Boolean); override; procedure SetAsFloat(const AValue: TJSONFloat); override; procedure SetAsInteger(const AValue: Integer); override; procedure SetAsInt64(const AValue: Int64); override; function GetAsJSON: TJSONStringType; override; function GetAsString: TJSONStringType; override; procedure SetAsString(const AValue: TJSONStringType); override; function GetValue: variant; override; procedure SetValue(const AValue: variant); override; function GetCount: Integer; override; function GetItem(Index : Integer): TJSONData; override; procedure SetItem(Index : Integer; const AValue: TJSONData); override; Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; override; public Constructor Create; overload; reintroduce; Constructor Create(const Elements : Array of Const); overload; Destructor Destroy; override; class function JSONType: TJSONType; override; Function Clone : TJSONData; override; // Examine procedure Iterate(Iterator : TJSONArrayIterator; Data: TObject); function IndexOf(obj: TJSONData): Integer; function GetEnumerator: TBaseJSONEnumerator; override; // Manipulate Procedure Clear; override; function Add(Item : TJSONData): Integer; function Add(I : Integer): Integer; function Add(I : Int64): Int64; function Add(const S : String): Integer; function Add: Integer; function Add(F : TJSONFloat): Integer; function Add(B : Boolean): Integer; function Add(AnArray : TJSONArray): Integer; function Add(AnObject: TJSONObject): Integer; Procedure Delete(Index : Integer); procedure Exchange(Index1, Index2: Integer); function Extract(Item: TJSONData): TJSONData; function Extract(Index : Integer): TJSONData; procedure Insert(Index: Integer); procedure Insert(Index: Integer; Item : TJSONData); procedure Insert(Index: Integer; I : Integer); procedure Insert(Index: Integer; I : Int64); procedure Insert(Index: Integer; const S : String); procedure Insert(Index: Integer; F : TJSONFloat); procedure Insert(Index: Integer; B : Boolean); procedure Insert(Index: Integer; AnArray : TJSONArray); procedure Insert(Index: Integer; AnObject: TJSONObject); procedure Move(CurIndex, NewIndex: Integer); Procedure Remove(Item : TJSONData); // Easy Access Properties. property Items;default; Property Types[Index : Integer] : TJSONType Read GetTypes; Property Nulls[Index : Integer] : Boolean Read GetNulls; Property Integers[Index : Integer] : Integer Read GetIntegers Write SetIntegers; Property Int64s[Index : Integer] : Int64 Read GetInt64s Write SetInt64s; Property Strings[Index : Integer] : TJSONStringType Read GetStrings Write SetStrings; Property Floats[Index : Integer] : TJSONFloat Read GetFloats Write SetFloats; Property Booleans[Index : Integer] : Boolean Read GetBooleans Write SetBooleans; Property Arrays[Index : Integer] : TJSONArray Read GetArrays Write SetArrays; Property Objects[Index : Integer] : TJSONObject Read GetObjects Write SetObjects; end; TJSONArrayClass = Class of TJSONArray; TJSONObjectIterator = procedure(Const AName : TJSONStringType; Item: TJSONData; Data: TObject; var Continue: Boolean) of object; { TJSONObject } TJSONObject = class(TJSONData) private FHash : TFPHashObjectList; // Careful : Names limited to 255 chars. function GetArrays(const AName : String): TJSONArray; function GetBooleans(const AName : String): Boolean; function GetElements(const AName: string): TJSONData; function GetFloats(const AName : String): TJSONFloat; function GetIntegers(const AName : String): Integer; function GetInt64s(const AName : String): Int64; function GetIsNull(const AName : String): Boolean; reintroduce; function GetNameOf(Index : Integer): TJSONStringType; function GetObjects(const AName : String): TJSONObject; function GetStrings(const AName : String): TJSONStringType; function GetTypes(const AName : String): TJSONType; procedure SetArrays(const AName : String; const AValue: TJSONArray); procedure SetBooleans(const AName : String; const AValue: Boolean); procedure SetElements(const AName: string; const AValue: TJSONData); procedure SetFloats(const AName : String; const AValue: TJSONFloat); procedure SetIntegers(const AName : String; const AValue: Integer); procedure SetInt64s(const AName : String; const AValue: Int64); procedure SetIsNull(const AName : String; const AValue: Boolean); procedure SetObjects(const AName : String; const AValue: TJSONObject); procedure SetStrings(const AName : String; const AValue: TJSONStringType); protected Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; override; Procedure Converterror(From : Boolean); function GetAsBoolean: Boolean; override; function GetAsFloat: TJSONFloat; override; function GetAsInteger: Integer; override; function GetAsInt64: Int64; override; procedure SetAsBoolean(const AValue: Boolean); override; procedure SetAsFloat(const AValue: TJSONFloat); override; procedure SetAsInteger(const AValue: Integer); override; procedure SetAsInt64(const AValue: Int64); override; function GetAsJSON: TJSONStringType; override; function GetAsString: TJSONStringType; override; procedure SetAsString(const AValue: TJSONStringType); override; function GetValue: variant; override; procedure SetValue(const AValue: variant); override; function GetCount: Integer; override; function GetItem(Index : Integer): TJSONData; override; procedure SetItem(Index : Integer; const AValue: TJSONData); override; Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; override; public constructor Create; reintroduce; Constructor Create(const Elements : Array of Const); overload; destructor Destroy; override; class function JSONType: TJSONType; override; Function Clone : TJSONData; override; function GetEnumerator: TBaseJSONEnumerator; override; // Examine procedure Iterate(Iterator : TJSONObjectIterator; Data: TObject); function IndexOf(Item: TJSONData): Integer; Function IndexOfName(const AName: TJSONStringType; CaseInsensitive : Boolean = False): Integer; Function Find(Const AName : String) : TJSONData; overload; Function Find(Const AName : String; AType : TJSONType) : TJSONData; overload; Function Get(Const AName : String) : Variant; Function Get(Const AName : String; ADefault : TJSONFloat) : TJSONFloat; Function Get(Const AName : String; ADefault : Integer) : Integer; Function Get(Const AName : String; ADefault : Int64) : Int64; Function Get(Const AName : String; ADefault : Boolean) : Boolean; Function Get(Const AName : String; ADefault : TJSONStringType) : TJSONStringTYpe; Function Get(Const AName : String; ADefault : TJSONArray) : TJSONArray; Function Get(Const AName : String; ADefault : TJSONObject) : TJSONObject; // Manipulate Procedure Clear; override; function Add(const AName: TJSONStringType; AValue: TJSONData): Integer; overload; function Add(const AName: TJSONStringType; AValue: Boolean): Integer; overload; function Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer; overload; function Add(const AName, AValue: TJSONStringType): Integer; overload; function Add(const AName: TJSONStringType; Avalue: Integer): Integer; overload; function Add(const AName: TJSONStringType; Avalue: Int64): Integer; overload; function Add(const AName: TJSONStringType): Integer; overload; function Add(const AName: TJSONStringType; AValue : TJSONArray): Integer; overload; procedure Delete(Index : Integer); procedure Delete(Const AName : string); procedure Remove(Item : TJSONData); Function Extract(Index : Integer) : TJSONData; Function Extract(Const AName : string) : TJSONData; // Easy access properties. property Names[Index : Integer] : TJSONStringType read GetNameOf; property Elements[AName: string] : TJSONData read GetElements write SetElements; default; Property Types[AName : String] : TJSONType Read GetTypes; Property Nulls[AName : String] : Boolean Read GetIsNull Write SetIsNull; Property Floats[AName : String] : TJSONFloat Read GetFloats Write SetFloats; Property Integers[AName : String] : Integer Read GetIntegers Write SetIntegers; Property Int64s[AName : String] : Int64 Read GetInt64s Write SetInt64s; Property Strings[AName : String] : TJSONStringType Read GetStrings Write SetStrings; Property Booleans[AName : String] : Boolean Read GetBooleans Write SetBooleans; Property Arrays[AName : String] : TJSONArray Read GetArrays Write SetArrays; Property Objects[AName : String] : TJSONObject Read GetObjects Write SetObjects; end; TJSONObjectClass = Class of TJSONObject; EJSON = Class(Exception); TJSONParserHandler = Procedure(AStream : TStream; Const AUseUTF8 : Boolean; Out Data : TJSONData); Procedure SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass); Function GetJSONInstanceType(AType : TJSONInstanceType) : TJSONDataClass; Function StringToJSONString(const S : TJSONStringType) : TJSONStringType; Function JSONStringToString(const S : TJSONStringType) : TJSONStringType; Function JSONTypeName(JSONType : TJSONType) : String; // These functions create JSONData structures, taking into account the instance types Function CreateJSON : TJSONNull; Function CreateJSON(Data : Boolean) : TJSONBoolean; Function CreateJSON(Data : Integer) : TJSONIntegerNumber; Function CreateJSON(Data : Int64) : TJSONInt64Number; Function CreateJSON(Data : TJSONFloat) : TJSONFloatNumber; Function CreateJSON(Data : TJSONStringType) : TJSONString; Function CreateJSONArray(Data : Array of const) : TJSONArray; Function CreateJSONObject(Data : Array of const) : TJSONObject; // These functions rely on a callback. If the callback is not set, they will raise an error. // When the jsonparser unit is included in the project, the callback is automatically set. Function GetJSON(Const JSON : TJSONStringType; Const UseUTF8 : Boolean = True) : TJSONData; Function GetJSON(Const JSON : TStream; Const UseUTF8 : Boolean = True) : TJSONData; Procedure SetJSONParserHandler(AHandler : TJSONParserHandler); Function GetJSONParserHandler : TJSONParserHandler; implementation Uses typinfo; Resourcestring SErrCannotConvertFromNull = 'Cannot convert data from Null value'; SErrCannotConvertToNull = 'Cannot convert data to Null value'; SErrCannotConvertFromArray = 'Cannot convert data from array value'; SErrCannotConvertToArray = 'Cannot convert data to array value'; SErrCannotConvertFromObject = 'Cannot convert data from object value'; SErrCannotConvertToObject = 'Cannot convert data to object value'; SErrInvalidFloat = 'Invalid float value : %s'; SErrInvalidInteger = 'Invalid float value : %s'; SErrCannotSetNotIsNull = 'IsNull cannot be set to False'; SErrCannotAddArrayTwice = 'Adding an array object to an array twice is not allowed'; SErrCannotAddObjectTwice = 'Adding an object to an array twice is not allowed'; SErrUnknownTypeInConstructor = 'Unknown type in JSON%s constructor: %d'; SErrNotJSONData = 'Cannot add object of type %s to TJSON%s'; SErrPointerNotNil = 'Cannot add non-nil pointer to JSON%s'; SErrOddNumber = 'TJSONObject must be constructed with name,value pairs'; SErrNameMustBeString = 'TJSONObject constructor element name at pos %d is not a string'; SErrNonexistentElement = 'Unknown object member: "%s"'; SErrPathElementNotFound = 'Path "%s" invalid: element "%s" not found.'; SErrWrongInstanceClass = 'Cannot set instance class: %s does not descend from %s.'; SErrNoParserHandler = 'No JSON parser handler installed. Recompile your project with the jsonparser unit included'; Var DefaultJSONInstanceTypes : Array [TJSONInstanceType] of TJSONDataClass = (TJSONData, TJSONIntegerNumber, TJSONInt64Number,TJSONFloatNumber, TJSONString, TJSONBoolean, TJSONNull, TJSONArray, TJSONObject); Const MinJSONInstanceTypes : Array [TJSONInstanceType] of TJSONDataClass = (TJSONData, TJSONIntegerNumber, TJSONInt64Number,TJSONFloatNumber, TJSONString, TJSONBoolean, TJSONNull, TJSONArray, TJSONObject); procedure SetJSONInstanceType(AType: TJSONInstanceType; AClass: TJSONDataClass); begin if AClass=Nil then TJSONData.DoError(SErrWrongInstanceClass,['Nil',MinJSONINstanceTypes[AType].ClassName]); if Not AClass.InheritsFrom(MinJSONINstanceTypes[AType]) then TJSONData.DoError(SErrWrongInstanceClass,[AClass.ClassName,MinJSONINstanceTypes[AType].ClassName]); DefaultJSONINstanceTypes[AType]:=AClass; end; function GetJSONInstanceType(AType: TJSONInstanceType): TJSONDataClass; begin Result:=DefaultJSONInstanceTypes[AType] end; Function StringToJSONString(const S : TJSONStringType) : TJSONStringType; Var I,J,L : Integer; P : PJSONCharType; begin I:=1; J:=1; Result:=''; L:=Length(S); P:=PJSONCharType(S); While I<=L do begin if (AnsiChar(P^) in ['"','/','\',#8,#9,#10,#12,#13]) then begin Result:=Result+Copy(S,J,I-J); Case P^ of '\' : Result:=Result+'\\'; '/' : Result:=Result+'\/'; '"' : Result:=Result+'\"'; #8 : Result:=Result+'\b'; #9 : Result:=Result+'\t'; #10 : Result:=Result+'\n'; #12 : Result:=Result+'\f'; #13 : Result:=Result+'\r'; end; J:=I+1; end; Inc(I); Inc(P); end; Result:=Result+Copy(S,J,I-1); end; Function JSONStringToString(const S : TJSONStringType) : TJSONStringType; Var I,J,L : Integer; P : PJSONCharType; w : String; begin I:=1; J:=1; L:=Length(S); Result:=''; P:=PJSONCharType(S); While (I<=L) do begin if (P^='\') then begin Result:=Result+Copy(S,J,I-J); Inc(P); If (P^<>#0) then begin Inc(I); Case AnsiChar(P^) of '\','"','/' : Result:=Result+P^; 'b' : Result:=Result+#8; 't' : Result:=Result+#9; 'n' : Result:=Result+#10; 'f' : Result:=Result+#12; 'r' : Result:=Result+#13; 'u' : begin W:=Copy(S,I+1,4); Inc(I,4); Inc(P,4); Result:=Result+WideChar(StrToInt('$'+W)); end; end; end; J:=I+1; end; Inc(I); Inc(P); end; Result:=Result+Copy(S,J,I-J+1); end; function JSONTypeName(JSONType: TJSONType): String; begin Result:=GetEnumName(TypeInfo(TJSONType),Ord(JSONType)); end; function CreateJSON: TJSONNull; begin Result:=TJSONNullClass(DefaultJSONInstanceTypes[jitNull]).Create end; function CreateJSON(Data: Boolean): TJSONBoolean; begin Result:=TJSONBooleanClass(DefaultJSONInstanceTypes[jitBoolean]).Create(Data); end; function CreateJSON(Data: Integer): TJSONIntegerNumber; begin Result:=TJSONIntegerNumberCLass(DefaultJSONInstanceTypes[jitNumberInteger]).Create(Data); end; function CreateJSON(Data: Int64): TJSONInt64Number; begin Result:=TJSONInt64NumberCLass(DefaultJSONInstanceTypes[jitNumberInt64]).Create(Data); end; function CreateJSON(Data: TJSONFloat): TJSONFloatNumber; begin Result:=TJSONFloatNumberCLass(DefaultJSONInstanceTypes[jitNumberFloat]).Create(Data); end; function CreateJSON(Data: TJSONStringType): TJSONString; begin Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data); end; function CreateJSONArray(Data: array of const): TJSONArray; begin Result:=TJSONArrayCLass(DefaultJSONInstanceTypes[jitArray]).Create(Data); end; function CreateJSONObject(Data: array of const): TJSONObject; begin Result:=TJSONObjectCLass(DefaultJSONInstanceTypes[jitObject]).Create(Data); end; Var JPH : TJSONParserHandler; function GetJSON(const JSON: TJSONStringType; Const UseUTF8: Boolean): TJSONData; Var SS : TStringStream; begin SS:=TStringStream.Create(JSON); try Result:=GetJSON(SS,UseUTF8); finally SS.Free; end; end; function GetJSON(Const JSON: TStream; Const UseUTF8: Boolean): TJSONData; begin Result:=Nil; If (JPH=Nil) then TJSONData.DoError(SErrNoParserHandler); JPH(JSON,UseUTF8,Result); end; procedure SetJSONParserHandler(AHandler: TJSONParserHandler); begin JPH:=AHandler; end; function GetJSONParserHandler: TJSONParserHandler; begin Result:=JPH; end; Type { TJSONEnumerator } TJSONEnumerator = class(TBaseJSONEnumerator) Private FData : TJSONData; public Constructor Create(AData : TJSONData); function GetCurrent: TJSONEnum; override; function MoveNext : Boolean; override; end; { TJSONArrayEnumerator } TJSONArrayEnumerator = class(TBaseJSONEnumerator) Private FData : TJSONArray; FCurrent : Integer; public Constructor Create(AData : TJSONArray); function GetCurrent: TJSONEnum; override; function MoveNext : Boolean; override; end; { TJSONObjectEnumerator } TJSONObjectEnumerator = class(TBaseJSONEnumerator) Private FData : TJSONObject; FCurrent : Integer; public Constructor Create(AData : TJSONObject); function GetCurrent: TJSONEnum; override; function MoveNext : Boolean; override; end; constructor TJSONObjectEnumerator.Create(AData: TJSONObject); begin FData:=AData; FCurrent:=-1; end; function TJSONObjectEnumerator.GetCurrent: TJSONEnum; begin Result.KeyNum:=FCurrent; Result.Key:=FData.Names[FCurrent]; Result.Value:=FData.Items[FCurrent]; end; function TJSONObjectEnumerator.MoveNext: Boolean; begin Inc(FCurrent); Result:=FCurrentNil; end; { TJSONData } function TJSONData.GetItem(Index : Integer): TJSONData; begin Result:=nil; end; function TJSONData.GetCount: Integer; begin Result:=0; end; constructor TJSONData.Create; begin Clear; end; class procedure TJSONData.DoError(const Msg: String); begin Raise EJSON.Create(Msg); end; class procedure TJSONData.DoError(const Fmt: String; Args: array of const); begin Raise EJSON.CreateFmt(Fmt,Args); end; function TJSONData.DoFindPath(const APath: TJSONStringType; out NotFound: TJSONStringType): TJSONdata; begin If APath<>'' then begin NotFound:=APath; Result:=Nil; end else Result:=Self; end; function TJSONData.GetIsNull: Boolean; begin Result:=False; end; class function TJSONData.JSONType: TJSONType; begin JSONType:=jtUnknown; end; function TJSONData.GetEnumerator: TBaseJSONEnumerator; begin Result:=TJSONEnumerator.Create(Self); end; function TJSONData.FindPath(const APath: TJSONStringType): TJSONdata; Var M : String; begin Result:=DoFindPath(APath,M); end; function TJSONData.GetPath(const APath: TJSONStringType): TJSONdata; Var M : String; begin Result:=DoFindPath(APath,M); If Result=Nil then DoError(SErrPathElementNotFound,[APath,M]); end; procedure TJSONData.SetItem(Index : Integer; const AValue: TJSONData); begin // Do Nothing end; function TJSONData.FormatJSON(Options: TFormatOptions; Indentsize: Integer ): TJSONStringType; begin Result:=DoFormatJSON(Options,0,IndentSize); end; function TJSONData.DoFormatJSON(Options: TFormatOptions; CurrentIndent, Indent: Integer): TJSONStringType; begin Result:=AsJSON; end; { TJSONnumber } class function TJSONnumber.JSONType: TJSONType; begin Result:=jtNumber; end; { TJSONstring } class function TJSONstring.JSONType: TJSONType; begin Result:=jtString; end; procedure TJSONString.Clear; begin FValue:=''; end; function TJSONString.Clone: TJSONData; begin Result:=TJSONStringClass(ClassType).Create(Self.FValue); end; function TJSONstring.GetValue: Variant; begin Result:=FValue; end; procedure TJSONstring.SetValue(const AValue: Variant); begin FValue:=AValue; end; function TJSONstring.GetAsBoolean: Boolean; begin Result:=StrToBool(FValue); end; function TJSONstring.GetAsFloat: TJSONFloat; Var C : Integer; begin Val(FValue,Result,C); If (C<>0) then If Not TryStrToFloat(FValue,Result) then Raise EConvertError.CreateFmt(SErrInvalidFloat,[FValue]); end; function TJSONstring.GetAsInteger: Integer; begin Result:=StrToInt(FValue); end; function TJSONstring.GetAsInt64: Int64; begin Result:=StrToInt64(FValue); end; procedure TJSONstring.SetAsBoolean(const AValue: Boolean); begin FValue:=BoolToStr(AValue); end; procedure TJSONstring.SetAsFloat(const AValue: TJSONFloat); begin FValue:=FloatToStr(AValue); end; procedure TJSONstring.SetAsInteger(const AValue: Integer); begin FValue:=IntToStr(AValue); end; procedure TJSONstring.SetAsInt64(const AValue: Int64); begin FValue:=IntToStr(AValue); end; function TJSONstring.GetAsJSON: TJSONStringType; begin Result:='"'+StringToJSONString(FValue)+'"'; end; function TJSONstring.GetAsString: TJSONStringType; begin Result:=FValue; end; procedure TJSONstring.SetAsString(const AValue: TJSONStringType); begin FValue:=AValue; end; constructor TJSONstring.Create(const AValue: TJSONStringType); begin FValue:=AValue; end; { TJSONboolean } function TJSONboolean.GetValue: Variant; begin Result:=FValue; end; class function TJSONboolean.JSONType: TJSONType; begin Result:=jtBoolean; end; procedure TJSONBoolean.Clear; begin FValue:=False; end; function TJSONBoolean.Clone: TJSONData; begin Result:=TJSONBooleanClass(Self.ClassType).Create(Self.Fvalue); end; procedure TJSONboolean.SetValue(const AValue: Variant); begin FValue:=boolean(AValue); end; function TJSONboolean.GetAsBoolean: Boolean; begin Result:=FValue; end; function TJSONboolean.GetAsFloat: TJSONFloat; begin Result:=Ord(FValue); end; function TJSONboolean.GetAsInteger: Integer; begin Result:=Ord(FValue); end; function TJSONboolean.GetAsInt64: Int64; begin Result:=Ord(FValue); end; procedure TJSONboolean.SetAsBoolean(const AValue: Boolean); begin FValue:=AValue; end; procedure TJSONboolean.SetAsFloat(const AValue: TJSONFloat); begin FValue:=(AValue<>0) end; procedure TJSONboolean.SetAsInteger(const AValue: Integer); begin FValue:=(AValue<>0) end; procedure TJSONboolean.SetAsInt64(const AValue: Int64); begin FValue:=(AValue<>0) end; function TJSONboolean.GetAsJSON: TJSONStringType; begin If FValue then Result:='true' else Result:='false'; end; function TJSONboolean.GetAsString: TJSONStringType; begin Result:=BoolToStr(FValue, True); end; procedure TJSONboolean.SetAsString(const AValue: TJSONStringType); begin FValue:=StrToBool(AValue); end; constructor TJSONboolean.Create(AValue: Boolean); begin FValue:=AValue; end; { TJSONnull } procedure TJSONnull.Converterror(From : Boolean); begin If From then DoError(SErrCannotConvertFromNull) else DoError(SErrCannotConvertToNull); end; {$warnings off} function TJSONnull.GetAsBoolean: Boolean; begin ConvertError(True); end; function TJSONnull.GetAsFloat: TJSONFloat; begin ConvertError(True); end; function TJSONnull.GetAsInteger: Integer; begin ConvertError(True); end; function TJSONnull.GetAsInt64: Int64; begin ConvertError(True); end; function TJSONnull.GetIsNull: Boolean; begin Result:=True; end; procedure TJSONnull.SetAsBoolean(const AValue: Boolean); begin ConvertError(False); end; procedure TJSONnull.SetAsFloat(const AValue: TJSONFloat); begin ConvertError(False); end; procedure TJSONnull.SetAsInteger(const AValue: Integer); begin ConvertError(False); end; procedure TJSONnull.SetAsInt64(const AValue: Int64); begin ConvertError(False); end; function TJSONnull.GetAsJSON: TJSONStringType; begin Result:='null'; end; function TJSONnull.GetAsString: TJSONStringType; begin ConvertError(True); end; procedure TJSONnull.SetAsString(const AValue: TJSONStringType); begin ConvertError(True); end; function TJSONnull.GetValue: Variant; begin Result:=variants.Null; end; procedure TJSONnull.SetValue(const AValue: variant); begin ConvertError(False); end; class function TJSONnull.JSONType: TJSONType; begin Result:=jtNull; end; procedure TJSONNull.Clear; begin // Do nothing end; function TJSONNull.Clone: TJSONData; begin Result:=TJSONNullClass(Self.ClassType).Create; end; {$warnings on} { TJSONFloatNumber } function TJSONFloatNumber.GetAsBoolean: Boolean; begin Result:=(FValue<>0); end; function TJSONFloatNumber.GetAsFloat: TJSONFloat; begin Result:=FValue; end; function TJSONFloatNumber.GetAsInteger: Integer; begin Result:=Round(FValue); end; function TJSONFloatNumber.GetAsInt64: Int64; begin Result:=Round(FValue); end; procedure TJSONFloatNumber.SetAsBoolean(const AValue: Boolean); begin FValue:=Ord(AValue); end; procedure TJSONFloatNumber.SetAsFloat(const AValue: TJSONFloat); begin FValue:=AValue; end; procedure TJSONFloatNumber.SetAsInteger(const AValue: Integer); begin FValue:=AValue; end; procedure TJSONFloatNumber.SetAsInt64(const AValue: Int64); begin FValue:=AValue; end; function TJSONFloatNumber.GetAsJSON: TJSONStringType; begin Result:=AsString; end; function TJSONFloatNumber.GetAsString: TJSONStringType; begin Str(FValue,Result); // Str produces a ' ' in front where the - can go. if (Result<>'') and (Result[1]=' ') then Delete(Result,1,1); end; procedure TJSONFloatNumber.SetAsString(const AValue: TJSONStringType); Var C : Integer; begin Val(AValue,FValue,C); If (C<>0) then Raise EConvertError.CreateFmt(SErrInvalidFloat,[AValue]); end; function TJSONFloatNumber.GetValue: variant; begin Result:=FValue; end; procedure TJSONFloatNumber.SetValue(const AValue: variant); begin FValue:=AValue; end; constructor TJSONFloatNumber.Create(AValue: TJSONFloat); begin FValue:=AValue; end; class function TJSONFloatNumber.NumberType: TJSONNumberType; begin Result:=ntFloat; end; procedure TJSONFloatNumber.Clear; begin FValue:=0; end; function TJSONFloatNumber.Clone: TJSONData; begin Result:=TJSONFloatNumberClass(ClassType).Create(Self.FValue); end; { TJSONIntegerNumber } function TJSONIntegerNumber.GetAsBoolean: Boolean; begin Result:=FValue<>0; end; function TJSONIntegerNumber.GetAsFloat: TJSONFloat; begin Result:=Ord(FValue); end; function TJSONIntegerNumber.GetAsInteger: Integer; begin Result:=FValue; end; function TJSONIntegerNumber.GetAsInt64: Int64; begin Result:=FValue; end; procedure TJSONIntegerNumber.SetAsBoolean(const AValue: Boolean); begin FValue:=Ord(AValue); end; procedure TJSONIntegerNumber.SetAsFloat(const AValue: TJSONFloat); begin FValue:=Round(AValue); end; procedure TJSONIntegerNumber.SetAsInteger(const AValue: Integer); begin FValue:=AValue; end; procedure TJSONIntegerNumber.SetAsInt64(const AValue: Int64); begin FValue:=AValue; end; function TJSONIntegerNumber.GetAsJSON: TJSONStringType; begin Result:=AsString; end; function TJSONIntegerNumber.GetAsString: TJSONStringType; begin Result:=IntToStr(FValue) end; procedure TJSONIntegerNumber.SetAsString(const AValue: TJSONStringType); begin FValue:=StrToInt(AValue); end; function TJSONIntegerNumber.GetValue: variant; begin Result:=FValue; end; procedure TJSONIntegerNumber.SetValue(const AValue: variant); begin FValue:=AValue; end; constructor TJSONIntegerNumber.Create(AValue: Integer); begin FValue:=AValue; end; class function TJSONIntegerNumber.NumberType: TJSONNumberType; begin Result:=ntInteger; end; procedure TJSONIntegerNumber.Clear; begin FValue:=0; end; function TJSONIntegerNumber.Clone: TJSONData; begin Result:=TJSONIntegerNumberClass(ClassType).Create(Self.FValue); end; { TJSONInt64Number } function TJSONInt64Number.GetAsInt64: Int64; begin Result := FValue; end; procedure TJSONInt64Number.SetAsInt64(const AValue: Int64); begin FValue := AValue; end; function TJSONInt64Number.GetAsBoolean: Boolean; begin Result:=FValue<>0; end; function TJSONInt64Number.GetAsFloat: TJSONFloat; begin Result:= FValue; end; function TJSONInt64Number.GetAsInteger: Integer; begin Result := FValue; end; procedure TJSONInt64Number.SetAsBoolean(const AValue: Boolean); begin FValue:=Ord(AValue); end; procedure TJSONInt64Number.SetAsFloat(const AValue: TJSONFloat); begin FValue:=Round(AValue); end; procedure TJSONInt64Number.SetAsInteger(const AValue: Integer); begin FValue:=AValue; end; function TJSONInt64Number.GetAsJSON: TJSONStringType; begin Result:=AsString; end; function TJSONInt64Number.GetAsString: TJSONStringType; begin Result:=IntToStr(FValue) end; procedure TJSONInt64Number.SetAsString(const AValue: TJSONStringType); begin FValue:=StrToInt64(AValue); end; function TJSONInt64Number.GetValue: variant; begin Result:=FValue; end; procedure TJSONInt64Number.SetValue(const AValue: variant); begin FValue:=AValue; end; constructor TJSONInt64Number.Create(AValue: Int64); begin FValue := AValue; end; class function TJSONInt64Number.NumberType: TJSONNumberType; begin Result:=ntInt64; end; procedure TJSONInt64Number.Clear; begin FValue:=0; end; function TJSONInt64Number.Clone: TJSONData; begin Result:=TJSONInt64NumberClass(ClassType).Create(Self.FValue); end; { TJSONArray } function TJSONArray.GetBooleans(Index : Integer): Boolean; begin Result:=Items[Index].AsBoolean; end; function TJSONArray.GetArrays(Index : Integer): TJSONArray; begin Result:=Items[Index] as TJSONArray; end; function TJSONArray.GetFloats(Index : Integer): TJSONFloat; begin Result:=Items[Index].AsFloat; end; function TJSONArray.GetIntegers(Index : Integer): Integer; begin Result:=Items[Index].AsInteger; end; function TJSONArray.GetInt64s(Index : Integer): Int64; begin Result:=Items[Index].AsInt64; end; function TJSONArray.GetNulls(Index : Integer): Boolean; begin Result:=Items[Index].IsNull; end; function TJSONArray.GetObjects(Index : Integer): TJSONObject; begin Result:=Items[Index] as TJSONObject; end; function TJSONArray.GetStrings(Index : Integer): TJSONStringType; begin Result:=Items[Index].AsString; end; function TJSONArray.GetTypes(Index : Integer): TJSONType; begin Result:=Items[Index].JSONType; end; procedure TJSONArray.SetArrays(Index : Integer; const AValue: TJSONArray); begin Items[Index]:=AValue; end; procedure TJSONArray.SetBooleans(Index : Integer; const AValue: Boolean); begin Items[Index]:=CreateJSON(AValue); end; procedure TJSONArray.SetFloats(Index : Integer; const AValue: TJSONFloat); begin Items[Index]:=CreateJSON(AValue); end; procedure TJSONArray.SetIntegers(Index : Integer; const AValue: Integer); begin Items[Index]:=CreateJSON(AValue); end; procedure TJSONArray.SetInt64s(Index : Integer; const AValue: Int64); begin Items[Index]:=CreateJSON(AValue); end; procedure TJSONArray.SetObjects(Index : Integer; const AValue: TJSONObject); begin Items[Index]:=AValue; end; procedure TJSONArray.SetStrings(Index : Integer; const AValue: TJSONStringType); begin Items[Index]:=CreateJSON(AValue); end; function TJSONArray.DoFindPath(const APath: TJSONStringType; out NotFound: TJSONStringType): TJSONdata; Var P,I : integer; E : String; begin if (APath<>'') and (APath[1]='[') then begin P:=Pos(']',APath); I:=-1; If (P>2) then I:=StrToIntDef(Copy(APath,2,P-2),-1); If (I>=0) and (I0) then NotFound:=Copy(APath,1,P) else NotFound:=APath; end; end else Result:=inherited DoFindPath(APath, NotFound); end; procedure TJSONArray.Converterror(From: Boolean); begin If From then DoError(SErrCannotConvertFromArray) else DoError(SErrCannotConvertToArray); end; {$warnings off} function TJSONArray.GetAsBoolean: Boolean; begin ConvertError(True); end; function TJSONArray.GetAsFloat: TJSONFloat; begin ConvertError(True); end; function TJSONArray.GetAsInteger: Integer; begin ConvertError(True); end; function TJSONArray.GetAsInt64: Int64; begin ConvertError(True); end; procedure TJSONArray.SetAsBoolean(const AValue: Boolean); begin ConvertError(False); end; procedure TJSONArray.SetAsFloat(const AValue: TJSONFloat); begin ConvertError(False); end; procedure TJSONArray.SetAsInteger(const AValue: Integer); begin ConvertError(False); end; procedure TJSONArray.SetAsInt64(const AValue: Int64); begin ConvertError(False); end; {$warnings on} function TJSONArray.GetAsJSON: TJSONStringType; Var I : Integer; begin Result:='['; For I:=0 to Count-1 do begin Result:=Result+Items[i].AsJSON; If (INil) then TJSONData.DoError(SErrPointerNotNil,[SourceType]) else Result:=CreateJSON(); vtCurrency : Result:=CreateJSON(vCurrency^); vtInt64 : Result:=CreateJSON(vInt64^); vtObject : if (VObject is TJSONData) then Result:=TJSONData(VObject) else TJSONData.DoError(SErrNotJSONData,[VObject.ClassName,SourceType]); //vtVariant : else TJSONData.DoError(SErrUnknownTypeInConstructor,[SourceType,VType]) end; end; constructor TJSONArray.Create(const Elements: array of const); Var I : integer; J : TJSONData; begin Create; For I:=Low(Elements) to High(Elements) do begin J:=VarRecToJSON(Elements[i],'Array'); Add(J); end; end; destructor TJSONArray.Destroy; begin FreeAndNil(FList); inherited Destroy; end; class function TJSONArray.JSONType: TJSONType; begin Result:=jtArray; end; function TJSONArray.Clone: TJSONData; Var A : TJSONArray; I : Integer; begin A:=TJSONArrayClass(ClassType).Create; try For I:=0 to Count-1 do A.Add(Self.Items[I].Clone); Result:=A; except A.Free; Raise; end; end; procedure TJSONArray.Iterate(Iterator: TJSONArrayIterator; Data: TObject); Var I : Integer; Cont : Boolean; begin I:=0; Cont:=True; While (I-1) then DoError(SErrCannotAddArrayTwice); Result:=Add(TJSONData(AnArray)); end; function TJSONArray.Add(AnObject: TJSONObject): Integer; begin If (IndexOf(AnObject)<>-1) then DoError(SErrCannotAddObjectTwice); Result:=Add(TJSONData(AnObject)); end; procedure TJSONArray.Delete(Index: Integer); begin FList.Delete(Index); end; procedure TJSONArray.Exchange(Index1, Index2: Integer); begin FList.Exchange(Index1, Index2); end; function TJSONArray.Extract(Item: TJSONData): TJSONData; begin Result := TJSONData(FList.Extract(Item)); end; function TJSONArray.Extract(Index: Integer): TJSONData; begin Result := TJSONData(FList.Extract(FList.Items[Index])); end; procedure TJSONArray.Insert(Index: Integer); begin Insert(Index,CreateJSON); end; procedure TJSONArray.Insert(Index: Integer; Item: TJSONData); begin FList.Insert(Index, Item); end; procedure TJSONArray.Insert(Index: Integer; I: Integer); begin FList.Insert(Index, CreateJSON(I)); end; procedure TJSONArray.Insert(Index: Integer; I: Int64); begin FList.Insert(Index, CreateJSON(I)); end; procedure TJSONArray.Insert(Index: Integer; const S: String); begin FList.Insert(Index, CreateJSON(S)); end; procedure TJSONArray.Insert(Index: Integer; F: TJSONFloat); begin FList.Insert(Index, CreateJSON(F)); end; procedure TJSONArray.Insert(Index: Integer; B: Boolean); begin FList.Insert(Index, CreateJSON(B)); end; procedure TJSONArray.Insert(Index: Integer; AnArray: TJSONArray); begin if (IndexOf(AnArray)<>-1) then DoError(SErrCannotAddArrayTwice); FList.Insert(Index, AnArray); end; procedure TJSONArray.Insert(Index: Integer; AnObject: TJSONObject); begin if (IndexOf(AnObject)<>-1) then DoError(SErrCannotAddObjectTwice); FList.Insert(Index, AnObject); end; procedure TJSONArray.Move(CurIndex, NewIndex: Integer); begin FList.Move(CurIndex, NewIndex); end; procedure TJSONArray.Remove(Item: TJSONData); begin FList.Remove(Item); end; { TJSONObject } function TJSONObject.GetArrays(const AName: String): TJSONArray; begin Result:=GetElements(AName) as TJSONArray; end; function TJSONObject.GetBooleans(const AName: String): Boolean; begin Result:=GetElements(AName).AsBoolean; end; function TJSONObject.GetElements(const AName: string): TJSONData; begin Result:=TJSONData(FHash.Find(AName)); If (Result=Nil) then DoError(SErrNonexistentElement,[AName]); end; function TJSONObject.GetFloats(const AName: String): TJSONFloat; begin Result:=GetElements(AName).AsFloat; end; function TJSONObject.GetIntegers(const AName: String): Integer; begin Result:=GetElements(AName).AsInteger; end; function TJSONObject.GetInt64s(const AName: String): Int64; begin Result:=GetElements(AName).AsInt64; end; function TJSONObject.GetIsNull(const AName: String): Boolean; begin Result:=GetElements(AName).IsNull; end; function TJSONObject.GetNameOf(Index: Integer): TJSONStringType; begin Result:=FHash.NameOfIndex(Index); end; function TJSONObject.GetObjects(const AName : String): TJSONObject; begin Result:=GetElements(AName) as TJSONObject; end; function TJSONObject.GetStrings(const AName : String): TJSONStringType; begin Result:=GetElements(AName).AsString; end; function TJSONObject.GetTypes(const AName : String): TJSONType; begin Result:=Getelements(Aname).JSONType; end; procedure TJSONObject.SetArrays(const AName : String; const AValue: TJSONArray); begin SetElements(AName,AVAlue); end; procedure TJSONObject.SetBooleans(const AName : String; const AValue: Boolean); begin SetElements(AName,CreateJSON(AVAlue)); end; procedure TJSONObject.SetElements(const AName: string; const AValue: TJSONData); Var Index : Integer; begin Index:=FHash.FindIndexOf(AName); If (Index=-1) then FHash.Add(AName,AValue) else FHash.Items[Index]:=AValue; // Will free the previous value. end; procedure TJSONObject.SetFloats(const AName : String; const AValue: TJSONFloat); begin SetElements(AName,CreateJSON(AVAlue)); end; procedure TJSONObject.SetIntegers(const AName : String; const AValue: Integer); begin SetElements(AName,CreateJSON(AVAlue)); end; procedure TJSONObject.SetInt64s(const AName : String; const AValue: Int64); begin SetElements(AName,CreateJSON(AVAlue)); end; procedure TJSONObject.SetIsNull(const AName : String; const AValue: Boolean); begin If Not AValue then DoError(SErrCannotSetNotIsNull); SetElements(AName,CreateJSON); end; procedure TJSONObject.SetObjects(const AName : String; const AValue: TJSONObject); begin SetElements(AName,AValue); end; procedure TJSONObject.SetStrings(const AName : String; const AValue: TJSONStringType); begin SetElements(AName,CreateJSON(AVAlue)); end; function TJSONObject.DoFindPath(const APath: TJSONStringType; out NotFound: TJSONStringType): TJSONdata; Var N: TJSONStringType; L,P,P2 : Integer; begin If (APath='') then Exit(Self); N:=APath; L:=Length(N); P:=1; While (P'') then Result:=Result+', '; Result:=Result+'"'+StringToJSONString(Names[i])+'" : '+Items[I].AsJSON; end; If (Result<>'') then Result:='{ '+Result+' }' else Result:='{}'; end; {$warnings off} function TJSONObject.GetAsString: TJSONStringType; begin ConvertError(True); end; procedure TJSONObject.SetAsString(const AValue: TJSONStringType); begin ConvertError(False); end; function TJSONObject.GetValue: variant; begin ConvertError(True); end; procedure TJSONObject.SetValue(const AValue: variant); begin ConvertError(False); end; {$warnings on} function TJSONObject.GetCount: Integer; begin Result:=FHash.Count; end; function TJSONObject.GetItem(Index: Integer): TJSONData; begin Result:=TJSONData(FHash.Items[Index]); end; procedure TJSONObject.SetItem(Index: Integer; const AValue: TJSONData); begin FHash.Items[Index]:=AValue; end; constructor TJSONObject.Create; begin FHash:=TFPHashObjectList.Create(True); end; constructor TJSONObject.Create(const Elements: array of const); Var I : integer; AName : String; J : TJSONData; begin Create; If ((High(Elements)-Low(Elements)) mod 2)=0 then DoError(SErrOddNumber); I:=Low(Elements); While I<=High(Elements) do begin With Elements[i] do Case VType of vtChar : AName:=VChar; vtString : AName:=vString^; vtAnsiString : AName:=(AnsiString(vAnsiString)); vtPChar : AName:=StrPas(VPChar); else DoError(SErrNameMustBeString,[I+1]); end; If (ANAme='') then DoError(SErrNameMustBeString,[I+1]); Inc(I); J:=VarRecToJSON(Elements[i],'Object'); Add(AName,J); Inc(I); end; end; destructor TJSONObject.Destroy; begin FreeAndNil(FHash); inherited Destroy; end; class function TJSONObject.JSONType: TJSONType; begin Result:=jtObject; end; function TJSONObject.Clone: TJSONData; Var O : TJSONObject; I: Integer; begin O:=TJSONObjectClass(ClassType).Create; try For I:=0 to Count-1 do O.Add(Self.Names[I],Self.Items[I].Clone); Result:=O; except FreeAndNil(O); Raise; end; end; function TJSONObject.GetEnumerator: TBaseJSONEnumerator; begin Result:=TJSONObjectEnumerator.Create(Self); end; function TJSONObject.DoFormatJSON(Options: TFormatOptions; CurrentIndent, Indent: Integer): TJSONStringType; Var i : Integer; S : TJSONStringType; begin Result:=''; CurrentIndent:=CurrentIndent+Indent; For I:=0 to Count-1 do begin If (Result<>'') then begin If (foSingleLineObject in Options) then Result:=Result+', ' else Result:=Result+','+SLineBreak; end; If not (foSingleLineObject in Options) then Result:=Result+IndentString(Options,CurrentIndent); S:=StringToJSONString(Names[i]); If not (foDoNotQuoteMembers in options) then S:='"'+S+'"'; Result:=Result+S+' : '+Items[I].DoFormatJSON(Options,CurrentIndent,Indent); end; If (Result<>'') then begin if (foSingleLineObject in Options) then Result:='{ '+Result+' }' else Result:='{'+sLineBreak+Result+sLineBreak+indentString(options,CurrentIndent-Indent)+'}' end else Result:='{}'; end; procedure TJSONObject.Iterate(Iterator: TJSONObjectIterator; Data: TObject); Var I : Integer; Cont : Boolean; begin I:=0; Cont:=True; While (I=0) and (CompareText(Names[Result],AName)<>0) do Dec(Result); end; end; procedure TJSONObject.Clear; begin FHash.Clear; end; function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONData ): Integer; begin Result:=FHash.Add(AName,AValue); end; function TJSONObject.Add(const AName: TJSONStringType; AValue: Boolean ): Integer; begin Result:=Add(AName,CreateJSON(AValue)); end; function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer; begin Result:=Add(AName,CreateJSON(AValue)); end; function TJSONObject.Add(const AName, AValue: TJSONStringType): Integer; begin Result:=Add(AName,CreateJSON(AValue)); end; function TJSONObject.Add(const AName: TJSONStringType; Avalue: Integer): Integer; begin Result:=Add(AName,CreateJSON(AValue)); end; function TJSONObject.Add(const AName: TJSONStringType; Avalue: Int64): Integer; begin Result:=Add(AName,CreateJSON(AValue)); end; function TJSONObject.Add(const AName: TJSONStringType): Integer; begin Result:=Add(AName,CreateJSON); end; function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONArray ): Integer; begin Result:=Add(AName,TJSONData(AValue)); end; procedure TJSONObject.Delete(Index: Integer); begin FHash.Delete(Index); end; procedure TJSONObject.Delete(const AName: string); Var I : Integer; begin I:=IndexOfName(AName); if (I<>-1) then Delete(I); end; procedure TJSONObject.Remove(Item: TJSONData); begin FHash.Remove(Item); end; function TJSONObject.Extract(Index: Integer): TJSONData; begin Result:=Items[Index]; FHash.Extract(Result); end; function TJSONObject.Extract(const AName: string): TJSONData; Var I : Integer; begin I:=IndexOfName(AName); if (I<>-1) then Result:=Extract(I) else Result:=Nil end; function TJSONObject.Get(const AName: String): Variant; Var I : Integer; begin I:=IndexOfName(AName); If (I<>-1) then Result:=Items[i].Value else Result:=Null; end; function TJSONObject.Get(const AName: String; ADefault: TJSONFloat ): TJSONFloat; Var D : TJSONData; begin D:=Find(AName,jtNumber); If D<>Nil then Result:=D.AsFloat else Result:=ADefault; end; function TJSONObject.Get(const AName: String; ADefault: Integer ): Integer; Var D : TJSONData; begin D:=Find(AName,jtNumber); If D<>Nil then Result:=D.AsInteger else Result:=ADefault; end; function TJSONObject.Get(const AName: String; ADefault: Int64): Int64; Var D : TJSONData; begin D:=Find(AName,jtNumber); If D<>Nil then Result:=D.AsInt64 else Result:=ADefault; end; function TJSONObject.Get(const AName: String; ADefault: Boolean ): Boolean; Var D : TJSONData; begin D:=Find(AName,jtBoolean); If D<>Nil then Result:=D.AsBoolean else Result:=ADefault; end; function TJSONObject.Get(const AName: String; ADefault: TJSONStringType ): TJSONStringTYpe; Var D : TJSONData; begin D:=Find(AName,jtString); If (D<>Nil) then Result:=D.AsString else Result:=ADefault; end; function TJSONObject.Get(const AName: String; ADefault: TJSONArray ): TJSONArray; Var D : TJSONData; begin D:=Find(AName,jtArray); If (D<>Nil) then Result:=TJSONArray(D) else Result:=ADefault; end; function TJSONObject.Get(const AName: String; ADefault: TJSONObject ): TJSONObject; Var D : TJSONData; begin D:=Find(AName,jtObject); If (D<>Nil) then Result:=TJSONObject(D) else Result:=ADefault; end; function TJSONObject.Find(const AName: String): TJSONData; Var I : Integer; begin I:=IndexOfName(AName); If (I<>-1) then Result:=Items[i] else Result:=Nil; end; function TJSONObject.Find(const AName: String; AType: TJSONType): TJSONData; begin Result:=Find(AName); If Assigned(Result) and (Result.JSONType<>AType) then Result:=Nil; end; end.