123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752 |
- {
- This file is part of the Free Component Library
- JSON Data structures
- Copyright (c) 2007 by Michael Van Canneyt [email protected]
- 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);
- TJSONFloat = Extended;
- TJSONStringType = AnsiString;
- TJSONCharType = AnsiChar;
- PJSONCharType = ^TJSONCharType;
- { TJSONData }
- TJSONData = class(TObject)
- protected
- 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 GetCount: Integer; virtual;
- public
- Constructor Create; virtual;
- Class function JSONType: TJSONType; virtual;
- Procedure Clear; virtual; Abstract;
- 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;
- end;
-
- { 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;
- end;
- { 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;
- end;
- { 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(AValue : TJSONStringType); reintroduce;
- class function JSONType: TJSONType; override;
- Procedure Clear; override;
- end;
- { 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;
- end;
- { 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;
- end;
- 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
- 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;
- public
- Constructor Create; overload; reintroduce;
- Constructor Create(const Elements : Array of Const); overload;
- Destructor Destroy; override;
- class function JSONType: TJSONType; override;
- // Examine
- procedure Iterate(Iterator : TJSONArrayIterator; Data: TObject);
- function IndexOf(obj: TJSONData): Integer;
- // Manipulate
- Procedure Clear; override;
- function Add(Item : TJSONData): Integer;
- function Add(I : Integer): Integer;
- function Add(I : Int64): Int64;
- function Add(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 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;
- 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(AName : String): TJSONArray;
- function GetBooleans(AName : String): Boolean;
- function GetElements(AName: string): TJSONData;
- function GetFloats(AName : String): TJSONFloat;
- function GetIntegers(AName : String): Integer;
- function GetInt64s(AName : String): Int64;
- function GetIsNull(AName : String): Boolean; reintroduce;
- function GetNameOf(Index : Integer): TJSONStringType;
- function GetObjects(AName : String): TJSONObject;
- function GetStrings(AName : String): TJSONStringType;
- function GetTypes(AName : String): TJSONType;
- procedure SetArrays(AName : String; const AValue: TJSONArray);
- procedure SetBooleans(AName : String; const AValue: Boolean);
- procedure SetElements(AName: string; const AValue: TJSONData);
- procedure SetFloats(AName : String; const AValue: TJSONFloat);
- procedure SetIntegers(AName : String; const AValue: Integer);
- procedure SetInt64s(AName : String; const AValue: Int64);
- procedure SetIsNull(AName : String; const AValue: Boolean);
- procedure SetObjects(AName : String; const AValue: TJSONObject);
- procedure SetStrings(AName : String; const AValue: TJSONStringType);
- protected
- 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;
- public
- constructor Create; reintroduce;
- Constructor Create(const Elements : Array of Const); overload;
- destructor Destroy; override;
- class function JSONType: TJSONType; override;
- // Examine
- procedure Iterate(Iterator : TJSONObjectIterator; Data: TObject);
- function IndexOf(Item: TJSONData): Integer;
- Function IndexOfName(const AName: TJSONStringType): Integer;
- // 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: TJSONStringType; 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 Remove(Item : 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;
- EJSON = Class(Exception);
-
- Function StringToJSONString(S : TJSONStringType) : TJSONStringType;
- Function JSONStringToString(S : TJSONStringType) : TJSONStringType;
- implementation
- 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';
-
-
- Function StringToJSONString(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(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;
- { 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;
- function TJSONData.GetIsNull: Boolean;
- begin
- Result:=False;
- end;
- class function TJSONData.JSONType: TJSONType;
- begin
- JSONType:=jtUnknown;
- end;
- procedure TJSONData.SetItem(Index : Integer; const AValue:
- TJSONData);
- begin
- // Do Nothing
- 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.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(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;
- 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);
- 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
- Raise EJSON.Create(SErrCannotConvertFromNull)
- else
- Raise EJSON.Create(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;
- {$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);
- 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;
- { 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;
- { 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;
- { 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]:=TJSonBoolean.Create(AValue);
- end;
- procedure TJSONArray.SetFloats(Index : Integer; const AValue: TJSONFloat);
- begin
- Items[Index]:=TJSONFloatNumber.Create(AValue);
- end;
- procedure TJSONArray.SetIntegers(Index : Integer; const AValue: Integer);
- begin
- Items[Index]:=TJSONIntegerNumber.Create(AValue);
- end;
- procedure TJSONArray.SetInt64s(Index : Integer; const AValue: Int64);
- begin
- Items[Index]:=TJSONInt64Number.Create(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]:=TJSONString.Create(AValue);
- end;
- procedure TJSONArray.Converterror(From: Boolean);
- begin
- If From then
- Raise EJSON.Create(SErrCannotConvertFromArray)
- else
- Raise EJSON.Create(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 (I<Count-1) then
- Result:=Result+', '
- end;
- Result:=Result+']';
- end;
- {$warnings off}
- function TJSONArray.GetAsString: TJSONStringType;
- begin
- ConvertError(True);
- end;
- procedure TJSONArray.SetAsString(const AValue: TJSONStringType);
- begin
- ConvertError(False);
- end;
- function TJSONArray.GetValue: variant;
- begin
- ConvertError(True);
- end;
- procedure TJSONArray.SetValue(const AValue: variant);
- begin
- ConvertError(False);
- end;
- {$warnings on}
- function TJSONArray.GetCount: Integer;
- begin
- Result:=Flist.Count;
- end;
- function TJSONArray.GetItem(Index: Integer): TJSONData;
- begin
- Result:=FList[Index] as TJSONData;
- end;
- procedure TJSONArray.SetItem(Index: Integer; const AValue: TJSONData);
- begin
- If (Index=FList.Count) then
- FList.Add(AValue)
- else
- FList[Index]:=AValue;
- end;
- constructor TJSONArray.Create;
- begin
- Flist:=TFPObjectList.Create(True);
- end;
- Function VarRecToJSON(Const Element : TVarRec; SourceType : String) : TJSONData;
- begin
- Result:=Nil;
- With Element do
- case VType of
- vtInteger : Result:=TJSONIntegerNumber.Create(VInteger);
- vtBoolean : Result:=TJSONBoolean.Create(VBoolean);
- vtChar : Result:=TJSONString.Create(VChar);
- vtExtended : Result:=TJSONFloatNumber.Create(VExtended^);
- vtString : Result:=TJSONString.Create(vString^);
- vtAnsiString : Result:=TJSONString.Create(AnsiString(vAnsiString));
- vtPChar : Result:=TJSONString.Create(StrPas(VPChar));
- vtPointer : If (VPointer<>Nil) then
- Raise EJSON.CreateFmt(SErrPointerNotNil,[SourceType])
- else
- Result:=TJSONNull.Create;
- vtCurrency : Result:=TJSONFloatNumber.Create(vCurrency^);
- vtInt64 : Result:=TJSONInt64Number.Create(vInt64^);
- vtObject : if (VObject is TJSONData) then
- Result:=TJSONData(VObject)
- else
- Raise EJSON.CreateFmt(SErrNotJSONData,[SourceType,VObject.ClassName]);
- //vtVariant :
- else
- Raise EJSON.CreateFmt(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;
- procedure TJSONArray.Iterate(Iterator: TJSONArrayIterator; Data: TObject);
- Var
- I : Integer;
- Cont : Boolean;
-
- begin
- I:=0;
- Cont:=True;
- While (I<FList.Count) and cont do
- begin
- Iterator(Items[i],Data,Cont);
- Inc(I);
- end;
- end;
- function TJSONArray.IndexOf(obj: TJSONData): Integer;
- begin
- Result:=FList.IndexOf(Obj);
- end;
- procedure TJSONArray.Clear;
- begin
- FList.Clear;
- end;
- function TJSONArray.Add(Item: TJSONData): Integer;
- begin
- Result:=FList.Add(Item);
- end;
- function TJSONArray.Add(I: Integer): Integer;
- begin
- Result:=Add(TJSONIntegerNumber.Create(I));
- end;
- function TJSONArray.Add(I: Int64): Int64;
- begin
- Result:=Add(TJSONInt64Number.Create(I));
- end;
- function TJSONArray.Add(S: String): Integer;
- begin
- Result:=Add(TJSONString.Create(S));
- end;
- function TJSONArray.Add: Integer;
- begin
- Result:=Add(TJSONNull.Create);
- end;
- function TJSONArray.Add(F: TJSONFloat): Integer;
- begin
- Result:=Add(TJSONFloatNumber.Create(F));
- end;
- function TJSONArray.Add(B: Boolean): Integer;
- begin
- Result:=Add(TJSONBoolean.Create(B));
- end;
- function TJSONArray.Add(AnArray: TJSONArray): Integer;
- begin
- If (IndexOf(AnArray)<>-1) then
- Raise EJSON.Create(SErrCannotAddArrayTwice);
- Result:=Add(TJSONData(AnArray));
- end;
- function TJSONArray.Add(AnObject: TJSONObject): Integer;
- begin
- If (IndexOf(AnObject)<>-1) then
- Raise EJSON.Create(SErrCannotAddObjectTwice);
- Result:=Add(TJSONData(AnObject));
- end;
- procedure TJSONArray.Delete(Index: Integer);
- begin
- FList.Delete(Index);
- end;
- procedure TJSONArray.Remove(Item: TJSONData);
- begin
- FList.Remove(Item);
- end;
- { TJSONObject }
- function TJSONObject.GetArrays(AName : String): TJSONArray;
- begin
- Result:=GetElements(AName) as TJSONArray;
- end;
- function TJSONObject.GetBooleans(AName : String): Boolean;
- begin
- Result:=GetElements(AName).AsBoolean;
- end;
- function TJSONObject.GetElements(AName: string): TJSONData;
- begin
- Result:=TJSONData(FHash.Find(AName));
- end;
- function TJSONObject.GetFloats(AName : String): TJSONFloat;
- begin
- Result:=GetElements(AName).AsFloat;
- end;
- function TJSONObject.GetIntegers(AName : String): Integer;
- begin
- Result:=GetElements(AName).AsInteger;
- end;
- function TJSONObject.GetInt64s(AName : String): Int64;
- begin
- Result:=GetElements(AName).AsInt64;
- end;
- function TJSONObject.GetIsNull(AName : String): Boolean;
- begin
- Result:=GetElements(AName).IsNull;
- end;
- function TJSONObject.GetNameOf(Index: Integer): TJSONStringType;
- begin
- Result:=FHash.NameOfIndex(Index);
- end;
- function TJSONObject.GetObjects(AName : String): TJSONObject;
- begin
- Result:=GetElements(AName) as TJSONObject;
- end;
- function TJSONObject.GetStrings(AName : String): TJSONStringType;
- begin
- Result:=GetElements(AName).AsString;
- end;
- function TJSONObject.GetTypes(AName : String): TJSONType;
- begin
- Result:=Getelements(Aname).JSONType;
- end;
- procedure TJSONObject.SetArrays(AName : String; const AValue: TJSONArray);
- begin
- SetElements(AName,AVAlue);
- end;
- procedure TJSONObject.SetBooleans(AName : String; const AValue: Boolean);
- begin
- SetElements(AName,TJSONBoolean.Create(AVAlue));
- end;
- procedure TJSONObject.SetElements(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(AName : String; const AValue: TJSONFloat);
- begin
- SetElements(AName,TJSONFloatNumber.Create(AVAlue));
- end;
- procedure TJSONObject.SetIntegers(AName : String; const AValue: Integer);
- begin
- SetElements(AName,TJSONIntegerNumber.Create(AVAlue));
- end;
- procedure TJSONObject.SetInt64s(AName : String; const AValue: Int64);
- begin
- SetElements(AName,TJSONInt64Number.Create(AVAlue));
- end;
- procedure TJSONObject.SetIsNull(AName : String; const AValue: Boolean);
- begin
- If Not AValue then
- Raise EJSON.Create(SErrCannotSetNotIsNull);
- SetElements(AName,TJSONNull.Create);
- end;
- procedure TJSONObject.SetObjects(AName : String; const AValue: TJSONObject);
- begin
- SetElements(AName,AValue);
- end;
- procedure TJSONObject.SetStrings(AName : String; const AValue: TJSONStringType);
- begin
- SetElements(AName,TJSONString.Create(AVAlue));
- end;
- procedure TJSONObject.Converterror(From: Boolean);
- begin
- If From then
- Raise EJSON.Create(SErrCannotConvertFromObject)
- else
- Raise EJSON.Create(SErrCannotConvertToObject);
- end;
- {$warnings off}
- function TJSONObject.GetAsBoolean: Boolean;
- begin
- ConvertError(True);
- end;
- function TJSONObject.GetAsFloat: TJSONFloat;
- begin
- ConvertError(True);
- end;
- function TJSONObject.GetAsInteger: Integer;
- begin
- ConvertError(True);
- end;
- function TJSONObject.GetAsInt64: Int64;
- begin
- ConvertError(True);
- end;
- procedure TJSONObject.SetAsBoolean(const AValue: Boolean);
- begin
- ConvertError(False);
- end;
- procedure TJSONObject.SetAsFloat(const AValue: TJSONFloat);
- begin
- ConvertError(False);
- end;
- procedure TJSONObject.SetAsInteger(const AValue: Integer);
- begin
- ConvertError(False);
- end;
- procedure TJSONObject.SetAsInt64(const AValue: Int64);
- begin
- ConvertError(False);
- end;
- {$warnings on}
- function TJSONObject.GetAsJSON: TJSONStringType;
- Var
- I : Integer;
- begin
- Result:='';
- For I:=0 to Count-1 do
- begin
- If (Result<>'') 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
- Raise EJSON.Create(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
- Raise EJSON.CreateFmt(SErrNameMustBeString,[I+1]);
- end;
- If (ANAme='') then
- Raise EJSON.CreateFmt(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;
- procedure TJSONObject.Iterate(Iterator: TJSONObjectIterator; Data: TObject);
- Var
- I : Integer;
- Cont : Boolean;
- begin
- I:=0;
- Cont:=True;
- While (I<FHash.Count) and cont do
- begin
- Iterator(Names[I],Items[i],Data,Cont);
- Inc(I);
- end;
- end;
- function TJSONObject.IndexOf(Item: TJSONData): Integer;
- begin
- Result:=FHash.IndexOf(Item);
- end;
- function TJSONObject.IndexOfName(const AName: TJSONStringType): Integer;
- begin
- Result:=FHash.FindIndexOf(AName);
- 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,TJSONBoolean.Create(AValue));
- end;
- function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer;
- begin
- Result:=Add(AName,TJSONFloatNumber.Create(AValue));
- end;
- function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONStringType): Integer;
- begin
- Result:=Add(AName,TJSONString.Create(AValue));
- end;
- function TJSONObject.Add(const AName: TJSONStringType; Avalue: Integer): Integer;
- begin
- Result:=Add(AName,TJSONIntegerNumber.Create(AValue));
- end;
- function TJSONObject.Add(const AName: TJSONStringType; Avalue: Int64): Integer;
- begin
- Result:=Add(AName,TJSONInt64Number.Create(AValue));
- end;
- function TJSONObject.Add(const AName: TJSONStringType): Integer;
- begin
- Result:=Add(AName,TJSONNull.Create);
- 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.Remove(Item: TJSONData);
- begin
- FHash.Remove(Item);
- end;
- end.
|