fpjson.pp 100 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095
  1. {
  2. This file is part of the Free Component Library
  3. JSON Data structures
  4. Copyright (c) 2007 by Michael Van Canneyt [email protected]
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {$mode objfpc}
  12. {$h+}
  13. unit fpjson;
  14. interface
  15. uses
  16. {$IFNDEF PAS2JS}
  17. variants,
  18. {$ENDIF}
  19. {$IFDEF PAS2JS}
  20. JS, RTLConsts, Types,
  21. {$ENDIF}
  22. SysUtils,
  23. classes,
  24. contnrs;
  25. type
  26. TJSONtype = (jtUnknown, jtNumber, jtString, jtBoolean, jtNull, jtArray, jtObject);
  27. TJSONInstanceType = (
  28. jitUnknown,
  29. jitNumberInteger,
  30. {$IFNDEF PAS2JS}
  31. jitNumberInt64,
  32. jitNumberQWord,
  33. {$ELSE}
  34. jitNumberNativeInt,
  35. {$ENDIF}
  36. jitNumberFloat,
  37. jitString,
  38. jitBoolean,
  39. jitNull,
  40. jitArray,
  41. jitObject);
  42. TJSONFloat = Double;
  43. TJSONStringType = {$IFNDEF PAS2JS}UTF8String{$else}string{$ENDIF};
  44. TJSONUnicodeStringType = Unicodestring;
  45. {$IFNDEF PAS2JS}
  46. TJSONCharType = AnsiChar;
  47. PJSONCharType = ^TJSONCharType;
  48. TJSONVariant = variant;
  49. TFPJSStream = TMemoryStream;
  50. TJSONLargeInt = Int64;
  51. {$else}
  52. TJSONCharType = char;
  53. TJSONVariant = jsvalue;
  54. TFPJSStream = TJSArray;
  55. TJSONLargeInt = NativeInt;
  56. {$ENDIF}
  57. TFormatOption = (foSingleLineArray, // Array without CR/LF : all on one line
  58. foSingleLineObject, // Object without CR/LF : all on one line
  59. foDoNotQuoteMembers, // Do not quote object member names.
  60. foUseTabchar, // Use tab characters instead of spaces.
  61. foSkipWhiteSpace, // Do not use whitespace at all
  62. foSkipWhiteSpaceOnlyLeading // When foSkipWhiteSpace is active, skip whitespace for object members only before :
  63. );
  64. TFormatOptions = set of TFormatOption;
  65. Const
  66. DefaultIndentSize = 2;
  67. DefaultFormat = [];
  68. AsJSONFormat = [foSingleLineArray,foSingleLineObject]; // These options make FormatJSON behave as AsJSON
  69. AsCompressedJSON = [foSingleLineArray,foSingleLineObject,foskipWhiteSpace]; // These options make FormatJSON behave as AsJSON with TJSONData.CompressedJSON=True
  70. AsCompactJSON = [foSingleLineArray,foSingleLineObject,foskipWhiteSpace,foDoNotQuoteMembers]; // These options make FormatJSON behave as AsJSON with TJSONData.CompressedJSON=True and TJSONObject.UnquotedMemberNames=True
  71. ValueJSONTypes = [jtNumber, jtString, jtBoolean, jtNull];
  72. ActualValueJSONTypes = ValueJSONTypes - [jtNull];
  73. StructuredJSONTypes = [jtArray,jtObject];
  74. {$IFDEF PAS2JS}
  75. jitNumberLargeInt = jitNumberNativeInt;
  76. {$ELSE}
  77. jitNumberLargeInt = jitNumberInt64;
  78. {$ENDIF}
  79. Type
  80. TJSONData = Class;
  81. { TBaseJSONEnumerator }
  82. TJSONEnum = Record
  83. Key : TJSONStringType;
  84. KeyNum : Integer;
  85. Value : TJSONData;
  86. end;
  87. TBaseJSONEnumerator = class
  88. public
  89. function GetCurrent: TJSONEnum; virtual; abstract;
  90. function MoveNext : Boolean; virtual; abstract;
  91. property Current: TJSONEnum read GetCurrent;
  92. end;
  93. { TJSONData }
  94. TJSONData = class(TObject)
  95. private
  96. Const
  97. ElementSeps : Array[Boolean] of TJSONStringType = (', ',',');
  98. Class Var FCompressedJSON : Boolean;
  99. Class Var FElementSep : TJSONStringType;
  100. class procedure DetermineElementSeparators;
  101. class function GetCompressedJSON: Boolean; {$IFNDEF PAS2JS}static;{$ENDIF}
  102. class procedure SetCompressedJSON(AValue: Boolean); {$IFNDEF PAS2JS}static;{$ENDIF}
  103. protected
  104. Class Procedure DoError(Const Msg : String);
  105. Class Procedure DoError(Const Fmt : String; const Args : Array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF});
  106. Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; virtual;
  107. function GetAsBoolean: Boolean; virtual; abstract;
  108. function GetAsFloat: TJSONFloat; virtual; abstract;
  109. function GetAsInteger: Integer; virtual; abstract;
  110. function GetIsNull: Boolean; virtual;
  111. {$IFNDEF PAS2JS}
  112. function GetAsInt64: Int64; virtual; abstract;
  113. function GetAsQWord: QWord; virtual; abstract;
  114. function GetAsUnicodeString: TJSONUnicodeStringType; virtual;
  115. procedure SetAsInt64(const AValue: Int64); virtual; abstract;
  116. procedure SetAsQword(const AValue: QWord); virtual; abstract;
  117. procedure SetAsUnicodeString(const AValue: TJSONUnicodeStringType); virtual;
  118. {$ELSE}
  119. function GetAsNativeInt: NativeInt; virtual; abstract;
  120. procedure SetAsNativeInt(const AValue: NativeInt); virtual; abstract;
  121. {$ENDIF}
  122. procedure SetAsBoolean(const AValue: Boolean); virtual; abstract;
  123. procedure SetAsFloat(const AValue: TJSONFloat); virtual; abstract;
  124. procedure SetAsInteger(const AValue: Integer); virtual; abstract;
  125. function GetAsJSON: TJSONStringType; virtual; abstract;
  126. function GetAsString: TJSONStringType; virtual; abstract;
  127. procedure SetAsString(const AValue: TJSONStringType); virtual; abstract;
  128. function GetValue: TJSONVariant; virtual; abstract;
  129. procedure SetValue(const AValue: TJSONVariant); virtual; abstract;
  130. function GetItem(Index : Integer): TJSONData; virtual;
  131. procedure SetItem(Index : Integer; const AValue: TJSONData); virtual;
  132. Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; virtual;
  133. function GetCount: Integer; virtual;
  134. Public
  135. Class function JSONType: TJSONType; virtual;
  136. Class Property CompressedJSON : Boolean Read GetCompressedJSON Write SetCompressedJSON;
  137. public
  138. Constructor Create; virtual;
  139. Procedure Clear; virtual; Abstract;
  140. Procedure DumpJSON(S : TFPJSStream);
  141. // Get enumerator
  142. function GetEnumerator: TBaseJSONEnumerator; virtual;
  143. Function FindPath(Const APath : TJSONStringType) : TJSONdata;
  144. Function GetPath(Const APath : TJSONStringType) : TJSONdata;
  145. Function Clone : TJSONData; virtual; abstract;
  146. Function FormatJSON(Options : TFormatOptions = DefaultFormat; Indentsize : Integer = DefaultIndentSize) : TJSONStringType;
  147. property Count: Integer read GetCount;
  148. property Items[Index: Integer]: TJSONData read GetItem write SetItem;
  149. property Value: TJSONVariant read GetValue write SetValue;
  150. Property AsString : TJSONStringType Read GetAsString Write SetAsString;
  151. {$IFNDEF PAS2JS}
  152. Property AsUnicodeString : TJSONUnicodeStringType Read GetAsUnicodeString Write SetAsUnicodeString;
  153. Property AsInt64 : Int64 Read GetAsInt64 Write SetAsInt64;
  154. Property AsQWord : QWord Read GetAsQWord Write SetAsQword;
  155. Property AsLargeInt : TJSONLargeInt Read GetAsInt64 Write SetAsInt64;
  156. {$ELSE}
  157. Property AsNativeInt : NativeInt Read GetAsNativeInt Write SetAsNativeInt;
  158. Property AsLargeInt : TJSONLargeInt Read GetAsNativeInt Write SetAsNativeInt;
  159. {$ENDIF}
  160. Property AsFloat : TJSONFloat Read GetAsFloat Write SetAsFloat;
  161. Property AsInteger : Integer Read GetAsInteger Write SetAsInteger;
  162. Property AsBoolean : Boolean Read GetAsBoolean Write SetAsBoolean;
  163. Property IsNull : Boolean Read GetIsNull;
  164. Property AsJSON : TJSONStringType Read GetAsJSON;
  165. end;
  166. TJSONDataClass = Class of TJSONData;
  167. TJSONNumberType = (
  168. ntFloat,
  169. ntInteger
  170. {$IFNDEF PAS2JS}
  171. ,ntInt64
  172. ,ntQWord
  173. {$else}
  174. ,ntNativeInt
  175. {$ENDIF}
  176. );
  177. TJSONNumber = class(TJSONData)
  178. protected
  179. public
  180. class function JSONType: TJSONType; override;
  181. class function NumberType : TJSONNumberType; virtual; abstract;
  182. end;
  183. { TJSONFloatNumber }
  184. TJSONFloatNumber = class(TJSONNumber)
  185. Private
  186. FValue : TJSONFloat;
  187. protected
  188. function GetAsBoolean: Boolean; override;
  189. function GetAsFloat: TJSONFloat; override;
  190. function GetAsInteger: Integer; override;
  191. function GetAsJSON: TJSONStringType; override;
  192. function GetAsString: TJSONStringType; override;
  193. function GetValue: TJSONVariant; override;
  194. {$IFNDEF PAS2JS}
  195. function GetAsInt64: Int64; override;
  196. function GetAsQWord: QWord; override;
  197. procedure SetAsInt64(const AValue: Int64); override;
  198. procedure SetAsQword(const AValue: QWord); override;
  199. {$ELSE}
  200. function GetAsNativeInt: NativeInt; override;
  201. procedure SetAsNativeInt(const AValue: NativeInt); override;
  202. {$ENDIF}
  203. procedure SetAsBoolean(const AValue: Boolean); override;
  204. procedure SetAsFloat(const AValue: TJSONFloat); override;
  205. procedure SetAsInteger(const AValue: Integer); override;
  206. procedure SetAsString(const AValue: TJSONStringType); override;
  207. procedure SetValue(const AValue: TJSONVariant); override;
  208. public
  209. Constructor Create(AValue : TJSONFloat); reintroduce;
  210. class function NumberType : TJSONNumberType; override;
  211. Procedure Clear; override;
  212. Function Clone : TJSONData; override;
  213. end;
  214. TJSONFloatNumberClass = Class of TJSONFloatNumber;
  215. { TJSONIntegerNumber }
  216. TJSONIntegerNumber = class(TJSONNumber)
  217. Private
  218. FValue : Integer;
  219. protected
  220. function GetAsBoolean: Boolean; override;
  221. function GetAsFloat: TJSONFloat; override;
  222. function GetAsInteger: Integer; override;
  223. {$IFNDEF PAS2JS}
  224. function GetAsInt64: Int64; override;
  225. function GetAsQWord: QWord; override;
  226. procedure SetAsInt64(const AValue: Int64); override;
  227. procedure SetAsQword(const AValue: QWord); override;
  228. {$ELSE}
  229. function GetAsNativeInt: NativeInt; override;
  230. procedure SetAsNativeInt(const AValue: NativeInt); override;
  231. {$ENDIF}
  232. procedure SetAsBoolean(const AValue: Boolean); override;
  233. procedure SetAsFloat(const AValue: TJSONFloat); override;
  234. procedure SetAsInteger(const AValue: Integer); override;
  235. function GetAsJSON: TJSONStringType; override;
  236. function GetAsString: TJSONStringType; override;
  237. procedure SetAsString(const AValue: TJSONStringType); override;
  238. function GetValue: TJSONVariant; override;
  239. procedure SetValue(const AValue: TJSONVariant); override;
  240. public
  241. Constructor Create(AValue : Integer); reintroduce;
  242. class function NumberType : TJSONNumberType; override;
  243. Procedure Clear; override;
  244. Function Clone : TJSONData; override;
  245. end;
  246. TJSONIntegerNumberClass = Class of TJSONIntegerNumber;
  247. {$IFNDEF PAS2JS}
  248. { TJSONInt64Number }
  249. TJSONInt64Number = class(TJSONNumber)
  250. Private
  251. FValue : Int64;
  252. protected
  253. function GetAsBoolean: Boolean; override;
  254. function GetAsFloat: TJSONFloat; override;
  255. function GetAsInteger: Integer; override;
  256. function GetAsInt64: Int64; override;
  257. function GetAsQWord: QWord; override;
  258. procedure SetAsBoolean(const AValue: Boolean); override;
  259. procedure SetAsFloat(const AValue: TJSONFloat); override;
  260. procedure SetAsInteger(const AValue: Integer); override;
  261. procedure SetAsInt64(const AValue: Int64); override;
  262. procedure SetAsQword(const AValue: QWord); override;
  263. function GetAsJSON: TJSONStringType; override;
  264. function GetAsString: TJSONStringType; override;
  265. procedure SetAsString(const AValue: TJSONStringType); override;
  266. function GetValue: TJSONVariant; override;
  267. procedure SetValue(const AValue: TJSONVariant); override;
  268. public
  269. Constructor Create(AValue : Int64); reintroduce;
  270. class function NumberType : TJSONNumberType; override;
  271. Procedure Clear; override;
  272. Function Clone : TJSONData; override;
  273. end;
  274. TJSONInt64NumberClass = Class of TJSONInt64Number;
  275. TJSONLargeIntNumber = TJSONInt64Number;
  276. TJSONLargeIntNumberClass = TJSONInt64NumberClass;
  277. {$ELSE}
  278. { TJSONNativeIntNumber }
  279. TJSONNativeIntNumber = class(TJSONNumber)
  280. Private
  281. FValue : NativeInt;
  282. protected
  283. function GetAsBoolean: Boolean; override;
  284. function GetAsFloat: TJSONFloat; override;
  285. function GetAsInteger: Integer; override;
  286. function GetAsNativeInt: NativeInt; override;
  287. procedure SetAsBoolean(const AValue: Boolean); override;
  288. procedure SetAsFloat(const AValue: TJSONFloat); override;
  289. procedure SetAsInteger(const AValue: Integer); override;
  290. procedure SetAsNativeInt(const AValue: NativeInt); override;
  291. function GetAsJSON: TJSONStringType; override;
  292. function GetAsString: TJSONStringType; override;
  293. procedure SetAsString(const AValue: TJSONStringType); override;
  294. function GetValue: TJSONVariant; override;
  295. procedure SetValue(const AValue: TJSONVariant); override;
  296. public
  297. Constructor Create(AValue : NativeInt); reintroduce;
  298. class function NumberType : TJSONNumberType; override;
  299. Procedure Clear; override;
  300. Function Clone : TJSONData; override;
  301. end;
  302. TJSONNativeIntNumberClass = Class of TJSONNativeIntNumber;
  303. TJSONLargeIntNumber = TJSONNativeIntNumber;
  304. TJSONLargeIntNumberClass = TJSONNativeIntNumberClass;
  305. {$ENDIF}
  306. {$IFNDEF PAS2JS}
  307. { TJSONQWordNumber }
  308. TJSONQWordNumber = class(TJSONNumber)
  309. Private
  310. FValue : Qword;
  311. protected
  312. function GetAsBoolean: Boolean; override;
  313. function GetAsFloat: TJSONFloat; override;
  314. function GetAsInteger: Integer; override;
  315. function GetAsInt64: Int64; override;
  316. function GetAsQWord: QWord; override;
  317. procedure SetAsBoolean(const AValue: Boolean); override;
  318. procedure SetAsFloat(const AValue: TJSONFloat); override;
  319. procedure SetAsInteger(const AValue: Integer); override;
  320. procedure SetAsInt64(const AValue: Int64); override;
  321. procedure SetAsQword(const AValue: QWord); override;
  322. function GetAsJSON: TJSONStringType; override;
  323. function GetAsString: TJSONStringType; override;
  324. procedure SetAsString(const AValue: TJSONStringType); override;
  325. function GetValue: TJSONVariant; override;
  326. procedure SetValue(const AValue: TJSONVariant); override;
  327. public
  328. Constructor Create(AValue : QWord); reintroduce;
  329. class function NumberType : TJSONNumberType; override;
  330. Procedure Clear; override;
  331. Function Clone : TJSONData; override;
  332. end;
  333. TJSONQWordNumberClass = Class of TJSONQWordNumber;
  334. {$ENDIF}
  335. { TJSONString }
  336. TJSONString = class(TJSONData)
  337. Private
  338. FValue: TJSONStringType;
  339. protected
  340. function GetValue: TJSONVariant; override;
  341. procedure SetValue(const AValue: TJSONVariant); override;
  342. function GetAsBoolean: Boolean; override;
  343. function GetAsFloat: TJSONFloat; override;
  344. function GetAsInteger: Integer; override;
  345. {$IFNDEF PAS2JS}
  346. function GetAsInt64: Int64; override;
  347. function GetAsQWord: QWord; override;
  348. procedure SetAsInt64(const AValue: Int64); override;
  349. procedure SetAsQword(const AValue: QWord); override;
  350. {$ELSE}
  351. function GetAsNativeInt: NativeInt; override;
  352. procedure SetAsNativeInt(const AValue: NativeInt); override;
  353. {$ENDIF}
  354. procedure SetAsBoolean(const AValue: Boolean); override;
  355. procedure SetAsFloat(const AValue: TJSONFloat); override;
  356. procedure SetAsInteger(const AValue: Integer); override;
  357. function GetAsJSON: TJSONStringType; override;
  358. function GetAsString: TJSONStringType; override;
  359. procedure SetAsString(const AValue: TJSONStringType); override;
  360. Public
  361. Class var StrictEscaping : Boolean;
  362. public
  363. Constructor Create(const AValue : TJSONStringType); reintroduce;
  364. {$IFNDEF PAS2JS}
  365. Constructor Create(const AValue : TJSONUnicodeStringType); reintroduce;
  366. {$ENDIF}
  367. class function JSONType: TJSONType; override;
  368. Procedure Clear; override;
  369. Function Clone : TJSONData; override;
  370. end;
  371. TJSONStringClass = Class of TJSONString;
  372. { TJSONBoolean }
  373. TJSONBoolean = class(TJSONData)
  374. Private
  375. FValue: Boolean;
  376. protected
  377. function GetValue: TJSONVariant; override;
  378. procedure SetValue(const AValue: TJSONVariant); override;
  379. function GetAsBoolean: Boolean; override;
  380. function GetAsFloat: TJSONFloat; override;
  381. function GetAsInteger: Integer; override;
  382. {$IFNDEF PAS2JS}
  383. function GetAsInt64: Int64; override;
  384. function GetAsQWord: QWord; override;
  385. procedure SetAsInt64(const AValue: Int64); override;
  386. procedure SetAsQword(const AValue: QWord); override;
  387. {$ELSE}
  388. function GetAsNativeInt: NativeInt; override;
  389. procedure SetAsNativeInt(const AValue: NativeInt); override;
  390. {$ENDIF}
  391. procedure SetAsBoolean(const AValue: Boolean); override;
  392. procedure SetAsFloat(const AValue: TJSONFloat); override;
  393. procedure SetAsInteger(const AValue: Integer); override;
  394. function GetAsJSON: TJSONStringType; override;
  395. function GetAsString: TJSONStringType; override;
  396. procedure SetAsString(const AValue: TJSONStringType); override;
  397. public
  398. Constructor Create(AValue : Boolean); reintroduce;
  399. class function JSONType: TJSONType; override;
  400. Procedure Clear; override;
  401. Function Clone : TJSONData; override;
  402. end;
  403. TJSONBooleanClass = Class of TJSONBoolean;
  404. { TJSONnull }
  405. TJSONNull = class(TJSONData)
  406. protected
  407. Procedure Converterror(From : Boolean);
  408. function GetAsBoolean: Boolean; override;
  409. function GetAsFloat: TJSONFloat; override;
  410. function GetAsInteger: Integer; override;
  411. function GetIsNull: Boolean; override;
  412. function GetAsJSON: TJSONStringType; override;
  413. function GetAsString: TJSONStringType; override;
  414. function GetValue: TJSONVariant; override;
  415. {$IFNDEF PAS2JS}
  416. function GetAsInt64: Int64; override;
  417. function GetAsQWord: QWord; override;
  418. procedure SetAsInt64(const AValue: Int64); override;
  419. procedure SetAsQword(const AValue: QWord); override;
  420. {$ELSE}
  421. function GetAsNativeInt: NativeInt; override;
  422. procedure SetAsNativeInt(const AValue: NativeInt); override;
  423. {$ENDIF}
  424. procedure SetAsBoolean(const AValue: Boolean); override;
  425. procedure SetAsFloat(const AValue: TJSONFloat); override;
  426. procedure SetAsInteger(const AValue: Integer); override;
  427. procedure SetAsString(const AValue: TJSONStringType); override;
  428. procedure SetValue(const AValue: TJSONVariant); override;
  429. public
  430. class function JSONType: TJSONType; override;
  431. Procedure Clear; override;
  432. Function Clone : TJSONData; override;
  433. end;
  434. TJSONNullClass = Class of TJSONNull;
  435. TJSONArrayIterator = procedure(Item: TJSONData; Data: TObject; var Continue: Boolean) of object;
  436. { TJSONArray }
  437. TJSONObject = Class;
  438. TJSONArray = class(TJSONData)
  439. Private
  440. FList : TFPObjectList;
  441. function GetArrays(Index : Integer): TJSONArray;
  442. function GetBooleans(Index : Integer): Boolean;
  443. function GetFloats(Index : Integer): TJSONFloat;
  444. function GetIntegers(Index : Integer): Integer;
  445. function GetNulls(Index : Integer): Boolean;
  446. function GetObjects(Index : Integer): TJSONObject;
  447. function GetStrings(Index : Integer): TJSONStringType;
  448. function GetTypes(Index : Integer): TJSONType;
  449. {$IFNDEF PAS2JS}
  450. function GetInt64s(Index : Integer): Int64;
  451. function GetQWords(Index : Integer): QWord;
  452. function GetUnicodeStrings(Index : Integer): TJSONUnicodeStringType;
  453. procedure SetInt64s(Index : Integer; const AValue: Int64);
  454. procedure SetQWords(Index : Integer; AValue: QWord);
  455. procedure SetUnicodeStrings(Index : Integer; const AValue: TJSONUnicodeStringType);
  456. {$ELSE}
  457. function GetNativeInts(Index : Integer): NativeInt;
  458. procedure SetNativeInts(Index : Integer; AValue: NativeInt);
  459. {$ENDIF}
  460. procedure SetArrays(Index : Integer; const AValue: TJSONArray);
  461. procedure SetBooleans(Index : Integer; const AValue: Boolean);
  462. procedure SetFloats(Index : Integer; const AValue: TJSONFloat);
  463. procedure SetIntegers(Index : Integer; const AValue: Integer);
  464. procedure SetObjects(Index : Integer; const AValue: TJSONObject);
  465. procedure SetStrings(Index : Integer; const AValue: TJSONStringType);
  466. protected
  467. Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; override;
  468. Procedure Converterror(From : Boolean);
  469. function GetAsBoolean: Boolean; override;
  470. function GetAsFloat: TJSONFloat; override;
  471. function GetAsInteger: Integer; override;
  472. {$IFNDEF PAS2JS}
  473. function GetAsInt64: Int64; override;
  474. function GetAsQWord: QWord; override;
  475. procedure SetAsInt64(const AValue: Int64); override;
  476. procedure SetAsQword(const AValue: QWord); override;
  477. {$ELSE}
  478. function GetAsNativeInt: NativeInt; override;
  479. procedure SetAsNativeInt(const AValue: NativeInt); override;
  480. {$ENDIF}
  481. procedure SetAsBoolean(const AValue: Boolean); override;
  482. procedure SetAsFloat(const AValue: TJSONFloat); override;
  483. procedure SetAsInteger(const AValue: Integer); override;
  484. function GetAsJSON: TJSONStringType; override;
  485. function GetAsString: TJSONStringType; override;
  486. procedure SetAsString(const AValue: TJSONStringType); override;
  487. function GetValue: TJSONVariant; override;
  488. procedure SetValue(const AValue: TJSONVariant); override;
  489. function GetCount: Integer; override;
  490. function GetItem(Index : Integer): TJSONData; override;
  491. procedure SetItem(Index : Integer; const AValue: TJSONData); override;
  492. Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; override;
  493. public
  494. Constructor Create; overload; reintroduce;
  495. Constructor Create(const Elements : Array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF}); overload;
  496. Destructor Destroy; override;
  497. class function JSONType: TJSONType; override;
  498. Function Clone : TJSONData; override;
  499. // Examine
  500. procedure Iterate(Iterator : TJSONArrayIterator; Data: TObject);
  501. function IndexOf(obj: TJSONData): Integer;
  502. function GetEnumerator: TBaseJSONEnumerator; override;
  503. // Manipulate
  504. Procedure Clear; override;
  505. function Add(Item : TJSONData): Integer;
  506. function Add(I : Integer): Integer;
  507. {$IFNDEF PAS2JS}
  508. function Add(I : Int64): Int64;
  509. function Add(I : QWord): QWord;
  510. function Add(const S : UnicodeString): Integer;
  511. {$ELSE}
  512. function Add(I : NativeInt): Integer;
  513. {$ENDIF}
  514. function Add(const S : String): Integer;
  515. function Add: Integer;
  516. function Add(F : TJSONFloat): Integer;
  517. function Add(B : Boolean): Integer;
  518. function Add(AnArray : TJSONArray): Integer;
  519. function Add(AnObject: TJSONObject): Integer;
  520. Procedure Delete(Index : Integer);
  521. procedure Exchange(Index1, Index2: Integer);
  522. function Extract(Item: TJSONData): TJSONData;
  523. function Extract(Index : Integer): TJSONData;
  524. procedure Insert(Index: Integer);
  525. procedure Insert(Index: Integer; Item : TJSONData);
  526. procedure Insert(Index: Integer; I : Integer);
  527. {$IFNDEF PAS2JS}
  528. procedure Insert(Index: Integer; I : Int64);
  529. procedure Insert(Index: Integer; I : QWord);
  530. procedure Insert(Index: Integer; const S : UnicodeString);
  531. {$ELSE}
  532. procedure Insert(Index: Integer; I : NativeInt);
  533. {$ENDIF}
  534. procedure Insert(Index: Integer; const S : String);
  535. procedure Insert(Index: Integer; F : TJSONFloat);
  536. procedure Insert(Index: Integer; B : Boolean);
  537. procedure Insert(Index: Integer; AnArray : TJSONArray);
  538. procedure Insert(Index: Integer; AnObject: TJSONObject);
  539. procedure Move(CurIndex, NewIndex: Integer);
  540. Procedure Remove(Item : TJSONData);
  541. Procedure Sort(Compare: TListSortCompare);
  542. // Easy Access Properties.
  543. property Items;default;
  544. Property Types[Index : Integer] : TJSONType Read GetTypes;
  545. Property Nulls[Index : Integer] : Boolean Read GetNulls;
  546. Property Integers[Index : Integer] : Integer Read GetIntegers Write SetIntegers;
  547. {$IFNDEF PAS2JS}
  548. Property Int64s[Index : Integer] : Int64 Read GetInt64s Write SetInt64s;
  549. Property LargeInts[Index : Integer] : TJSONLargeInt Read GetInt64s Write SetInt64s;
  550. Property QWords[Index : Integer] : QWord Read GetQWords Write SetQWords;
  551. Property UnicodeStrings[Index : Integer] : TJSONUnicodeStringType Read GetUnicodeStrings Write SetUnicodeStrings;
  552. {$ELSE}
  553. Property NativeInts[Index : Integer] : NativeInt Read GetNativeInts Write SetNativeInts;
  554. Property LargeInts[Index : Integer] : TJSONLargeInt Read GetNativeInts Write SetNativeInts;
  555. {$ENDIF}
  556. Property Strings[Index : Integer] : TJSONStringType Read GetStrings Write SetStrings;
  557. Property Floats[Index : Integer] : TJSONFloat Read GetFloats Write SetFloats;
  558. Property Booleans[Index : Integer] : Boolean Read GetBooleans Write SetBooleans;
  559. Property Arrays[Index : Integer] : TJSONArray Read GetArrays Write SetArrays;
  560. Property Objects[Index : Integer] : TJSONObject Read GetObjects Write SetObjects;
  561. end;
  562. TJSONArrayClass = Class of TJSONArray;
  563. TJSONObjectIterator = procedure(Const AName : TJSONStringType; Item: TJSONData; Data: TObject; var Continue: Boolean) of object;
  564. { TJSONObject }
  565. TJSONObject = class(TJSONData)
  566. private
  567. Const
  568. ElementStart : Array[Boolean] of TJSONStringType = ('"','');
  569. SpacedQuoted : Array[Boolean] of TJSONStringType = ('" : ',' : ');
  570. UnSpacedQuoted : Array[Boolean] of TJSONStringType = ('":',':');
  571. ObjStartSeps : Array[Boolean] of TJSONStringType = ('{ ','{');
  572. ObjEndSeps : Array[Boolean] of TJSONStringType = (' }','}');
  573. Class var FUnquotedMemberNames: Boolean;
  574. Class var FObjStartSep,FObjEndSep,FElementEnd,FElementStart : TJSONStringType;
  575. function DoAdd(const AName: TJSONStringType; AValue: TJSONData; FreeOnError: Boolean=True): Integer;
  576. Class procedure DetermineElementQuotes;
  577. Private
  578. {$IFDEF PAS2JS}
  579. FCount: integer;
  580. FHash: TJSObject;
  581. FNames: TStringDynArray;
  582. {$else}
  583. FHash : TFPHashObjectList; // Careful : Names limited to 255 chars.
  584. {$ENDIF}
  585. function GetArrays(const AName : String): TJSONArray;
  586. function GetBooleans(const AName : String): Boolean;
  587. function GetElements(const AName: string): TJSONData;
  588. function GetFloats(const AName : String): TJSONFloat;
  589. function GetIntegers(const AName : String): Integer;
  590. function GetIsNull(const AName : String): Boolean; reintroduce;
  591. function GetNameOf(Index : Integer): TJSONStringType;
  592. function GetObjects(const AName : String): TJSONObject;
  593. function GetStrings(const AName : String): TJSONStringType;
  594. function GetTypes(const AName : String): TJSONType;
  595. procedure SetArrays(const AName : String; const AValue: TJSONArray);
  596. procedure SetBooleans(const AName : String; const AValue: Boolean);
  597. procedure SetElements(const AName: string; const AValue: TJSONData);
  598. procedure SetFloats(const AName : String; const AValue: TJSONFloat);
  599. procedure SetIntegers(const AName : String; const AValue: Integer);
  600. {$IFNDEF PAS2JS}
  601. function GetInt64s(const AName : String): Int64;
  602. function GetUnicodeStrings(const AName : String): TJSONUnicodeStringType;
  603. function GetQWords(AName : String): QWord;
  604. procedure SetInt64s(const AName : String; const AValue: Int64);
  605. procedure SetQWords(AName : String; AValue: QWord);
  606. procedure SetUnicodeStrings(const AName : String; const AValue: TJSONUnicodeStringType);
  607. {$ELSE}
  608. function GetNativeInts(const AName : String): NativeInt;
  609. procedure SetNativeInts(const AName : String; const AValue: NativeInt);
  610. {$ENDIF}
  611. procedure SetIsNull(const AName : String; const AValue: Boolean);
  612. procedure SetObjects(const AName : String; const AValue: TJSONObject);
  613. procedure SetStrings(const AName : String; const AValue: TJSONStringType);
  614. class function GetUnquotedMemberNames: Boolean; {$IFNDEF PAS2JS}static;{$ENDIF}
  615. class procedure SetUnquotedMemberNames(AValue: Boolean); {$IFNDEF PAS2JS}static;{$ENDIF}
  616. protected
  617. Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; override;
  618. Procedure Converterror(From : Boolean);
  619. function GetAsBoolean: Boolean; override;
  620. function GetAsFloat: TJSONFloat; override;
  621. function GetAsInteger: Integer; override;
  622. {$IFNDEF PAS2JS}
  623. function GetAsInt64: Int64; override;
  624. function GetAsQWord: QWord; override;
  625. procedure SetAsInt64(const AValue: Int64); override;
  626. procedure SetAsQword(const AValue: QWord); override;
  627. {$ELSE}
  628. function GetAsNativeInt: NativeInt; override;
  629. procedure SetAsNativeInt(const AValue: NativeInt); override;
  630. {$ENDIF}
  631. procedure SetAsBoolean(const AValue: Boolean); override;
  632. procedure SetAsFloat(const AValue: TJSONFloat); override;
  633. procedure SetAsInteger(const AValue: Integer); override;
  634. function GetAsJSON: TJSONStringType; override;
  635. function GetAsString: TJSONStringType; override;
  636. procedure SetAsString(const AValue: TJSONStringType); override;
  637. function GetValue: TJSONVariant; override;
  638. procedure SetValue(const AValue: TJSONVariant); override;
  639. function GetCount: Integer; override;
  640. function GetItem(Index : Integer): TJSONData; override;
  641. procedure SetItem(Index : Integer; const AValue: TJSONData); override;
  642. Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; override;
  643. public
  644. constructor Create; reintroduce;
  645. Constructor Create(const Elements : Array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF}); overload;
  646. destructor Destroy; override;
  647. class function JSONType: TJSONType; override;
  648. Class Property UnquotedMemberNames : Boolean Read GetUnquotedMemberNames Write SetUnquotedMemberNames;
  649. Function Clone : TJSONData; override;
  650. function GetEnumerator: TBaseJSONEnumerator; override;
  651. // Examine
  652. procedure Iterate(Iterator : TJSONObjectIterator; Data: TObject);
  653. function IndexOf(Item: TJSONData): Integer;
  654. Function IndexOfName(const AName: TJSONStringType; CaseInsensitive : Boolean = False): Integer;
  655. Function Find(Const AName : String) : TJSONData; overload;
  656. Function Find(Const AName : String; AType : TJSONType) : TJSONData; overload;
  657. function Find(const key: TJSONStringType; out AValue: TJSONData): boolean;
  658. function Find(const key: TJSONStringType; out AValue: TJSONObject): boolean;
  659. function Find(const key: TJSONStringType; out AValue: TJSONArray): boolean;
  660. function Find(const key: TJSONStringType; out AValue: TJSONString): boolean;
  661. function Find(const key: TJSONStringType; out AValue: TJSONBoolean): boolean;
  662. function Find(const key: TJSONStringType; out AValue: TJSONNumber): boolean;
  663. Function Get(Const AName : String) : TJSONVariant;
  664. Function Get(Const AName : String; ADefault : TJSONFloat) : TJSONFloat;
  665. Function Get(Const AName : String; ADefault : Integer) : Integer;
  666. {$IFNDEF PAS2JS}
  667. Function Get(Const AName : String; ADefault : Int64) : Int64;
  668. Function Get(Const AName : String; ADefault : QWord) : QWord;
  669. Function Get(Const AName : String; ADefault : TJSONUnicodeStringType) : TJSONUnicodeStringType;
  670. {$ENDIF}
  671. Function Get(Const AName : String; ADefault : Boolean) : Boolean;
  672. Function Get(Const AName : String; ADefault : TJSONStringType) : TJSONStringType;
  673. Function Get(Const AName : String; ADefault : TJSONArray) : TJSONArray;
  674. Function Get(Const AName : String; ADefault : TJSONObject) : TJSONObject;
  675. // Manipulate
  676. Procedure Clear; override;
  677. function Add(const AName: TJSONStringType; AValue: TJSONData): Integer; overload;
  678. function Add(const AName: TJSONStringType; AValue: Boolean): Integer; overload;
  679. function Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer; overload;
  680. function Add(const AName, AValue: TJSONStringType): Integer; overload;
  681. {$IFNDEF PAS2JS}
  682. function Add(const AName : String; AValue: TJSONUnicodeStringType): Integer; overload;
  683. function Add(const AName: TJSONStringType; Avalue: Int64): Integer; overload;
  684. function Add(const AName: TJSONStringType; Avalue: QWord): Integer; overload;
  685. {$ELSE}
  686. function Add(const AName: TJSONStringType; Avalue: NativeInt): Integer; overload;
  687. {$ENDIF}
  688. function Add(const AName: TJSONStringType; Avalue: Integer): Integer; overload;
  689. function Add(const AName: TJSONStringType): Integer; overload;
  690. function Add(const AName: TJSONStringType; AValue : TJSONArray): Integer; overload;
  691. procedure Delete(Index : Integer);
  692. procedure Delete(Const AName : string);
  693. procedure Remove(Item : TJSONData);
  694. Function Extract(Index : Integer) : TJSONData;
  695. Function Extract(Const AName : string) : TJSONData;
  696. // Easy access properties.
  697. property Names[Index : Integer] : TJSONStringType read GetNameOf;
  698. property Elements[AName: string] : TJSONData read GetElements write SetElements; default;
  699. Property Types[AName : String] : TJSONType Read GetTypes;
  700. Property Nulls[AName : String] : Boolean Read GetIsNull Write SetIsNull;
  701. Property Floats[AName : String] : TJSONFloat Read GetFloats Write SetFloats;
  702. Property Integers[AName : String] : Integer Read GetIntegers Write SetIntegers;
  703. {$IFNDEF PAS2JS}
  704. Property Int64s[AName : String] : Int64 Read GetInt64s Write SetInt64s;
  705. Property QWords[AName : String] : QWord Read GetQWords Write SetQWords;
  706. Property LargeInts[AName : String] : TJSONLargeInt Read GetInt64s Write SetInt64s;
  707. Property UnicodeStrings[AName : String] : TJSONUnicodeStringType Read GetUnicodeStrings Write SetUnicodeStrings;
  708. {$ELSE}
  709. Property NativeInts[AName : String] : NativeInt Read GetNativeInts Write SetNativeInts;
  710. Property LargeInts[AName : String] : TJSONLargeInt Read GetNativeInts Write SetNativeInts;
  711. {$ENDIF}
  712. Property Strings[AName : String] : TJSONStringType Read GetStrings Write SetStrings;
  713. Property Booleans[AName : String] : Boolean Read GetBooleans Write SetBooleans;
  714. Property Arrays[AName : String] : TJSONArray Read GetArrays Write SetArrays;
  715. Property Objects[AName : String] : TJSONObject Read GetObjects Write SetObjects;
  716. end;
  717. TJSONObjectClass = Class of TJSONObject;
  718. EJSON = Class(Exception);
  719. TJSONParserHandler = Procedure(AStream : TStream; Const AUseUTF8 : Boolean; Out Data : TJSONData);
  720. TJSONStringParserHandler = Procedure(Const aJSON : TJSONStringType; Const AUseUTF8 : Boolean; Out Data : TJSONData);
  721. Function SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass) : TJSONDataClass;
  722. Function GetJSONInstanceType(AType : TJSONInstanceType) : TJSONDataClass;
  723. Function StringToJSONString(const S : TJSONStringType; Strict : Boolean = False) : TJSONStringType;
  724. Function JSONStringToString(const S : TJSONStringType) : TJSONStringType;
  725. Function JSONTypeName(JSONType : TJSONType) : String;
  726. // These functions create JSONData structures, taking into account the instance types
  727. Function CreateJSON : TJSONNull;
  728. Function CreateJSON(Data : Boolean) : TJSONBoolean;
  729. Function CreateJSON(Data : Integer) : TJSONIntegerNumber;
  730. {$IFNDEF PAS2JS}
  731. Function CreateJSON(Data : Int64) : TJSONInt64Number;
  732. Function CreateJSON(Data : QWord) : TJSONQWordNumber;
  733. {$ELSE}
  734. Function CreateJSON(Data : NativeInt) : TJSONNativeIntNumber;
  735. {$ENDIF}
  736. Function CreateJSON(Data : TJSONFloat) : TJSONFloatNumber;
  737. Function CreateJSON(const Data : TJSONStringType) : TJSONString;
  738. {$IFNDEF PAS2JS}
  739. Function CreateJSON(const Data : TJSONUnicodeStringType) : TJSONString;
  740. {$ENDIF}
  741. Function CreateJSONArray(const Data : Array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF}) : TJSONArray;
  742. Function CreateJSONObject(const Data : Array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF}) : TJSONObject;
  743. // These functions rely on a callback. If the callback is not set, they will raise an error.
  744. // When the jsonparser unit is included in the project, the callback is automatically set.
  745. Function GetJSON(Const JSON : TJSONStringType; Const UseUTF8 : Boolean = True) : TJSONData;
  746. Function GetJSON(Const JSON : TStream; Const UseUTF8 : Boolean = True) : TJSONData;
  747. Function SetJSONParserHandler(AHandler : TJSONParserHandler) : TJSONParserHandler;
  748. Function SetJSONStringParserHandler(AHandler : TJSONStringParserHandler) : TJSONStringParserHandler;
  749. Function GetJSONParserHandler : TJSONParserHandler;
  750. Function GetJSONStringParserHandler: TJSONStringParserHandler;
  751. implementation
  752. Uses typinfo;
  753. Resourcestring
  754. SErrCannotConvertFromNull = 'Cannot convert data from Null value';
  755. SErrCannotConvertToNull = 'Cannot convert data to Null value';
  756. SErrCannotConvertFromArray = 'Cannot convert data from array value';
  757. SErrCannotConvertToArray = 'Cannot convert data to array value';
  758. SErrCannotConvertFromObject = 'Cannot convert data from object value';
  759. SErrCannotConvertToObject = 'Cannot convert data to object value';
  760. SErrInvalidFloat = 'Invalid float value : %s';
  761. SErrCannotSetNotIsNull = 'IsNull cannot be set to False';
  762. SErrCannotAddArrayTwice = 'Adding an array object to an array twice is not allowed';
  763. SErrCannotAddObjectTwice = 'Adding an object to an array twice is not allowed';
  764. SErrNotJSONData = 'Cannot add object of type %s to TJSON%s';
  765. SErrOddNumber = 'TJSONObject must be constructed with name,value pairs';
  766. SErrNameMustBeString = 'TJSONObject constructor element name at pos %d is not a string';
  767. SErrNonexistentElement = 'Unknown object member: "%s"';
  768. SErrDuplicateValue = 'Duplicate object member: "%s"';
  769. SErrPathElementNotFound = 'Path "%s" invalid: element "%s" not found.';
  770. SErrWrongInstanceClass = 'Cannot set instance class: %s does not descend from %s.';
  771. {$IFNDEF PAS2JS}
  772. SErrPointerNotNil = 'Cannot add non-nil pointer to JSON%s';
  773. SErrUnknownTypeInConstructor = 'Unknown type in JSON%s constructor: %d';
  774. {$ELSE}
  775. SErrUnknownTypeInConstructor = 'Unknown type in JSON%s constructor: %s';
  776. {$ENDIF}
  777. SErrNoParserHandler = 'No JSON parser handler installed. Recompile your project with the jsonparser unit included';
  778. Var
  779. DefaultJSONInstanceTypes :
  780. Array [TJSONInstanceType] of TJSONDataClass = (
  781. TJSONData,
  782. TJSONIntegerNumber,
  783. {$IFNDEF PAS2JS}
  784. TJSONInt64Number,
  785. TJSONQWordNumber,
  786. {$ELSE}
  787. TJSONNativeIntNumber,
  788. {$ENDIF}
  789. TJSONFloatNumber,
  790. TJSONString,
  791. TJSONBoolean,
  792. TJSONNull,
  793. TJSONArray,
  794. TJSONObject);
  795. Const
  796. MinJSONInstanceTypes :
  797. Array [TJSONInstanceType] of TJSONDataClass = (
  798. TJSONData,
  799. TJSONIntegerNumber,
  800. {$IFNDEF PAS2JS}
  801. TJSONInt64Number,
  802. TJSONQWordNumber,
  803. {$else}
  804. TJSONNativeIntNumber,
  805. {$ENDIF}
  806. TJSONFloatNumber,
  807. TJSONString,
  808. TJSONBoolean,
  809. TJSONNull,
  810. TJSONArray,
  811. TJSONObject
  812. );
  813. function SetJSONInstanceType(AType: TJSONInstanceType; AClass: TJSONDataClass): TJSONDataClass;
  814. begin
  815. if AClass=Nil then
  816. TJSONData.DoError(SErrWrongInstanceClass,['Nil',MinJSONInstanceTypes[AType].ClassName]);
  817. if Not AClass.InheritsFrom(MinJSONINstanceTypes[AType]) then
  818. TJSONData.DoError(SErrWrongInstanceClass,[AClass.ClassName,MinJSONInstanceTypes[AType].ClassName]);
  819. Result:=DefaultJSONInstanceTypes[AType];
  820. DefaultJSONINstanceTypes[AType]:=AClass;
  821. end;
  822. function GetJSONInstanceType(AType: TJSONInstanceType): TJSONDataClass;
  823. begin
  824. Result:=DefaultJSONInstanceTypes[AType]
  825. end;
  826. function StringToJSONString(const S: TJSONStringType; Strict : Boolean = False): TJSONStringType;
  827. Var
  828. I,J,L : Integer;
  829. C : Char;
  830. begin
  831. I:=1;
  832. J:=1;
  833. Result:='';
  834. L:=Length(S);
  835. While I<=L do
  836. begin
  837. C:=S[I];
  838. if (C in ['"','/','\',#0..#31]) then
  839. begin
  840. Result:=Result+Copy(S,J,I-J);
  841. Case C of
  842. '\' : Result:=Result+'\\';
  843. '/' : if Strict then
  844. Result:=Result+'\/'
  845. else
  846. Result:=Result+'/';
  847. '"' : Result:=Result+'\"';
  848. #8 : Result:=Result+'\b';
  849. #9 : Result:=Result+'\t';
  850. #10 : Result:=Result+'\n';
  851. #12 : Result:=Result+'\f';
  852. #13 : Result:=Result+'\r';
  853. else
  854. Result:=Result+'\u'+HexStr(Ord(C),4);
  855. end;
  856. J:=I+1;
  857. end;
  858. Inc(I);
  859. end;
  860. Result:=Result+Copy(S,J,I-1);
  861. end;
  862. function JSONStringToString(const S: TJSONStringType): TJSONStringType;
  863. {$IFDEF PAS2JS}
  864. Var
  865. J : JSValue;
  866. OK : Boolean;
  867. begin
  868. OK:=False;
  869. try
  870. J:=TJSJSON.parse('"'+S+'"');
  871. if isString(J) then
  872. begin
  873. Result:=String(J);
  874. OK:=True;
  875. end;
  876. except
  877. OK:=False;
  878. end;
  879. if not OK then
  880. Raise EConvertError.Create('Invalid JSON String:'+S);
  881. end;
  882. {$ELSE}
  883. Var
  884. I,J,L,U1,U2 : Integer;
  885. App,W : String;
  886. Procedure MaybeAppendUnicode;
  887. Var
  888. U : String;
  889. begin
  890. if (U1<>0) then
  891. begin
  892. U:={$IFDEF FPC_HAS_CPSTRING}UTF8Encode(WideChar(U1)){$ELSE}widechar(U1){$ENDIF};
  893. Result:=Result+U;
  894. U1:=0;
  895. end;
  896. end;
  897. begin
  898. I:=1;
  899. J:=1;
  900. L:=Length(S);
  901. Result:='';
  902. U1:=0;
  903. While (I<=L) do
  904. begin
  905. if (S[I]='\') then
  906. begin
  907. Result:=Result+Copy(S,J,I-J);
  908. If I<L then
  909. begin
  910. Inc(I);
  911. App:='';
  912. Case S[I] of
  913. '\','"','/'
  914. : App:=S[I];
  915. 'b' : App:=#8;
  916. 't' : App:=#9;
  917. 'n' : App:=#10;
  918. 'f' : App:=#12;
  919. 'r' : App:=#13;
  920. 'u' : begin
  921. W:=Copy(S,I+1,4);
  922. Inc(I,4);
  923. u2:=StrToInt('$'+W);
  924. if (U1<>0) then
  925. begin
  926. App:={$IFDEF FPC_HAS_CPSTRING}UTF8Encode({$ENDIF}WideChar(U1)+WideChar(U2){$IFDEF FPC_HAS_CPSTRING}){$ENDIF};
  927. writeln('app a: ',L,': ',App);
  928. U2:=0;
  929. end
  930. else
  931. begin
  932. writeln('app b: ',L,': ',WideChar(U2));
  933. U1:=U2;
  934. end;
  935. end;
  936. end;
  937. if App<>'' then
  938. begin
  939. MaybeAppendUnicode;
  940. Result:=Result+App;
  941. end;
  942. end;
  943. J:=I+1;
  944. end
  945. else
  946. MaybeAppendUnicode;
  947. Inc(I);
  948. end;
  949. MaybeAppendUnicode;
  950. Result:=Result+Copy(S,J,I-J+1);
  951. end;
  952. {$ENDIF}
  953. function JSONTypeName(JSONType: TJSONType): String;
  954. begin
  955. Result:=GetEnumName(TypeInfo(TJSONType),Ord(JSONType));
  956. end;
  957. function CreateJSON: TJSONNull;
  958. begin
  959. Result:=TJSONNullClass(DefaultJSONInstanceTypes[jitNull]).Create
  960. end;
  961. function CreateJSON(Data: Boolean): TJSONBoolean;
  962. begin
  963. Result:=TJSONBooleanClass(DefaultJSONInstanceTypes[jitBoolean]).Create(Data);
  964. end;
  965. function CreateJSON(Data: Integer): TJSONIntegerNumber;
  966. begin
  967. Result:=TJSONIntegerNumberCLass(DefaultJSONInstanceTypes[jitNumberInteger]).Create(Data);
  968. end;
  969. {$IFNDEF PAS2JS}
  970. function CreateJSON(Data: Int64): TJSONInt64Number;
  971. begin
  972. Result:=TJSONInt64NumberCLass(DefaultJSONInstanceTypes[jitNumberInt64]).Create(Data);
  973. end;
  974. function CreateJSON(Data: QWord): TJSONQWordNumber;
  975. begin
  976. Result:=TJSONQWordNumberClass(DefaultJSONInstanceTypes[jitNumberQWord]).Create(Data);
  977. end;
  978. {$ELSE}
  979. function CreateJSON(Data: NativeInt): TJSONNativeIntNumber;
  980. begin
  981. Result:=TJSONNativeIntNumberCLass(DefaultJSONInstanceTypes[jitNumberNativeInt]).Create(Data);
  982. end;
  983. {$ENDIF}
  984. function CreateJSON(Data: TJSONFloat): TJSONFloatNumber;
  985. begin
  986. Result:=TJSONFloatNumberCLass(DefaultJSONInstanceTypes[jitNumberFloat]).Create(Data);
  987. end;
  988. function CreateJSON(const Data: TJSONStringType): TJSONString;
  989. begin
  990. Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
  991. end;
  992. {$IFNDEF PAS2JS}
  993. function CreateJSON(const Data: TJSONUnicodeStringType): TJSONString;
  994. begin
  995. Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
  996. end;
  997. {$ENDIF}
  998. function CreateJSONArray(const Data: array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF}): TJSONArray;
  999. begin
  1000. Result:=TJSONArrayCLass(DefaultJSONInstanceTypes[jitArray]).Create(Data);
  1001. end;
  1002. function CreateJSONObject(const Data: array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF}): TJSONObject;
  1003. begin
  1004. Result:=TJSONObjectClass(DefaultJSONInstanceTypes[jitObject]).Create(Data);
  1005. end;
  1006. Var
  1007. JPH : TJSONParserHandler;
  1008. JPSH : TJSONStringParserHandler;
  1009. function GetJSON(const JSON: TJSONStringType; const UseUTF8: Boolean): TJSONData;
  1010. Var
  1011. SS : TStringStream;
  1012. begin
  1013. if Assigned(JPSH) then
  1014. JPSH(JSON,UseUTF8,Result)
  1015. else
  1016. begin
  1017. {$IF FPC_FULLVERSION>30300}
  1018. if UseUTF8 then
  1019. SS:=TStringStream.Create(JSON,TEncoding.UTF8)
  1020. else
  1021. {$ENDIF}
  1022. SS:=TStringStream.Create(JSON);
  1023. try
  1024. Result:=GetJSON(SS,UseUTF8);
  1025. finally
  1026. SS.Free;
  1027. end;
  1028. end;
  1029. end;
  1030. function GetJSON(const JSON: TStream; const UseUTF8: Boolean): TJSONData;
  1031. Var
  1032. SS : TStringStream;
  1033. begin
  1034. Result:=Nil;
  1035. If (JPH<>Nil) then
  1036. JPH(JSON,UseUTF8,Result)
  1037. else if JPSH=Nil then
  1038. TJSONData.DoError(SErrNoParserHandler)
  1039. else
  1040. begin
  1041. {$IFNDEF PAS3JS}
  1042. SS:=TStringStream.Create('');
  1043. {$ELSE}
  1044. if UseUTF8 Then
  1045. SS:=TStringStream.Create('',TENcoding.UTF8)
  1046. else
  1047. SS:=TStringStream.Create('');
  1048. {$ENDIF}
  1049. try
  1050. SS.CopyFrom(JSON,0);
  1051. JPSH(SS.DataString,False,Result);
  1052. finally
  1053. SS.Free;
  1054. end;
  1055. end;
  1056. end;
  1057. Function SetJSONStringParserHandler(AHandler : TJSONStringParserHandler) : TJSONStringParserHandler;
  1058. begin
  1059. Result:=JPSH;
  1060. JPSH:=AHandler;
  1061. end;
  1062. function SetJSONParserHandler(AHandler: TJSONParserHandler): TJSONParserHandler;
  1063. begin
  1064. Result:=JPH;
  1065. JPH:=AHandler;
  1066. end;
  1067. function GetJSONParserHandler: TJSONParserHandler;
  1068. begin
  1069. Result:=JPH;
  1070. end;
  1071. function GetJSONStringParserHandler: TJSONStringParserHandler;
  1072. begin
  1073. Result:=JPSH;
  1074. end;
  1075. Type
  1076. { TJSONEnumerator }
  1077. TJSONEnumerator = class(TBaseJSONEnumerator)
  1078. Private
  1079. FData : TJSONData;
  1080. public
  1081. Constructor Create(AData : TJSONData);
  1082. function GetCurrent: TJSONEnum; override;
  1083. function MoveNext : Boolean; override;
  1084. end;
  1085. { TJSONArrayEnumerator }
  1086. TJSONArrayEnumerator = class(TBaseJSONEnumerator)
  1087. Private
  1088. FData : TJSONArray;
  1089. FCurrent : Integer;
  1090. public
  1091. Constructor Create(AData : TJSONArray);
  1092. function GetCurrent: TJSONEnum; override;
  1093. function MoveNext : Boolean; override;
  1094. end;
  1095. { TJSONObjectEnumerator }
  1096. TJSONObjectEnumerator = class(TBaseJSONEnumerator)
  1097. Private
  1098. FData : TJSONObject;
  1099. FCurrent : Integer;
  1100. public
  1101. Constructor Create(AData : TJSONObject);
  1102. function GetCurrent: TJSONEnum; override;
  1103. function MoveNext : Boolean; override;
  1104. end;
  1105. {$IFNDEF PAS2JS}
  1106. { TJSONQWordNumber }
  1107. function TJSONQWordNumber.GetAsBoolean: Boolean;
  1108. begin
  1109. Result:=FValue<>0;
  1110. end;
  1111. function TJSONQWordNumber.GetAsFloat: TJSONFloat;
  1112. begin
  1113. Result:= FValue;
  1114. end;
  1115. function TJSONQWordNumber.GetAsInteger: Integer;
  1116. begin
  1117. Result := FValue;
  1118. end;
  1119. function TJSONQWordNumber.GetAsInt64: Int64;
  1120. begin
  1121. Result := FValue;
  1122. end;
  1123. function TJSONQWordNumber.GetAsQWord: QWord;
  1124. begin
  1125. Result := FValue;
  1126. end;
  1127. procedure TJSONQWordNumber.SetAsBoolean(const AValue: Boolean);
  1128. begin
  1129. FValue:=Ord(AValue);
  1130. end;
  1131. procedure TJSONQWordNumber.SetAsFloat(const AValue: TJSONFloat);
  1132. begin
  1133. FValue:=Round(AValue);
  1134. end;
  1135. procedure TJSONQWordNumber.SetAsInteger(const AValue: Integer);
  1136. begin
  1137. FValue:=AValue;
  1138. end;
  1139. procedure TJSONQWordNumber.SetAsInt64(const AValue: Int64);
  1140. begin
  1141. FValue := AValue;
  1142. end;
  1143. procedure TJSONQWordNumber.SetAsQword(const AValue: QWord);
  1144. begin
  1145. FValue:=AValue;
  1146. end;
  1147. function TJSONQWordNumber.GetAsJSON: TJSONStringType;
  1148. begin
  1149. Result:=AsString;
  1150. end;
  1151. function TJSONQWordNumber.GetAsString: TJSONStringType;
  1152. begin
  1153. Result:=IntToStr(FValue);
  1154. end;
  1155. procedure TJSONQWordNumber.SetAsString(const AValue: TJSONStringType);
  1156. begin
  1157. FValue:=StrToQWord(AValue);
  1158. end;
  1159. function TJSONQWordNumber.GetValue: TJSONVariant;
  1160. begin
  1161. Result:=FValue;
  1162. end;
  1163. procedure TJSONQWordNumber.SetValue(const AValue: TJSONVariant);
  1164. begin
  1165. FValue:=AValue;
  1166. end;
  1167. constructor TJSONQWordNumber.Create(AValue: QWord);
  1168. begin
  1169. FValue := AValue;
  1170. end;
  1171. class function TJSONQWordNumber.NumberType: TJSONNumberType;
  1172. begin
  1173. Result:=ntQWord;
  1174. end;
  1175. procedure TJSONQWordNumber.Clear;
  1176. begin
  1177. FValue:=0;
  1178. end;
  1179. function TJSONQWordNumber.Clone: TJSONData;
  1180. begin
  1181. Result:=TJSONQWordNumberClass(ClassType).Create(Self.FValue);
  1182. end;
  1183. {$ENDIF}
  1184. { TJSONObjectEnumerator }
  1185. constructor TJSONObjectEnumerator.Create(AData: TJSONObject);
  1186. begin
  1187. FData:=AData;
  1188. FCurrent:=-1;
  1189. end;
  1190. function TJSONObjectEnumerator.GetCurrent: TJSONEnum;
  1191. begin
  1192. Result.KeyNum:=FCurrent;
  1193. Result.Key:=FData.Names[FCurrent];
  1194. Result.Value:=FData.Items[FCurrent];
  1195. end;
  1196. function TJSONObjectEnumerator.MoveNext: Boolean;
  1197. begin
  1198. Inc(FCurrent);
  1199. Result:=FCurrent<FData.Count;
  1200. end;
  1201. { TJSONArrayEnumerator }
  1202. constructor TJSONArrayEnumerator.Create(AData: TJSONArray);
  1203. begin
  1204. FData:=AData;
  1205. FCurrent:=-1;
  1206. end;
  1207. function TJSONArrayEnumerator.GetCurrent: TJSONEnum;
  1208. begin
  1209. Result.KeyNum:=FCurrent;
  1210. Result.Key:=IntToStr(FCurrent);
  1211. Result.Value:=FData.Items[FCurrent];
  1212. end;
  1213. function TJSONArrayEnumerator.MoveNext: Boolean;
  1214. begin
  1215. Inc(FCurrent);
  1216. Result:=FCurrent<FData.Count;
  1217. end;
  1218. { TJSONEnumerator }
  1219. constructor TJSONEnumerator.Create(AData: TJSONData);
  1220. begin
  1221. FData:=AData;
  1222. end;
  1223. function TJSONEnumerator.GetCurrent: TJSONEnum;
  1224. begin
  1225. Result.Key:='';
  1226. Result.KeyNum:=0;
  1227. Result.Value:=FData;
  1228. FData:=Nil;
  1229. end;
  1230. function TJSONEnumerator.MoveNext: Boolean;
  1231. begin
  1232. Result:=FData<>Nil;
  1233. end;
  1234. { TJSONData }
  1235. {$IFNDEF PAS2JS}
  1236. function TJSONData.GetAsUnicodeString: TJSONUnicodeStringType;
  1237. begin
  1238. Result:=UTF8Decode(AsString);
  1239. end;
  1240. procedure TJSONData.SetAsUnicodeString(const AValue: TJSONUnicodeStringType);
  1241. begin
  1242. AsString:=UTF8Encode(AValue);
  1243. end;
  1244. {$ENDIF}
  1245. function TJSONData.GetItem(Index : Integer): TJSONData;
  1246. begin
  1247. Result:=nil;
  1248. if Index>0 then ;
  1249. end;
  1250. function TJSONData.GetCount: Integer;
  1251. begin
  1252. Result:=0;
  1253. end;
  1254. constructor TJSONData.Create;
  1255. begin
  1256. Clear;
  1257. end;
  1258. procedure TJSONData.DumpJSON(S: TFPJSStream);
  1259. Procedure W(T : String);
  1260. begin
  1261. if T='' then exit;
  1262. {$IFDEF PAS2JS}
  1263. S.push(T);
  1264. {$else}
  1265. S.WriteBuffer(T[1],Length(T)*SizeOf(Char));
  1266. {$ENDIF}
  1267. end;
  1268. Var
  1269. I: Integer;
  1270. O : TJSONObject;
  1271. begin
  1272. Case JSONType of
  1273. jtObject :
  1274. begin
  1275. O:=TJSONObject(Self);
  1276. W('{');
  1277. For I:=0 to O.Count-1 do
  1278. begin
  1279. if (I>0) then
  1280. W(',');
  1281. W('"');
  1282. W(StringToJSONString(O.Names[i],False));
  1283. W('":');
  1284. O.Items[I].DumpJSON(S);
  1285. end;
  1286. W('}');
  1287. end;
  1288. jtArray :
  1289. begin
  1290. W('[');
  1291. For I:=0 to Count-1 do
  1292. begin
  1293. if (I>0) then
  1294. W(',');
  1295. Items[I].DumpJSON(S);
  1296. end;
  1297. W(']');
  1298. end
  1299. else
  1300. W(AsJSON)
  1301. end;
  1302. end;
  1303. class function TJSONData.GetCompressedJSON: Boolean; {$IFNDEF PAS2JS}static;{$ENDIF}
  1304. begin
  1305. Result:=FCompressedJSON;
  1306. end;
  1307. class procedure TJSONData.DetermineElementSeparators;
  1308. begin
  1309. FElementSep:=ElementSeps[FCompressedJSON];
  1310. end;
  1311. class procedure TJSONData.SetCompressedJSON(AValue: Boolean); {$IFNDEF PAS2JS}static;{$ENDIF}
  1312. begin
  1313. if AValue=FCompressedJSON then exit;
  1314. FCompressedJSON:=AValue;
  1315. DetermineElementSeparators;
  1316. TJSONObject.DetermineElementQuotes;
  1317. end;
  1318. class procedure TJSONData.DoError(const Msg: String);
  1319. begin
  1320. Raise EJSON.Create(Msg);
  1321. end;
  1322. class procedure TJSONData.DoError(const Fmt: String;
  1323. const Args: array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF});
  1324. begin
  1325. Raise EJSON.CreateFmt(Fmt,Args);
  1326. end;
  1327. function TJSONData.DoFindPath(const APath: TJSONStringType; out
  1328. NotFound: TJSONStringType): TJSONdata;
  1329. begin
  1330. If APath<>'' then
  1331. begin
  1332. NotFound:=APath;
  1333. Result:=Nil;
  1334. end
  1335. else
  1336. Result:=Self;
  1337. end;
  1338. function TJSONData.GetIsNull: Boolean;
  1339. begin
  1340. Result:=False;
  1341. end;
  1342. class function TJSONData.JSONType: TJSONType;
  1343. begin
  1344. JSONType:=jtUnknown;
  1345. end;
  1346. function TJSONData.GetEnumerator: TBaseJSONEnumerator;
  1347. begin
  1348. Result:=TJSONEnumerator.Create(Self);
  1349. end;
  1350. function TJSONData.FindPath(const APath: TJSONStringType): TJSONdata;
  1351. Var
  1352. M : TJSONStringType;
  1353. begin
  1354. Result:=DoFindPath(APath,M);
  1355. end;
  1356. function TJSONData.GetPath(const APath: TJSONStringType): TJSONdata;
  1357. Var
  1358. M : TJSONStringType;
  1359. begin
  1360. Result:=DoFindPath(APath,M);
  1361. If Result=Nil then
  1362. DoError(SErrPathElementNotFound,[APath,M]);
  1363. end;
  1364. procedure TJSONData.SetItem(Index : Integer; const AValue:
  1365. TJSONData);
  1366. begin
  1367. // Do Nothing
  1368. if Index>0 then ;
  1369. if AValue<>nil then ;
  1370. end;
  1371. function TJSONData.FormatJSON(Options: TFormatOptions; Indentsize: Integer
  1372. ): TJSONStringType;
  1373. begin
  1374. Result:=DoFormatJSON(Options,0,IndentSize);
  1375. end;
  1376. function TJSONData.DoFormatJSON(Options: TFormatOptions; CurrentIndent,
  1377. Indent: Integer): TJSONStringType;
  1378. begin
  1379. Result:=AsJSON;
  1380. if Options=[] then ;
  1381. if CurrentIndent=0 then ;
  1382. if Indent>0 then ;
  1383. end;
  1384. { TJSONnumber }
  1385. class function TJSONnumber.JSONType: TJSONType;
  1386. begin
  1387. Result:=jtNumber;
  1388. end;
  1389. { TJSONstring }
  1390. class function TJSONString.JSONType: TJSONType;
  1391. begin
  1392. Result:=jtString;
  1393. end;
  1394. procedure TJSONString.Clear;
  1395. begin
  1396. FValue:='';
  1397. end;
  1398. function TJSONString.Clone: TJSONData;
  1399. begin
  1400. Result:=TJSONStringClass(ClassType).Create(Self.FValue);
  1401. end;
  1402. function TJSONString.GetValue: TJSONVariant;
  1403. begin
  1404. Result:=FValue;
  1405. end;
  1406. procedure TJSONString.SetValue(const AValue: TJSONVariant);
  1407. begin
  1408. FValue:={$IFDEF PAS2JS}TJSONStringType(AValue){$else}AValue{$ENDIF};
  1409. end;
  1410. function TJSONString.GetAsBoolean: Boolean;
  1411. begin
  1412. Result:=StrToBool(FValue);
  1413. end;
  1414. function TJSONString.GetAsFloat: TJSONFloat;
  1415. Var
  1416. C : Integer;
  1417. begin
  1418. Val(FValue,Result,C);
  1419. If (C<>0) then
  1420. If Not TryStrToFloat(FValue,Result) then
  1421. Raise EConvertError.CreateFmt(SErrInvalidFloat,[FValue]);
  1422. end;
  1423. function TJSONString.GetAsInteger: Integer;
  1424. begin
  1425. Result:=StrToInt(FValue);
  1426. end;
  1427. {$IFNDEF PAS2JS}
  1428. function TJSONString.GetAsInt64: Int64;
  1429. begin
  1430. Result:=StrToInt64(FValue);
  1431. end;
  1432. function TJSONString.GetAsQWord: QWord;
  1433. begin
  1434. Result:=StrToQWord(FValue);
  1435. end;
  1436. procedure TJSONString.SetAsInt64(const AValue: Int64);
  1437. begin
  1438. FValue:=IntToStr(AValue);
  1439. end;
  1440. procedure TJSONString.SetAsQword(const AValue: QWord);
  1441. begin
  1442. FValue:=IntToStr(AValue);
  1443. end;
  1444. {$ELSE}
  1445. function TJSONString.GetAsNativeInt: NativeInt;
  1446. begin
  1447. Result:=StrToInt64(FValue);
  1448. end;
  1449. procedure TJSONString.SetAsNativeInt(const AValue: NativeInt);
  1450. begin
  1451. FValue:=IntToStr(aValue);
  1452. end;
  1453. {$ENDIF}
  1454. procedure TJSONString.SetAsBoolean(const AValue: Boolean);
  1455. begin
  1456. FValue:=BoolToStr(AValue);
  1457. end;
  1458. procedure TJSONString.SetAsFloat(const AValue: TJSONFloat);
  1459. begin
  1460. FValue:=FloatToStr(AValue);
  1461. end;
  1462. procedure TJSONString.SetAsInteger(const AValue: Integer);
  1463. begin
  1464. FValue:=IntToStr(AValue);
  1465. end;
  1466. function TJSONString.GetAsJSON: TJSONStringType;
  1467. begin
  1468. Result:='"'+StringToJSONString(FValue,StrictEscaping)+'"';
  1469. end;
  1470. function TJSONString.GetAsString: TJSONStringType;
  1471. begin
  1472. Result:=FValue;
  1473. end;
  1474. procedure TJSONString.SetAsString(const AValue: TJSONStringType);
  1475. begin
  1476. FValue:=AValue;
  1477. end;
  1478. constructor TJSONString.Create(const AValue: TJSONStringType);
  1479. begin
  1480. FValue:=AValue;
  1481. end;
  1482. {$IFNDEF PAS2JS}
  1483. constructor TJSONString.Create(const AValue: TJSONUnicodeStringType);
  1484. begin
  1485. FValue:=UTF8Encode(AValue);
  1486. end;
  1487. {$ENDIF}
  1488. { TJSONboolean }
  1489. function TJSONBoolean.GetValue: TJSONVariant;
  1490. begin
  1491. Result:=FValue;
  1492. end;
  1493. class function TJSONBoolean.JSONType: TJSONType;
  1494. begin
  1495. Result:=jtBoolean;
  1496. end;
  1497. procedure TJSONBoolean.Clear;
  1498. begin
  1499. FValue:=False;
  1500. end;
  1501. function TJSONBoolean.Clone: TJSONData;
  1502. begin
  1503. Result:=TJSONBooleanClass(Self.ClassType).Create(Self.Fvalue);
  1504. end;
  1505. procedure TJSONBoolean.SetValue(const AValue: TJSONVariant);
  1506. begin
  1507. FValue:=boolean(AValue);
  1508. end;
  1509. function TJSONBoolean.GetAsBoolean: Boolean;
  1510. begin
  1511. Result:=FValue;
  1512. end;
  1513. function TJSONBoolean.GetAsFloat: TJSONFloat;
  1514. begin
  1515. Result:=Ord(FValue);
  1516. end;
  1517. function TJSONBoolean.GetAsInteger: Integer;
  1518. begin
  1519. Result:=Ord(FValue);
  1520. end;
  1521. {$IFNDEF PAS2JS}
  1522. function TJSONBoolean.GetAsInt64: Int64;
  1523. begin
  1524. Result:=Ord(FValue);
  1525. end;
  1526. function TJSONBoolean.GetAsQWord: QWord;
  1527. begin
  1528. Result:=Ord(FValue);
  1529. end;
  1530. procedure TJSONBoolean.SetAsInt64(const AValue: Int64);
  1531. begin
  1532. FValue:=(AValue<>0)
  1533. end;
  1534. procedure TJSONBoolean.SetAsQword(const AValue: QWord);
  1535. begin
  1536. FValue:=(AValue<>0)
  1537. end;
  1538. {$ELSE}
  1539. function TJSONBoolean.GetAsNativeInt: NativeInt;
  1540. begin
  1541. Result:=Ord(FValue);
  1542. end;
  1543. procedure TJSONBoolean.SetAsNativeInt(const AValue: NativeInt);
  1544. begin
  1545. FValue:=aValue<>0;
  1546. end;
  1547. {$ENDIF}
  1548. procedure TJSONBoolean.SetAsBoolean(const AValue: Boolean);
  1549. begin
  1550. FValue:=AValue;
  1551. end;
  1552. procedure TJSONBoolean.SetAsFloat(const AValue: TJSONFloat);
  1553. begin
  1554. FValue:=(AValue<>0)
  1555. end;
  1556. procedure TJSONBoolean.SetAsInteger(const AValue: Integer);
  1557. begin
  1558. FValue:=(AValue<>0)
  1559. end;
  1560. function TJSONBoolean.GetAsJSON: TJSONStringType;
  1561. begin
  1562. If FValue then
  1563. Result:='true'
  1564. else
  1565. Result:='false';
  1566. end;
  1567. function TJSONBoolean.GetAsString: TJSONStringType;
  1568. begin
  1569. Result:=BoolToStr(FValue, True);
  1570. end;
  1571. procedure TJSONBoolean.SetAsString(const AValue: TJSONStringType);
  1572. begin
  1573. FValue:=StrToBool(AValue);
  1574. end;
  1575. constructor TJSONBoolean.Create(AValue: Boolean);
  1576. begin
  1577. FValue:=AValue;
  1578. end;
  1579. { TJSONnull }
  1580. procedure TJSONNull.Converterror(From: Boolean);
  1581. begin
  1582. If From then
  1583. DoError(SErrCannotConvertFromNull)
  1584. else
  1585. DoError(SErrCannotConvertToNull);
  1586. end;
  1587. {$warnings off}
  1588. function TJSONNull.GetAsBoolean: Boolean;
  1589. begin
  1590. ConvertError(True);
  1591. Result:=false;
  1592. end;
  1593. function TJSONNull.GetAsFloat: TJSONFloat;
  1594. begin
  1595. ConvertError(True);
  1596. Result:=0.0;
  1597. end;
  1598. function TJSONNull.GetAsInteger: Integer;
  1599. begin
  1600. ConvertError(True);
  1601. Result:=0;
  1602. end;
  1603. {$IFNDEF PAS2JS}
  1604. function TJSONNull.GetAsInt64: Int64;
  1605. begin
  1606. ConvertError(True);
  1607. end;
  1608. function TJSONNull.GetAsQWord: QWord;
  1609. begin
  1610. ConvertError(True);
  1611. end;
  1612. procedure TJSONNull.SetAsInt64(const AValue: Int64);
  1613. begin
  1614. ConvertError(False);
  1615. if AValue>0 then ;
  1616. end;
  1617. procedure TJSONNull.SetAsQword(const AValue: QWord);
  1618. begin
  1619. ConvertError(False);
  1620. if AValue>0 then ;
  1621. end;
  1622. {$ELSE}
  1623. function TJSONNull.GetAsNativeInt: NativeInt;
  1624. begin
  1625. ConvertError(True);
  1626. Result:=0;
  1627. end;
  1628. procedure TJSONNull.SetAsNativeInt(const AValue: NativeInt);
  1629. begin
  1630. ConvertError(False);
  1631. if AValue<>0 then ;
  1632. end;
  1633. {$ENDIF}
  1634. function TJSONNull.GetIsNull: Boolean;
  1635. begin
  1636. Result:=True;
  1637. end;
  1638. procedure TJSONNull.SetAsBoolean(const AValue: Boolean);
  1639. begin
  1640. ConvertError(False);
  1641. if AValue then ;
  1642. end;
  1643. procedure TJSONNull.SetAsFloat(const AValue: TJSONFloat);
  1644. begin
  1645. ConvertError(False);
  1646. if AValue>0 then ;
  1647. end;
  1648. procedure TJSONNull.SetAsInteger(const AValue: Integer);
  1649. begin
  1650. ConvertError(False);
  1651. if AValue>0 then ;
  1652. end;
  1653. function TJSONNull.GetAsJSON: TJSONStringType;
  1654. begin
  1655. Result:='null';
  1656. end;
  1657. function TJSONNull.GetAsString: TJSONStringType;
  1658. begin
  1659. ConvertError(True);
  1660. Result:='';
  1661. end;
  1662. procedure TJSONNull.SetAsString(const AValue: TJSONStringType);
  1663. begin
  1664. ConvertError(True);
  1665. if AValue='' then ;
  1666. end;
  1667. function TJSONNull.GetValue: TJSONVariant;
  1668. begin
  1669. Result:={$IFDEF PAS2JS}js.Null{$else}variants.Null{$ENDIF};
  1670. end;
  1671. procedure TJSONNull.SetValue(const AValue: TJSONVariant);
  1672. begin
  1673. ConvertError(False);
  1674. {$IFDEF PAS2JS}
  1675. if AValue=0 then ;
  1676. {$else}
  1677. if VarType(AValue)=0 then ;
  1678. {$ENDIF}
  1679. end;
  1680. class function TJSONNull.JSONType: TJSONType;
  1681. begin
  1682. Result:=jtNull;
  1683. end;
  1684. procedure TJSONNull.Clear;
  1685. begin
  1686. // Do nothing
  1687. end;
  1688. function TJSONNull.Clone: TJSONData;
  1689. begin
  1690. Result:=TJSONNullClass(Self.ClassType).Create;
  1691. end;
  1692. {$warnings on}
  1693. { TJSONFloatNumber }
  1694. function TJSONFloatNumber.GetAsBoolean: Boolean;
  1695. begin
  1696. Result:=(FValue<>0);
  1697. end;
  1698. function TJSONFloatNumber.GetAsFloat: TJSONFloat;
  1699. begin
  1700. Result:=FValue;
  1701. end;
  1702. function TJSONFloatNumber.GetAsInteger: Integer;
  1703. begin
  1704. Result:=Round(FValue);
  1705. end;
  1706. {$IFNDEF PAS2JS}
  1707. function TJSONFloatNumber.GetAsInt64: Int64;
  1708. begin
  1709. Result:=Round(FValue);
  1710. end;
  1711. function TJSONFloatNumber.GetAsQWord: QWord;
  1712. begin
  1713. Result:=Round(FValue);
  1714. end;
  1715. procedure TJSONFloatNumber.SetAsInt64(const AValue: Int64);
  1716. begin
  1717. FValue:=AValue;
  1718. end;
  1719. procedure TJSONFloatNumber.SetAsQword(const AValue: QWord);
  1720. begin
  1721. FValue:=AValue;
  1722. end;
  1723. {$ELSE}
  1724. function TJSONFloatNumber.GetAsNativeInt: NativeInt;
  1725. begin
  1726. Result:=Round(FValue);
  1727. end;
  1728. procedure TJSONFloatNumber.SetAsNativeInt(const AValue: NativeInt);
  1729. begin
  1730. FValue:=aValue;
  1731. end;
  1732. {$ENDIF}
  1733. procedure TJSONFloatNumber.SetAsBoolean(const AValue: Boolean);
  1734. begin
  1735. FValue:=Ord(AValue);
  1736. end;
  1737. procedure TJSONFloatNumber.SetAsFloat(const AValue: TJSONFloat);
  1738. begin
  1739. FValue:=AValue;
  1740. end;
  1741. procedure TJSONFloatNumber.SetAsInteger(const AValue: Integer);
  1742. begin
  1743. FValue:=AValue;
  1744. end;
  1745. function TJSONFloatNumber.GetAsJSON: TJSONStringType;
  1746. begin
  1747. Result:=AsString;
  1748. end;
  1749. function TJSONFloatNumber.GetAsString: TJSONStringType;
  1750. begin
  1751. Str(FValue,Result);
  1752. // Str produces a ' ' in front where the - can go.
  1753. if (Result<>'') and (Result[1]=' ') then
  1754. Delete(Result,1,1);
  1755. end;
  1756. procedure TJSONFloatNumber.SetAsString(const AValue: TJSONStringType);
  1757. Var
  1758. C : Integer;
  1759. begin
  1760. Val(AValue,FValue,C);
  1761. If (C<>0) then
  1762. Raise EConvertError.CreateFmt(SErrInvalidFloat,[AValue]);
  1763. end;
  1764. function TJSONFloatNumber.GetValue: TJSONVariant;
  1765. begin
  1766. Result:=FValue;
  1767. end;
  1768. procedure TJSONFloatNumber.SetValue(const AValue: TJSONVariant);
  1769. begin
  1770. FValue:={$IFDEF PAS2JS}TJSONFloat(AValue){$else}AValue{$ENDIF};
  1771. end;
  1772. constructor TJSONFloatNumber.Create(AValue: TJSONFloat);
  1773. begin
  1774. FValue:=AValue;
  1775. end;
  1776. class function TJSONFloatNumber.NumberType: TJSONNumberType;
  1777. begin
  1778. Result:=ntFloat;
  1779. end;
  1780. procedure TJSONFloatNumber.Clear;
  1781. begin
  1782. FValue:=0;
  1783. end;
  1784. function TJSONFloatNumber.Clone: TJSONData;
  1785. begin
  1786. Result:=TJSONFloatNumberClass(ClassType).Create(Self.FValue);
  1787. end;
  1788. { TJSONIntegerNumber }
  1789. function TJSONIntegerNumber.GetAsBoolean: Boolean;
  1790. begin
  1791. Result:=FValue<>0;
  1792. end;
  1793. function TJSONIntegerNumber.GetAsFloat: TJSONFloat;
  1794. begin
  1795. Result:=FValue;
  1796. end;
  1797. function TJSONIntegerNumber.GetAsInteger: Integer;
  1798. begin
  1799. Result:=FValue;
  1800. end;
  1801. {$IFNDEF PAS2JS}
  1802. function TJSONIntegerNumber.GetAsInt64: Int64;
  1803. begin
  1804. Result:=FValue;
  1805. end;
  1806. function TJSONIntegerNumber.GetAsQWord: QWord;
  1807. begin
  1808. result:=FValue;
  1809. end;
  1810. procedure TJSONIntegerNumber.SetAsInt64(const AValue: Int64);
  1811. begin
  1812. FValue:=AValue;
  1813. end;
  1814. procedure TJSONIntegerNumber.SetAsQword(const AValue: QWord);
  1815. begin
  1816. FValue:=AValue;
  1817. end;
  1818. {$ELSE}
  1819. function TJSONIntegerNumber.GetAsNativeInt: NativeInt;
  1820. begin
  1821. result:=FValue;
  1822. end;
  1823. procedure TJSONIntegerNumber.SetAsNativeInt(const AValue: NativeInt);
  1824. begin
  1825. FValue:=aValue;
  1826. end;
  1827. {$ENDIF}
  1828. procedure TJSONIntegerNumber.SetAsBoolean(const AValue: Boolean);
  1829. begin
  1830. FValue:=Ord(AValue);
  1831. end;
  1832. procedure TJSONIntegerNumber.SetAsFloat(const AValue: TJSONFloat);
  1833. begin
  1834. FValue:=Round(AValue);
  1835. end;
  1836. procedure TJSONIntegerNumber.SetAsInteger(const AValue: Integer);
  1837. begin
  1838. FValue:=AValue;
  1839. end;
  1840. function TJSONIntegerNumber.GetAsJSON: TJSONStringType;
  1841. begin
  1842. Result:=AsString;
  1843. end;
  1844. function TJSONIntegerNumber.GetAsString: TJSONStringType;
  1845. begin
  1846. Result:=IntToStr(FValue)
  1847. end;
  1848. procedure TJSONIntegerNumber.SetAsString(const AValue: TJSONStringType);
  1849. begin
  1850. FValue:=StrToInt(AValue);
  1851. end;
  1852. function TJSONIntegerNumber.GetValue: TJSONVariant;
  1853. begin
  1854. Result:=FValue;
  1855. end;
  1856. procedure TJSONIntegerNumber.SetValue(const AValue: TJSONVariant);
  1857. begin
  1858. FValue:={$IFDEF PAS2JS}Integer(AValue){$else}AValue{$ENDIF};
  1859. end;
  1860. constructor TJSONIntegerNumber.Create(AValue: Integer);
  1861. begin
  1862. FValue:=AValue;
  1863. end;
  1864. class function TJSONIntegerNumber.NumberType: TJSONNumberType;
  1865. begin
  1866. Result:=ntInteger;
  1867. end;
  1868. procedure TJSONIntegerNumber.Clear;
  1869. begin
  1870. FValue:=0;
  1871. end;
  1872. function TJSONIntegerNumber.Clone: TJSONData;
  1873. begin
  1874. Result:=TJSONIntegerNumberClass(ClassType).Create(Self.FValue);
  1875. end;
  1876. {$IFNDEF PAS2JS}
  1877. { TJSONInt64Number }
  1878. function TJSONInt64Number.GetAsInt64: Int64;
  1879. begin
  1880. Result := FValue;
  1881. end;
  1882. function TJSONInt64Number.GetAsQWord: QWord;
  1883. begin
  1884. Result := FValue;
  1885. end;
  1886. procedure TJSONInt64Number.SetAsInt64(const AValue: Int64);
  1887. begin
  1888. FValue := AValue;
  1889. end;
  1890. procedure TJSONInt64Number.SetAsQword(const AValue: QWord);
  1891. begin
  1892. FValue := AValue;
  1893. end;
  1894. function TJSONInt64Number.GetAsBoolean: Boolean;
  1895. begin
  1896. Result:=FValue<>0;
  1897. end;
  1898. function TJSONInt64Number.GetAsFloat: TJSONFloat;
  1899. begin
  1900. Result:= FValue;
  1901. end;
  1902. function TJSONInt64Number.GetAsInteger: Integer;
  1903. begin
  1904. Result := FValue;
  1905. end;
  1906. procedure TJSONInt64Number.SetAsBoolean(const AValue: Boolean);
  1907. begin
  1908. FValue:=Ord(AValue);
  1909. end;
  1910. procedure TJSONInt64Number.SetAsFloat(const AValue: TJSONFloat);
  1911. begin
  1912. FValue:=Round(AValue);
  1913. end;
  1914. procedure TJSONInt64Number.SetAsInteger(const AValue: Integer);
  1915. begin
  1916. FValue:=AValue;
  1917. end;
  1918. function TJSONInt64Number.GetAsJSON: TJSONStringType;
  1919. begin
  1920. Result:=AsString;
  1921. end;
  1922. function TJSONInt64Number.GetAsString: TJSONStringType;
  1923. begin
  1924. Result:=IntToStr(FValue)
  1925. end;
  1926. procedure TJSONInt64Number.SetAsString(const AValue: TJSONStringType);
  1927. begin
  1928. FValue:=StrToInt64(AValue);
  1929. end;
  1930. function TJSONInt64Number.GetValue: TJSONVariant;
  1931. begin
  1932. Result:=FValue;
  1933. end;
  1934. procedure TJSONInt64Number.SetValue(const AValue: TJSONVariant);
  1935. begin
  1936. FValue:=AValue;
  1937. end;
  1938. constructor TJSONInt64Number.Create(AValue: Int64);
  1939. begin
  1940. FValue := AValue;
  1941. end;
  1942. class function TJSONInt64Number.NumberType: TJSONNumberType;
  1943. begin
  1944. Result:=ntInt64;
  1945. end;
  1946. procedure TJSONInt64Number.Clear;
  1947. begin
  1948. FValue:=0;
  1949. end;
  1950. function TJSONInt64Number.Clone: TJSONData;
  1951. begin
  1952. Result:=TJSONInt64NumberClass(ClassType).Create(Self.FValue);
  1953. end;
  1954. {$else}
  1955. { TJSONNativeIntNumber }
  1956. function TJSONNativeIntNumber.GetAsNativeInt: NativeInt;
  1957. begin
  1958. Result := FValue;
  1959. end;
  1960. procedure TJSONNativeIntNumber.SetAsNativeInt(const AValue: NativeInt);
  1961. begin
  1962. FValue := AValue;
  1963. end;
  1964. function TJSONNativeIntNumber.GetAsBoolean: Boolean;
  1965. begin
  1966. Result:=FValue<>0;
  1967. end;
  1968. function TJSONNativeIntNumber.GetAsFloat: TJSONFloat;
  1969. begin
  1970. Result:= FValue;
  1971. end;
  1972. function TJSONNativeIntNumber.GetAsInteger: Integer;
  1973. begin
  1974. Result := FValue;
  1975. end;
  1976. procedure TJSONNativeIntNumber.SetAsBoolean(const AValue: Boolean);
  1977. begin
  1978. FValue:=Ord(AValue);
  1979. end;
  1980. procedure TJSONNativeIntNumber.SetAsFloat(const AValue: TJSONFloat);
  1981. begin
  1982. FValue:=Round(AValue);
  1983. end;
  1984. procedure TJSONNativeIntNumber.SetAsInteger(const AValue: Integer);
  1985. begin
  1986. FValue:=AValue;
  1987. end;
  1988. function TJSONNativeIntNumber.GetAsJSON: TJSONStringType;
  1989. begin
  1990. Result:=AsString;
  1991. end;
  1992. function TJSONNativeIntNumber.GetAsString: TJSONStringType;
  1993. begin
  1994. Result:=IntToStr(FValue)
  1995. end;
  1996. procedure TJSONNativeIntNumber.SetAsString(const AValue: TJSONStringType);
  1997. begin
  1998. FValue:=StrToNativeInt(AValue);
  1999. end;
  2000. function TJSONNativeIntNumber.GetValue: TJSONVariant;
  2001. begin
  2002. Result:=FValue;
  2003. end;
  2004. procedure TJSONNativeIntNumber.SetValue(const AValue: TJSONVariant);
  2005. begin
  2006. FValue:=NativeInt(AValue);
  2007. end;
  2008. constructor TJSONNativeIntNumber.Create(AValue: NativeInt);
  2009. begin
  2010. FValue := AValue;
  2011. end;
  2012. class function TJSONNativeIntNumber.NumberType: TJSONNumberType;
  2013. begin
  2014. Result:=ntNativeInt;
  2015. end;
  2016. procedure TJSONNativeIntNumber.Clear;
  2017. begin
  2018. FValue:=0;
  2019. end;
  2020. function TJSONNativeIntNumber.Clone: TJSONData;
  2021. begin
  2022. Result:=TJSONNativeIntNumberClass(ClassType).Create(Self.FValue);
  2023. end;
  2024. {$ENDIF}
  2025. { TJSONArray }
  2026. function TJSONArray.GetBooleans(Index : Integer): Boolean;
  2027. begin
  2028. Result:=Items[Index].AsBoolean;
  2029. end;
  2030. function TJSONArray.GetArrays(Index : Integer): TJSONArray;
  2031. begin
  2032. Result:=Items[Index] as TJSONArray;
  2033. end;
  2034. function TJSONArray.GetFloats(Index : Integer): TJSONFloat;
  2035. begin
  2036. Result:=Items[Index].AsFloat;
  2037. end;
  2038. function TJSONArray.GetIntegers(Index : Integer): Integer;
  2039. begin
  2040. Result:=Items[Index].AsInteger;
  2041. end;
  2042. {$IFNDEF PAS2JS}
  2043. function TJSONArray.GetInt64s(Index : Integer): Int64;
  2044. begin
  2045. Result:=Items[Index].AsInt64;
  2046. end;
  2047. {$ELSE}
  2048. function TJSONArray.GetNativeInts(Index : Integer): NativeInt;
  2049. begin
  2050. Result:=Items[Index].AsNativeInt;
  2051. end;
  2052. {$ENDIF}
  2053. function TJSONArray.GetNulls(Index : Integer): Boolean;
  2054. begin
  2055. Result:=Items[Index].IsNull;
  2056. end;
  2057. function TJSONArray.GetObjects(Index : Integer): TJSONObject;
  2058. begin
  2059. Result:=Items[Index] as TJSONObject;
  2060. end;
  2061. {$IFNDEF PAS2JS}
  2062. function TJSONArray.GetQWords(Index : Integer): QWord;
  2063. begin
  2064. Result:=Items[Index].AsQWord;
  2065. end;
  2066. {$ENDIF}
  2067. function TJSONArray.GetStrings(Index : Integer): TJSONStringType;
  2068. begin
  2069. Result:=Items[Index].AsString;
  2070. end;
  2071. {$IFNDEF PAS2JS}
  2072. function TJSONArray.GetUnicodeStrings(Index : Integer): TJSONUnicodeStringType;
  2073. begin
  2074. Result:=Items[Index].AsUnicodeString;
  2075. end;
  2076. {$ENDIF}
  2077. function TJSONArray.GetTypes(Index : Integer): TJSONType;
  2078. begin
  2079. Result:=Items[Index].JSONType;
  2080. end;
  2081. procedure TJSONArray.SetArrays(Index : Integer; const AValue: TJSONArray);
  2082. begin
  2083. Items[Index]:=AValue;
  2084. end;
  2085. procedure TJSONArray.SetBooleans(Index : Integer; const AValue: Boolean);
  2086. begin
  2087. Items[Index]:=CreateJSON(AValue);
  2088. end;
  2089. procedure TJSONArray.SetFloats(Index : Integer; const AValue: TJSONFloat);
  2090. begin
  2091. Items[Index]:=CreateJSON(AValue);
  2092. end;
  2093. procedure TJSONArray.SetIntegers(Index : Integer; const AValue: Integer);
  2094. begin
  2095. Items[Index]:=CreateJSON(AValue);
  2096. end;
  2097. {$IFNDEF PAS2JS}
  2098. procedure TJSONArray.SetInt64s(Index : Integer; const AValue: Int64);
  2099. begin
  2100. Items[Index]:=CreateJSON(AValue);
  2101. end;
  2102. {$ELSE}
  2103. procedure TJSONArray.SetNativeInts(Index : Integer; AValue: NativeInt);
  2104. begin
  2105. Items[Index]:=CreateJSON(AValue);
  2106. end;
  2107. {$ENDIF}
  2108. procedure TJSONArray.SetObjects(Index : Integer; const AValue: TJSONObject);
  2109. begin
  2110. Items[Index]:=AValue;
  2111. end;
  2112. {$IFNDEF PAS2JS}
  2113. procedure TJSONArray.SetQWords(Index : Integer; AValue: QWord);
  2114. begin
  2115. Items[Index]:=CreateJSON(AValue);
  2116. end;
  2117. {$ENDIF}
  2118. procedure TJSONArray.SetStrings(Index : Integer; const AValue: TJSONStringType);
  2119. begin
  2120. Items[Index]:=CreateJSON(AValue);
  2121. end;
  2122. {$IFNDEF PAS2JS}
  2123. procedure TJSONArray.SetUnicodeStrings(Index: Integer;
  2124. const AValue: TJSONUnicodeStringType);
  2125. begin
  2126. Items[Index]:=CreateJSON(AValue);
  2127. end;
  2128. {$ENDIF}
  2129. function TJSONArray.DoFindPath(const APath: TJSONStringType; out
  2130. NotFound: TJSONStringType): TJSONdata;
  2131. Var
  2132. P,I : integer;
  2133. E : String;
  2134. begin
  2135. if (APath<>'') and (APath[1]='[') then
  2136. begin
  2137. P:=Pos(']',APath);
  2138. I:=-1;
  2139. If (P>2) then
  2140. I:=StrToIntDef(Copy(APath,2,P-2),-1);
  2141. If (I>=0) and (I<Count) then
  2142. begin
  2143. E:=APath;
  2144. System.Delete(E,1,P);
  2145. Result:=Items[i].DoFindPath(E,NotFound);
  2146. end
  2147. else
  2148. begin
  2149. Result:=Nil;
  2150. If (P>0) then
  2151. NotFound:=Copy(APath,1,P)
  2152. else
  2153. NotFound:=APath;
  2154. end;
  2155. end
  2156. else
  2157. Result:=inherited DoFindPath(APath, NotFound);
  2158. end;
  2159. procedure TJSONArray.Converterror(From: Boolean);
  2160. begin
  2161. If From then
  2162. DoError(SErrCannotConvertFromArray)
  2163. else
  2164. DoError(SErrCannotConvertToArray);
  2165. end;
  2166. {$warnings off}
  2167. function TJSONArray.GetAsBoolean: Boolean;
  2168. begin
  2169. ConvertError(True);
  2170. Result:=false;
  2171. end;
  2172. function TJSONArray.GetAsFloat: TJSONFloat;
  2173. begin
  2174. ConvertError(True);
  2175. Result:=0.0;
  2176. end;
  2177. function TJSONArray.GetAsInteger: Integer;
  2178. begin
  2179. ConvertError(True);
  2180. Result:=0;
  2181. end;
  2182. {$IFNDEF PAS2JS}
  2183. {$ELSE}
  2184. {$ENDIF}
  2185. procedure TJSONArray.SetAsBoolean(const AValue: Boolean);
  2186. begin
  2187. ConvertError(False);
  2188. if AValue then ;
  2189. end;
  2190. procedure TJSONArray.SetAsFloat(const AValue: TJSONFloat);
  2191. begin
  2192. ConvertError(False);
  2193. if AValue>0 then ;
  2194. end;
  2195. procedure TJSONArray.SetAsInteger(const AValue: Integer);
  2196. begin
  2197. ConvertError(False);
  2198. if AValue>0 then ;
  2199. end;
  2200. {$warnings on}
  2201. function TJSONArray.GetAsJSON: TJSONStringType;
  2202. Var
  2203. I : Integer;
  2204. Sep : String;
  2205. D : TJSONData;
  2206. V : TJSONStringType;
  2207. begin
  2208. Sep:=TJSONData.FElementSep;
  2209. Result:='[';
  2210. For I:=0 to Count-1 do
  2211. begin
  2212. D:=Items[i];
  2213. if D<>Nil then
  2214. V:=D.AsJSON
  2215. else
  2216. V:='null';
  2217. Result:=Result+V;
  2218. If (I<Count-1) then
  2219. Result:=Result+Sep;
  2220. end;
  2221. Result:=Result+']';
  2222. end;
  2223. Function IndentString(Options : TFormatOptions; Indent : Integer) : TJSONStringType;
  2224. begin
  2225. If (foUseTabChar in Options) then
  2226. Result:=StringofChar(#9,Indent)
  2227. else
  2228. Result:=StringOfChar(' ',Indent);
  2229. end;
  2230. function TJSONArray.DoFormatJSON(Options: TFormatOptions; CurrentIndent,
  2231. Indent: Integer): TJSONStringType;
  2232. Var
  2233. I : Integer;
  2234. MultiLine : Boolean;
  2235. SkipWhiteSpace : Boolean;
  2236. Ind : String;
  2237. begin
  2238. Result:='[';
  2239. MultiLine:=Not (foSingleLineArray in Options);
  2240. SkipWhiteSpace:=foSkipWhiteSpace in Options;
  2241. Ind:=IndentString(Options, CurrentIndent+Indent);
  2242. if MultiLine then
  2243. Result:=Result+sLineBreak;
  2244. For I:=0 to Count-1 do
  2245. begin
  2246. if MultiLine then
  2247. Result:=Result+Ind;
  2248. if Items[i]=Nil then
  2249. Result:=Result+'null'
  2250. else
  2251. Result:=Result+Items[i].DoFormatJSON(Options,CurrentIndent+Indent,Indent);
  2252. If (I<Count-1) then
  2253. if MultiLine then
  2254. Result:=Result+','
  2255. else
  2256. Result:=Result+ElementSeps[SkipWhiteSpace];
  2257. if MultiLine then
  2258. Result:=Result+sLineBreak
  2259. end;
  2260. if MultiLine then
  2261. Result:=Result+IndentString(Options, CurrentIndent);
  2262. Result:=Result+']';
  2263. end;
  2264. {$warnings off}
  2265. function TJSONArray.GetAsString: TJSONStringType;
  2266. begin
  2267. ConvertError(True);
  2268. Result:='';
  2269. end;
  2270. procedure TJSONArray.SetAsString(const AValue: TJSONStringType);
  2271. begin
  2272. ConvertError(False);
  2273. if AValue='' then ;
  2274. end;
  2275. function TJSONArray.GetValue: TJSONVariant;
  2276. begin
  2277. ConvertError(True);
  2278. Result:=0;
  2279. end;
  2280. procedure TJSONArray.SetValue(const AValue: TJSONVariant);
  2281. begin
  2282. ConvertError(False);
  2283. {$IFDEF PAS2JS}
  2284. if AValue=0 then ;
  2285. {$else}
  2286. if VarType(AValue)=0 then ;
  2287. {$ENDIF}
  2288. end;
  2289. {$warnings on}
  2290. function TJSONArray.GetCount: Integer;
  2291. begin
  2292. Result:=FList.Count;
  2293. end;
  2294. function TJSONArray.GetItem(Index: Integer): TJSONData;
  2295. begin
  2296. Result:=FList[Index] as TJSONData;
  2297. end;
  2298. procedure TJSONArray.SetItem(Index: Integer; const AValue: TJSONData);
  2299. begin
  2300. If (Index=FList.Count) then
  2301. FList.Add(AValue)
  2302. else
  2303. FList[Index]:=AValue;
  2304. end;
  2305. constructor TJSONArray.Create;
  2306. begin
  2307. Flist:=TFPObjectList.Create(True);
  2308. end;
  2309. {$IFDEF PAS2JS}
  2310. Function VarRecToJSON(Const Element : jsvalue; const SourceType : String) : TJSONData;
  2311. var
  2312. i: NativeInt;
  2313. VObject: TObject;
  2314. begin
  2315. Result:=nil;
  2316. if Element=nil then
  2317. Result:=CreateJSON // TJSONNull
  2318. else if isBoolean(Element) then
  2319. Result:=CreateJSON(boolean(Element))
  2320. else if isString(Element) then
  2321. Result:=CreateJSON(String(Element))
  2322. else if isNumber(Element) then
  2323. begin
  2324. if isInteger(Element) then
  2325. begin
  2326. i:=NativeInt(Element);
  2327. if (i>=low(integer)) and (i<=high(integer)) then
  2328. Result:=CreateJSON(Integer(Element))
  2329. else
  2330. Result:=CreateJSON(NativeInt(Element));
  2331. end
  2332. else
  2333. Result:=CreateJSON(TJSONFloat(Element));
  2334. end
  2335. else if isObject(Element) and (Element is TObject) then
  2336. begin
  2337. VObject:=TObject(Element);
  2338. if VObject is TJSONData then
  2339. Result:=TJSONData(VObject)
  2340. else
  2341. TJSONData.DoError(SErrNotJSONData,[VObject.ClassName,SourceType]);
  2342. end
  2343. else
  2344. TJSONData.DoError(SErrUnknownTypeInConstructor,[SourceType,jsTypeOf(Element)]);
  2345. end;
  2346. {$else}
  2347. Function VarRecToJSON(Const Element : TVarRec; const SourceType : String) : TJSONData;
  2348. begin
  2349. Result:=Nil;
  2350. With Element do
  2351. case VType of
  2352. vtInteger : Result:=CreateJSON(VInteger);
  2353. vtBoolean : Result:=CreateJSON(VBoolean);
  2354. vtChar : Result:=CreateJSON(VChar);
  2355. vtExtended : Result:=CreateJSON(VExtended^);
  2356. vtString : Result:=CreateJSON(vString^);
  2357. vtAnsiString : Result:=CreateJSON(UTF8Decode(StrPas(VPChar)));
  2358. vtUnicodeString: Result:=CreateJSON(UnicodeString(VUnicodeString));
  2359. vtWideString: Result:=CreateJSON(WideString(VWideString));
  2360. vtPChar : Result:=CreateJSON(StrPas(VPChar));
  2361. vtPointer : If (VPointer<>Nil) then
  2362. TJSONData.DoError(SErrPointerNotNil,[SourceType])
  2363. else
  2364. Result:=CreateJSON();
  2365. vtCurrency : Result:=CreateJSON(vCurrency^);
  2366. vtInt64 : Result:=CreateJSON(vInt64^);
  2367. vtObject : if (VObject is TJSONData) then
  2368. Result:=TJSONData(VObject)
  2369. else
  2370. TJSONData.DoError(SErrNotJSONData,[VObject.ClassName,SourceType]);
  2371. //vtVariant :
  2372. else
  2373. TJSONData.DoError(SErrUnknownTypeInConstructor,[SourceType,VType])
  2374. end;
  2375. end;
  2376. {$ENDIF}
  2377. constructor TJSONArray.Create(const Elements: array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF});
  2378. Var
  2379. I : integer;
  2380. J : TJSONData;
  2381. begin
  2382. Create;
  2383. For I:=Low(Elements) to High(Elements) do
  2384. begin
  2385. J:=VarRecToJSON(Elements[i],'Array');
  2386. Add(J);
  2387. end;
  2388. end;
  2389. destructor TJSONArray.Destroy;
  2390. begin
  2391. FreeAndNil(FList);
  2392. inherited Destroy;
  2393. end;
  2394. class function TJSONArray.JSONType: TJSONType;
  2395. begin
  2396. Result:=jtArray;
  2397. end;
  2398. function TJSONArray.Clone: TJSONData;
  2399. Var
  2400. A : TJSONArray;
  2401. I : Integer;
  2402. begin
  2403. A:=TJSONArrayClass(ClassType).Create;
  2404. try
  2405. For I:=0 to Count-1 do
  2406. A.Add(Self.Items[I].Clone);
  2407. Result:=A;
  2408. except
  2409. A.Free;
  2410. Raise;
  2411. end;
  2412. end;
  2413. procedure TJSONArray.Iterate(Iterator: TJSONArrayIterator; Data: TObject);
  2414. Var
  2415. I : Integer;
  2416. Cont : Boolean;
  2417. begin
  2418. I:=0;
  2419. Cont:=True;
  2420. While (I<FList.Count) and cont do
  2421. begin
  2422. Iterator(Items[i],Data,Cont);
  2423. Inc(I);
  2424. end;
  2425. end;
  2426. function TJSONArray.IndexOf(obj: TJSONData): Integer;
  2427. begin
  2428. Result:=FList.IndexOf(Obj);
  2429. end;
  2430. function TJSONArray.GetEnumerator: TBaseJSONEnumerator;
  2431. begin
  2432. Result:=TJSONArrayEnumerator.Create(Self);
  2433. end;
  2434. procedure TJSONArray.Clear;
  2435. begin
  2436. FList.Clear;
  2437. end;
  2438. function TJSONArray.Add(Item: TJSONData): Integer;
  2439. begin
  2440. Result:=FList.Add(Item);
  2441. end;
  2442. function TJSONArray.Add(I: Integer): Integer;
  2443. begin
  2444. Result:=Add(CreateJSON(I));
  2445. end;
  2446. {$IFNDEF PAS2JS}
  2447. function TJSONArray.GetAsInt64: Int64;
  2448. begin
  2449. ConvertError(True);
  2450. Result:=0;
  2451. end;
  2452. function TJSONArray.GetAsQWord: QWord;
  2453. begin
  2454. ConvertError(True);
  2455. Result:=0;
  2456. end;
  2457. procedure TJSONArray.SetAsInt64(const AValue: Int64);
  2458. begin
  2459. ConvertError(False);
  2460. if AValue>0 then ;
  2461. end;
  2462. procedure TJSONArray.SetAsQword(const AValue: QWord);
  2463. begin
  2464. ConvertError(False);
  2465. if AValue>0 then ;
  2466. end;
  2467. function TJSONArray.Add(I: Int64): Int64;
  2468. begin
  2469. Result:=Add(CreateJSON(I));
  2470. end;
  2471. function TJSONArray.Add(I: QWord): QWord;
  2472. begin
  2473. Result:=Add(CreateJSON(I));
  2474. end;
  2475. function TJSONArray.Add(const S: UnicodeString): Integer;
  2476. begin
  2477. Result:=Add(CreateJSON(S));
  2478. end;
  2479. procedure TJSONArray.Insert(Index: Integer; I: Int64);
  2480. begin
  2481. FList.Insert(Index, CreateJSON(I));
  2482. end;
  2483. procedure TJSONArray.Insert(Index: Integer; I: QWord);
  2484. begin
  2485. FList.Insert(Index, CreateJSON(I));
  2486. end;
  2487. procedure TJSONArray.Insert(Index: Integer; const S: UnicodeString);
  2488. begin
  2489. FList.Insert(Index, CreateJSON(S));
  2490. end;
  2491. {$ELSE}
  2492. function TJSONArray.GetAsNativeInt: NativeInt;
  2493. begin
  2494. ConvertError(True);
  2495. Result:=0;
  2496. end;
  2497. procedure TJSONArray.SetAsNativeInt(const AValue: NativeInt);
  2498. begin
  2499. ConvertError(False);
  2500. if AValue<>0 then;
  2501. end;
  2502. function TJSONArray.Add(I: NativeInt): Integer;
  2503. begin
  2504. Result:=Add(CreateJSON(I));
  2505. end;
  2506. procedure TJSONArray.Insert(Index: Integer; I: NativeInt);
  2507. begin
  2508. FList.Insert(Index, CreateJSON(I));
  2509. end;
  2510. {$ENDIF}
  2511. function TJSONArray.Add(const S: String): Integer;
  2512. begin
  2513. Result:=Add(CreateJSON(S));
  2514. end;
  2515. function TJSONArray.Add: Integer;
  2516. begin
  2517. Result:=Add(CreateJSON);
  2518. end;
  2519. function TJSONArray.Add(F: TJSONFloat): Integer;
  2520. begin
  2521. Result:=Add(CreateJSON(F));
  2522. end;
  2523. function TJSONArray.Add(B: Boolean): Integer;
  2524. begin
  2525. Result:=Add(CreateJSON(B));
  2526. end;
  2527. function TJSONArray.Add(AnArray: TJSONArray): Integer;
  2528. begin
  2529. If (IndexOf(AnArray)<>-1) then
  2530. DoError(SErrCannotAddArrayTwice);
  2531. Result:=Add(TJSONData(AnArray));
  2532. end;
  2533. function TJSONArray.Add(AnObject: TJSONObject): Integer;
  2534. begin
  2535. If (IndexOf(AnObject)<>-1) then
  2536. DoError(SErrCannotAddObjectTwice);
  2537. Result:=Add(TJSONData(AnObject));
  2538. end;
  2539. procedure TJSONArray.Delete(Index: Integer);
  2540. begin
  2541. FList.Delete(Index);
  2542. end;
  2543. procedure TJSONArray.Exchange(Index1, Index2: Integer);
  2544. begin
  2545. FList.Exchange(Index1, Index2);
  2546. end;
  2547. function TJSONArray.Extract(Item: TJSONData): TJSONData;
  2548. begin
  2549. Result := TJSONData(FList.Extract(Item));
  2550. end;
  2551. function TJSONArray.Extract(Index: Integer): TJSONData;
  2552. begin
  2553. Result := TJSONData(FList.Extract(FList.Items[Index]));
  2554. end;
  2555. procedure TJSONArray.Insert(Index: Integer);
  2556. begin
  2557. Insert(Index,CreateJSON);
  2558. end;
  2559. procedure TJSONArray.Insert(Index: Integer; Item: TJSONData);
  2560. begin
  2561. FList.Insert(Index, Item);
  2562. end;
  2563. procedure TJSONArray.Insert(Index: Integer; I: Integer);
  2564. begin
  2565. FList.Insert(Index, CreateJSON(I));
  2566. end;
  2567. procedure TJSONArray.Insert(Index: Integer; const S: String);
  2568. begin
  2569. FList.Insert(Index, CreateJSON(S));
  2570. end;
  2571. procedure TJSONArray.Insert(Index: Integer; F: TJSONFloat);
  2572. begin
  2573. FList.Insert(Index, CreateJSON(F));
  2574. end;
  2575. procedure TJSONArray.Insert(Index: Integer; B: Boolean);
  2576. begin
  2577. FList.Insert(Index, CreateJSON(B));
  2578. end;
  2579. procedure TJSONArray.Insert(Index: Integer; AnArray: TJSONArray);
  2580. begin
  2581. if (IndexOf(AnArray)<>-1) then
  2582. DoError(SErrCannotAddArrayTwice);
  2583. FList.Insert(Index, AnArray);
  2584. end;
  2585. procedure TJSONArray.Insert(Index: Integer; AnObject: TJSONObject);
  2586. begin
  2587. if (IndexOf(AnObject)<>-1) then
  2588. DoError(SErrCannotAddObjectTwice);
  2589. FList.Insert(Index, AnObject);
  2590. end;
  2591. procedure TJSONArray.Move(CurIndex, NewIndex: Integer);
  2592. begin
  2593. FList.Move(CurIndex, NewIndex);
  2594. end;
  2595. procedure TJSONArray.Remove(Item: TJSONData);
  2596. begin
  2597. FList.Remove(Item);
  2598. end;
  2599. procedure TJSONArray.Sort(Compare: TListSortCompare);
  2600. begin
  2601. FList.Sort(Compare);
  2602. end;
  2603. { TJSONObject }
  2604. function TJSONObject.GetArrays(const AName: String): TJSONArray;
  2605. begin
  2606. Result:=GetElements(AName) as TJSONArray;
  2607. end;
  2608. function TJSONObject.GetBooleans(const AName: String): Boolean;
  2609. begin
  2610. Result:=GetElements(AName).AsBoolean;
  2611. end;
  2612. function TJSONObject.GetElements(const AName: string): TJSONData;
  2613. begin
  2614. {$IFDEF PAS2JS}
  2615. if FHash.hasOwnProperty('%'+AName) then
  2616. Result:=TJSONData(FHash['%'+AName])
  2617. else
  2618. DoError(SErrNonexistentElement,[AName]);
  2619. {$else}
  2620. Result:=TJSONData(FHash.Find(AName));
  2621. If (Result=Nil) then
  2622. DoError(SErrNonexistentElement,[AName]);
  2623. {$ENDIF}
  2624. end;
  2625. function TJSONObject.GetFloats(const AName: String): TJSONFloat;
  2626. begin
  2627. Result:=GetElements(AName).AsFloat;
  2628. end;
  2629. function TJSONObject.GetIntegers(const AName: String): Integer;
  2630. begin
  2631. Result:=GetElements(AName).AsInteger;
  2632. end;
  2633. {$IFNDEF PAS2JS}
  2634. function TJSONObject.GetInt64s(const AName: String): Int64;
  2635. begin
  2636. Result:=GetElements(AName).AsInt64;
  2637. end;
  2638. function TJSONObject.GetQWords(AName : String): QWord;
  2639. begin
  2640. Result:=GetElements(AName).AsQWord;
  2641. end;
  2642. function TJSONObject.GetUnicodeStrings(const AName: String
  2643. ): TJSONUnicodeStringType;
  2644. begin
  2645. Result:=GetElements(AName).AsUnicodeString;
  2646. end;
  2647. procedure TJSONObject.SetInt64s(const AName : String; const AValue: Int64);
  2648. begin
  2649. SetElements(AName,CreateJSON(AVAlue));
  2650. end;
  2651. procedure TJSONObject.SetQWords(AName : String; AValue: QWord);
  2652. begin
  2653. SetElements(AName,CreateJSON(AVAlue));
  2654. end;
  2655. procedure TJSONObject.SetUnicodeStrings(const AName: String;
  2656. const AValue: TJSONUnicodeStringType);
  2657. begin
  2658. SetElements(AName,CreateJSON(AValue));
  2659. end;
  2660. {$ELSE}
  2661. function TJSONObject.GetNativeInts(const AName: String): NativeInt;
  2662. begin
  2663. Result:=GetElements(AName).AsNativeInt;
  2664. end;
  2665. procedure TJSONObject.SetNativeInts(const AName: String; const AValue: NativeInt);
  2666. begin
  2667. SetElements(AName,CreateJSON(AVAlue));
  2668. end;
  2669. {$ENDIF}
  2670. function TJSONObject.GetIsNull(const AName: String): Boolean;
  2671. begin
  2672. Result:=GetElements(AName).IsNull;
  2673. end;
  2674. function TJSONObject.GetNameOf(Index: Integer): TJSONStringType;
  2675. begin
  2676. {$IFDEF PAS2JS}
  2677. if FNames=nil then
  2678. FNames:=TJSObject.getOwnPropertyNames(FHash);
  2679. if (Index<0) or (Index>=FCount) then
  2680. DoError(SListIndexError,[Index]);
  2681. Result:=copy(FNames[Index],2);
  2682. {$else}
  2683. Result:=FHash.NameOfIndex(Index);
  2684. {$ENDIF}
  2685. end;
  2686. function TJSONObject.GetObjects(const AName : String): TJSONObject;
  2687. begin
  2688. Result:=GetElements(AName) as TJSONObject;
  2689. end;
  2690. function TJSONObject.GetStrings(const AName : String): TJSONStringType;
  2691. begin
  2692. Result:=GetElements(AName).AsString;
  2693. end;
  2694. function TJSONObject.GetTypes(const AName : String): TJSONType;
  2695. begin
  2696. Result:=Getelements(Aname).JSONType;
  2697. end;
  2698. class function TJSONObject.GetUnquotedMemberNames: Boolean; {$IFNDEF PAS2JS}static;{$ENDIF}
  2699. begin
  2700. Result:=FUnquotedMemberNames;
  2701. end;
  2702. procedure TJSONObject.SetArrays(const AName : String; const AValue: TJSONArray);
  2703. begin
  2704. SetElements(AName,AVAlue);
  2705. end;
  2706. procedure TJSONObject.SetBooleans(const AName : String; const AValue: Boolean);
  2707. begin
  2708. SetElements(AName,CreateJSON(AVAlue));
  2709. end;
  2710. procedure TJSONObject.SetElements(const AName: string; const AValue: TJSONData);
  2711. {$IFDEF PAS2JS}
  2712. begin
  2713. if not FHash.hasOwnProperty('%'+AName) then
  2714. inc(FCount);
  2715. FHash['%'+AName]:=AValue;
  2716. FNames:=nil;
  2717. end;
  2718. {$else}
  2719. Var
  2720. Index : Integer;
  2721. begin
  2722. Index:=FHash.FindIndexOf(AName);
  2723. If (Index=-1) then
  2724. FHash.Add(AName,AValue)
  2725. else
  2726. FHash.Items[Index]:=AValue; // Will free the previous value.
  2727. end;
  2728. {$ENDIF}
  2729. procedure TJSONObject.SetFloats(const AName : String; const AValue: TJSONFloat);
  2730. begin
  2731. SetElements(AName,CreateJSON(AVAlue));
  2732. end;
  2733. procedure TJSONObject.SetIntegers(const AName : String; const AValue: Integer);
  2734. begin
  2735. SetElements(AName,CreateJSON(AVAlue));
  2736. end;
  2737. procedure TJSONObject.SetIsNull(const AName : String; const AValue: Boolean);
  2738. begin
  2739. If Not AValue then
  2740. DoError(SErrCannotSetNotIsNull);
  2741. SetElements(AName,CreateJSON);
  2742. end;
  2743. procedure TJSONObject.SetObjects(const AName : String; const AValue: TJSONObject);
  2744. begin
  2745. SetElements(AName,AValue);
  2746. end;
  2747. procedure TJSONObject.SetStrings(const AName : String; const AValue: TJSONStringType);
  2748. begin
  2749. SetElements(AName,CreateJSON(AValue));
  2750. end;
  2751. class procedure TJSONObject.DetermineElementQuotes;
  2752. begin
  2753. FObjStartSep:=ObjStartSeps[TJSONData.FCompressedJSON];
  2754. FObjEndSep:=ObjEndSeps[TJSONData.FCompressedJSON];
  2755. if TJSONData.FCompressedJSON then
  2756. FElementEnd:=UnSpacedQuoted[FUnquotedMemberNames]
  2757. else
  2758. FElementEnd:=SpacedQuoted[FUnquotedMemberNames];
  2759. FElementStart:=ElementStart[FUnquotedMemberNames]
  2760. end;
  2761. class procedure TJSONObject.SetUnquotedMemberNames(AValue: Boolean); {$IFNDEF PAS2JS}static;{$ENDIF}
  2762. begin
  2763. if FUnquotedMemberNames=AValue then exit;
  2764. FUnquotedMemberNames:=AValue;
  2765. DetermineElementQuotes;
  2766. end;
  2767. function TJSONObject.DoFindPath(const APath: TJSONStringType; out
  2768. NotFound: TJSONStringType): TJSONdata;
  2769. Var
  2770. N: TJSONStringType;
  2771. L,P,P2 : Integer;
  2772. begin
  2773. If (APath='') then
  2774. Exit(Self);
  2775. N:=APath;
  2776. L:=Length(N);
  2777. P:=1;
  2778. While (P<L) and (N[P]='.') do
  2779. inc(P);
  2780. P2:=P;
  2781. While (P2<=L) and (Not (N[P2] in ['.','['])) do
  2782. inc(P2);
  2783. N:=Copy(APath,P,P2-P);
  2784. If (N='') then
  2785. Result:=Self
  2786. else
  2787. begin
  2788. Result:=Find(N);
  2789. If Result=Nil then
  2790. NotFound:=N+Copy(APath,P2,L-P2)
  2791. else
  2792. begin
  2793. N:=Copy(APath,P2,L-P2+1);
  2794. Result:=Result.DoFindPath(N,NotFound);
  2795. end;
  2796. end;
  2797. end;
  2798. procedure TJSONObject.Converterror(From: Boolean);
  2799. begin
  2800. If From then
  2801. DoError(SErrCannotConvertFromObject)
  2802. else
  2803. DoError(SErrCannotConvertToObject);
  2804. end;
  2805. {$warnings off}
  2806. function TJSONObject.GetAsBoolean: Boolean;
  2807. begin
  2808. ConvertError(True);
  2809. Result:=false;
  2810. end;
  2811. function TJSONObject.GetAsFloat: TJSONFloat;
  2812. begin
  2813. ConvertError(True);
  2814. Result:=0.0;
  2815. end;
  2816. function TJSONObject.GetAsInteger: Integer;
  2817. begin
  2818. ConvertError(True);
  2819. Result:=0;
  2820. end;
  2821. procedure TJSONObject.SetAsBoolean(const AValue: Boolean);
  2822. begin
  2823. ConvertError(False);
  2824. if AValue then ;
  2825. end;
  2826. procedure TJSONObject.SetAsFloat(const AValue: TJSONFloat);
  2827. begin
  2828. ConvertError(False);
  2829. if AValue>0 then ;
  2830. end;
  2831. procedure TJSONObject.SetAsInteger(const AValue: Integer);
  2832. begin
  2833. ConvertError(False);
  2834. if AValue>0 then ;
  2835. end;
  2836. {$IFNDEF PAS2JS}
  2837. function TJSONObject.Add(const AName: String; AValue: TJSONUnicodeStringType
  2838. ): Integer;
  2839. begin
  2840. Result:=DoAdd(AName,CreateJSON(AValue));
  2841. end;
  2842. function TJSONObject.Add(const AName: TJSONStringType; Avalue: Int64): Integer;
  2843. begin
  2844. Result:=DoAdd(AName,CreateJSON(AValue));
  2845. end;
  2846. function TJSONObject.Add(const AName: TJSONStringType; Avalue: QWord): Integer;
  2847. begin
  2848. Result:=DoAdd(AName,CreateJSON(AValue));
  2849. end;
  2850. function TJSONObject.GetAsInt64: Int64;
  2851. begin
  2852. ConvertError(True);
  2853. end;
  2854. function TJSONObject.GetAsQWord: QWord;
  2855. begin
  2856. ConvertError(True);
  2857. end;
  2858. procedure TJSONObject.SetAsInt64(const AValue: Int64);
  2859. begin
  2860. ConvertError(False);
  2861. if AValue>0 then ;
  2862. end;
  2863. procedure TJSONObject.SetAsQword(const AValue: QWord);
  2864. begin
  2865. ConvertError(False);
  2866. if AValue>0 then ;
  2867. end;
  2868. {$ELSE}
  2869. function TJSONObject.GetAsNativeInt: NativeInt;
  2870. begin
  2871. ConvertError(True);
  2872. Result:=0;
  2873. end;
  2874. Procedure TJSONObject.SetAsNativeInt(const aValue : NativeInt);
  2875. begin
  2876. ConvertError(False);
  2877. if AValue<>0 then;
  2878. end;
  2879. function TJSONObject.Add(const AName: TJSONStringType; Avalue: NativeInt): Integer;
  2880. begin
  2881. Result:=DoAdd(AName,CreateJSON(AValue));
  2882. end;
  2883. {$ENDIF}
  2884. {$warnings on}
  2885. function TJSONObject.GetAsJSON: TJSONStringType;
  2886. Var
  2887. I : Integer;
  2888. Sep : String;
  2889. V : TJSONStringType;
  2890. D : TJSONData;
  2891. begin
  2892. Sep:=TJSONData.FElementSep;
  2893. Result:='';
  2894. For I:=0 to Count-1 do
  2895. begin
  2896. If (Result<>'') then
  2897. Result:=Result+Sep;
  2898. D:=Items[i];
  2899. if Assigned(D) then
  2900. V:=Items[I].AsJSON
  2901. else
  2902. V:='null';
  2903. Result:=Result+FElementStart+StringToJSONString(Names[i])+FElementEnd+V;
  2904. end;
  2905. If (Result<>'') then
  2906. Result:=FObjStartSep+Result+FObjEndSep
  2907. else
  2908. Result:='{}';
  2909. end;
  2910. {$warnings off}
  2911. function TJSONObject.GetAsString: TJSONStringType;
  2912. begin
  2913. ConvertError(True);
  2914. Result:='';
  2915. end;
  2916. procedure TJSONObject.SetAsString(const AValue: TJSONStringType);
  2917. begin
  2918. ConvertError(False);
  2919. if AValue='' then ;
  2920. end;
  2921. function TJSONObject.GetValue: TJSONVariant;
  2922. begin
  2923. ConvertError(True);
  2924. Result:=0;
  2925. end;
  2926. procedure TJSONObject.SetValue(const AValue: TJSONVariant);
  2927. begin
  2928. ConvertError(False);
  2929. {$IFDEF PAS2JS}
  2930. if AValue=0 then ;
  2931. {$else}
  2932. if VarType(AValue)=0 then ;
  2933. {$ENDIF}
  2934. end;
  2935. {$warnings on}
  2936. function TJSONObject.GetCount: Integer;
  2937. begin
  2938. {$IFDEF PAS2JS}
  2939. Result:=FCount;
  2940. {$else}
  2941. Result:=FHash.Count;
  2942. {$ENDIF}
  2943. end;
  2944. function TJSONObject.GetItem(Index: Integer): TJSONData;
  2945. begin
  2946. {$IFDEF PAS2JS}
  2947. Result:=GetElements(GetNameOf(Index));
  2948. {$else}
  2949. Result:=TJSONData(FHash.Items[Index]);
  2950. {$ENDIF}
  2951. end;
  2952. procedure TJSONObject.SetItem(Index: Integer; const AValue: TJSONData);
  2953. begin
  2954. {$IFDEF PAS2JS}
  2955. SetElements(GetNameOf(Index),AValue);
  2956. {$else}
  2957. FHash.Items[Index]:=AValue;
  2958. {$ENDIF}
  2959. end;
  2960. constructor TJSONObject.Create;
  2961. begin
  2962. {$IFDEF PAS2JS}
  2963. FHash:=TJSObject.new;
  2964. {$else}
  2965. FHash:=TFPHashObjectList.Create(True);
  2966. {$ENDIF}
  2967. end;
  2968. constructor TJSONObject.Create(const Elements: array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF});
  2969. Var
  2970. I : integer;
  2971. AName : TJSONUnicodeStringType;
  2972. J : TJSONData;
  2973. begin
  2974. Create;
  2975. If ((High(Elements)-Low(Elements)) mod 2)=0 then
  2976. DoError(SErrOddNumber);
  2977. I:=Low(Elements);
  2978. While I<=High(Elements) do
  2979. begin
  2980. {$IFDEF PAS2JS}
  2981. if isString(Elements[I]) then
  2982. AName:=String(Elements[I])
  2983. else
  2984. DoError(SErrNameMustBeString,[I+1]);
  2985. {$else}
  2986. With Elements[i] do
  2987. Case VType of
  2988. vtChar : AName:=TJSONUnicodeStringType(VChar);
  2989. vtString : AName:=TJSONUnicodeStringType(vString^);
  2990. vtAnsiString : AName:=UTF8Decode(StrPas(VPChar));
  2991. vtPChar : AName:=TJSONUnicodeStringType(StrPas(VPChar));
  2992. else
  2993. DoError(SErrNameMustBeString,[I+1]);
  2994. end;
  2995. {$ENDIF}
  2996. If (AName='') then
  2997. DoError(SErrNameMustBeString,[I+1]);
  2998. Inc(I);
  2999. J:=VarRecToJSON(Elements[i],'Object');
  3000. {$IFDEF FPC_HAS_CPSTRING}
  3001. Add(UTF8Encode(AName),J);
  3002. {$ELSE}
  3003. Add(AName,J);
  3004. {$ENDIF}
  3005. Inc(I);
  3006. end;
  3007. end;
  3008. destructor TJSONObject.Destroy;
  3009. begin
  3010. {$IFDEF PAS2JS}
  3011. FHash:=nil;
  3012. {$else}
  3013. FreeAndNil(FHash);
  3014. {$ENDIF}
  3015. inherited Destroy;
  3016. end;
  3017. class function TJSONObject.JSONType: TJSONType;
  3018. begin
  3019. Result:=jtObject;
  3020. end;
  3021. function TJSONObject.Clone: TJSONData;
  3022. Var
  3023. O : TJSONObject;
  3024. I: Integer;
  3025. begin
  3026. O:=TJSONObjectClass(ClassType).Create;
  3027. try
  3028. For I:=0 to Count-1 do
  3029. O.Add(Self.Names[I],Self.Items[I].Clone);
  3030. Result:=O;
  3031. except
  3032. FreeAndNil(O);
  3033. Raise;
  3034. end;
  3035. end;
  3036. function TJSONObject.GetEnumerator: TBaseJSONEnumerator;
  3037. begin
  3038. Result:=TJSONObjectEnumerator.Create(Self);
  3039. end;
  3040. function TJSONObject.DoFormatJSON(Options: TFormatOptions; CurrentIndent,
  3041. Indent: Integer): TJSONStringType;
  3042. Var
  3043. i : Integer;
  3044. S : TJSONStringType;
  3045. MultiLine,UseQuotes, SkipWhiteSpace,SkipWhiteSpaceOnlyLeading : Boolean;
  3046. NSep,Sep,Ind : String;
  3047. V : TJSONStringType;
  3048. D : TJSONData;
  3049. begin
  3050. Result:='';
  3051. UseQuotes:=Not (foDoNotQuoteMembers in options);
  3052. MultiLine:=Not (foSingleLineObject in Options);
  3053. SkipWhiteSpace:=foSkipWhiteSpace in Options;
  3054. SkipWhiteSpaceOnlyLeading:=foSkipWhiteSpaceOnlyLeading in Options;
  3055. CurrentIndent:=CurrentIndent+Indent;
  3056. Ind:=IndentString(Options, CurrentIndent);
  3057. If SkipWhiteSpace then
  3058. begin
  3059. if SkipWhiteSpaceOnlyLeading then
  3060. NSep:=': '
  3061. else
  3062. NSep:=':'
  3063. end
  3064. else
  3065. NSep:=' : ';
  3066. If MultiLine then
  3067. Sep:=','+SLineBreak+Ind
  3068. else if SkipWhiteSpace then
  3069. Sep:=','
  3070. else
  3071. Sep:=', ';
  3072. For I:=0 to Count-1 do
  3073. begin
  3074. If (I>0) then
  3075. Result:=Result+Sep
  3076. else If MultiLine then
  3077. Result:=Result+Ind;
  3078. S:=StringToJSONString(Names[i]);
  3079. If UseQuotes then
  3080. S:='"'+S+'"';
  3081. D:=Items[i];
  3082. if D=Nil then
  3083. V:='null'
  3084. else
  3085. v:=Items[I].DoFormatJSON(Options,CurrentIndent,Indent);
  3086. Result:=Result+S+NSep+V;
  3087. end;
  3088. If (Result<>'') then
  3089. begin
  3090. if MultiLine then
  3091. Result:='{'+sLineBreak+Result+sLineBreak+indentString(options,CurrentIndent-Indent)+'}'
  3092. else
  3093. Result:=ObjStartSeps[SkipWhiteSpace]+Result+ObjEndSeps[SkipWhiteSpace]
  3094. end
  3095. else
  3096. Result:='{}';
  3097. end;
  3098. procedure TJSONObject.Iterate(Iterator: TJSONObjectIterator; Data: TObject);
  3099. {$IFDEF PAS2JS}
  3100. var
  3101. i: Integer;
  3102. Cont: Boolean;
  3103. begin
  3104. if FNames=nil then
  3105. FNames:=TJSObject.getOwnPropertyNames(FHash);
  3106. Cont:=True;
  3107. for i:=0 to length(FNames) do
  3108. begin
  3109. Iterator(copy(FNames[I],2),TJSONData(FHash[FNames[i]]),Data,Cont);
  3110. if not Cont then break;
  3111. end;
  3112. end;
  3113. {$else}
  3114. Var
  3115. I : Integer;
  3116. Cont : Boolean;
  3117. begin
  3118. I:=0;
  3119. Cont:=True;
  3120. While (I<FHash.Count) and Cont do
  3121. begin
  3122. Iterator(Names[I],Items[i],Data,Cont);
  3123. Inc(I);
  3124. end;
  3125. end;
  3126. {$ENDIF}
  3127. function TJSONObject.IndexOf(Item: TJSONData): Integer;
  3128. begin
  3129. {$IFDEF PAS2JS}
  3130. if FNames=nil then
  3131. FNames:=TJSObject.getOwnPropertyNames(FHash);
  3132. for Result:=0 to length(FNames)-1 do
  3133. if TJSONData(FHash[FNames[Result]])=Item then exit;
  3134. Result:=-1;
  3135. {$else}
  3136. Result:=FHash.IndexOf(Item);
  3137. {$ENDIF}
  3138. end;
  3139. function TJSONObject.IndexOfName(const AName: TJSONStringType; CaseInsensitive : Boolean = False): Integer;
  3140. begin
  3141. {$IFDEF PAS2JS}
  3142. if FNames=nil then
  3143. FNames:=TJSObject.getOwnPropertyNames(FHash);
  3144. Result:=TJSArray(FNames).indexOf('%'+AName); // -1 if not found
  3145. {$else}
  3146. Result:=FHash.FindIndexOf(AName);
  3147. {$ENDIF}
  3148. if (Result<0) and CaseInsensitive then
  3149. begin
  3150. Result:=Count-1;
  3151. While (Result>=0) and (CompareText(Names[Result],AName)<>0) do
  3152. Dec(Result);
  3153. end;
  3154. end;
  3155. procedure TJSONObject.Clear;
  3156. begin
  3157. {$IFDEF PAS2JS}
  3158. FCount:=0;
  3159. FHash:=TJSObject.new;
  3160. FNames:=nil;
  3161. {$else}
  3162. FHash.Clear;
  3163. {$ENDIF}
  3164. end;
  3165. function TJSONObject.DoAdd(const AName: TJSONStringType; AValue: TJSONData; FreeOnError : Boolean = True): Integer;
  3166. begin
  3167. if {$IFDEF PAS2JS}FHash.hasOwnProperty('%'+AName){$else}(IndexOfName(aName)<>-1){$ENDIF} then
  3168. begin
  3169. if FreeOnError then
  3170. FreeAndNil(AValue);
  3171. DoError(SErrDuplicateValue,[aName]);
  3172. end;
  3173. {$IFDEF PAS2JS}
  3174. FHash['%'+AName]:=AValue;
  3175. FNames:=nil;
  3176. inc(FCount);
  3177. Result:=FCount;
  3178. {$else}
  3179. Result:=FHash.Add(AName,AValue);
  3180. {$ENDIF}
  3181. end;
  3182. function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONData
  3183. ): Integer;
  3184. begin
  3185. Result:=DoAdd(aName,AValue,False);
  3186. end;
  3187. function TJSONObject.Add(const AName: TJSONStringType; AValue: Boolean
  3188. ): Integer;
  3189. begin
  3190. Result:=DoAdd(AName,CreateJSON(AValue));
  3191. end;
  3192. function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer;
  3193. begin
  3194. Result:=DoAdd(AName,CreateJSON(AValue));
  3195. end;
  3196. function TJSONObject.Add(const AName, AValue: TJSONStringType): Integer;
  3197. begin
  3198. Result:=DoAdd(AName,CreateJSON(AValue));
  3199. end;
  3200. function TJSONObject.Add(const AName: TJSONStringType; Avalue: Integer): Integer;
  3201. begin
  3202. Result:=DoAdd(AName,CreateJSON(AValue));
  3203. end;
  3204. function TJSONObject.Add(const AName: TJSONStringType): Integer;
  3205. begin
  3206. Result:=DoAdd(AName,CreateJSON);
  3207. end;
  3208. function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONArray
  3209. ): Integer;
  3210. begin
  3211. Result:=DoAdd(AName,TJSONData(AValue),False);
  3212. end;
  3213. procedure TJSONObject.Delete(Index: Integer);
  3214. begin
  3215. {$IFDEF PAS2JS}
  3216. if (Index<0) or (Index>=FCount) then
  3217. DoError(SListIndexError,[Index]);
  3218. JSDelete(FHash,'%'+GetNameOf(Index));
  3219. FNames:=nil;
  3220. dec(FCount);
  3221. {$else}
  3222. FHash.Delete(Index);
  3223. {$ENDIF}
  3224. end;
  3225. procedure TJSONObject.Delete(const AName: string);
  3226. {$IFDEF PAS2JS}
  3227. begin
  3228. if not FHash.hasOwnProperty('%'+AName) then exit;
  3229. JSDelete(FHash,'%'+AName);
  3230. FNames:=nil;
  3231. dec(FCount);
  3232. end;
  3233. {$else}
  3234. Var
  3235. I : Integer;
  3236. begin
  3237. I:=IndexOfName(AName);
  3238. if (I<>-1) then
  3239. Delete(I);
  3240. end;
  3241. {$ENDIF}
  3242. procedure TJSONObject.Remove(Item: TJSONData);
  3243. {$IFDEF PAS2JS}
  3244. var AName: String;
  3245. begin
  3246. for AName in FHash do
  3247. if FHash.hasOwnProperty(AName) and (FHash[AName]=Item) then
  3248. begin
  3249. JSDelete(FHash,AName);
  3250. FNames:=nil;
  3251. dec(FCount);
  3252. exit;
  3253. end;
  3254. end;
  3255. {$else}
  3256. begin
  3257. FHash.Remove(Item);
  3258. end;
  3259. {$ENDIF}
  3260. function TJSONObject.Extract(Index: Integer): TJSONData;
  3261. {$IFDEF PAS2JS}
  3262. Var
  3263. N : String;
  3264. begin
  3265. N:=GetNameOf(Index);
  3266. Result:=Extract(N);
  3267. end;
  3268. {$ELSE}
  3269. begin
  3270. Result:=Items[Index];
  3271. FHash.Extract(Result);
  3272. end;
  3273. {$ENDIF}
  3274. function TJSONObject.Extract(const AName: string): TJSONData;
  3275. {$IFDEF PAS2JS}
  3276. begin
  3277. if FHash.hasOwnProperty('%'+AName) then
  3278. begin
  3279. Result:=TJSONData(FHash['%'+AName]);
  3280. FHash['%'+AName]:=undefined;
  3281. Dec(FCount);
  3282. end
  3283. else
  3284. Result:=nil;
  3285. end;
  3286. {$ELSE}
  3287. Var
  3288. I : Integer;
  3289. begin
  3290. I:=IndexOfName(AName);
  3291. if (I<>-1) then
  3292. Result:=Extract(I)
  3293. else
  3294. Result:=Nil
  3295. end;
  3296. {$ENDIF}
  3297. function TJSONObject.Get(const AName: String): TJSONVariant;
  3298. {$IFDEF PAS2JS}
  3299. begin
  3300. if FHash.hasOwnProperty('%'+AName) then
  3301. Result:=TJSONData(FHash['%'+AName]).Value
  3302. else
  3303. Result:=nil;
  3304. end;
  3305. {$else}
  3306. Var
  3307. I : Integer;
  3308. begin
  3309. I:=IndexOfName(AName);
  3310. If (I<>-1) then
  3311. Result:=Items[i].Value
  3312. else
  3313. Result:=Null;
  3314. end;
  3315. {$ENDIF}
  3316. function TJSONObject.Get(const AName: String; ADefault: TJSONFloat
  3317. ): TJSONFloat;
  3318. Var
  3319. D : TJSONData;
  3320. begin
  3321. D:=Find(AName,jtNumber);
  3322. If D<>Nil then
  3323. Result:=D.AsFloat
  3324. else
  3325. Result:=ADefault;
  3326. end;
  3327. function TJSONObject.Get(const AName: String; ADefault: Integer
  3328. ): Integer;
  3329. Var
  3330. D : TJSONData;
  3331. begin
  3332. D:=Find(AName,jtNumber);
  3333. If D<>Nil then
  3334. Result:=D.AsInteger
  3335. else
  3336. Result:=ADefault;
  3337. end;
  3338. {$IFNDEF PAS2JS}
  3339. function TJSONObject.Get(const AName: String; ADefault: Int64): Int64;
  3340. Var
  3341. D : TJSONData;
  3342. begin
  3343. D:=Find(AName,jtNumber);
  3344. If D<>Nil then
  3345. Result:=D.AsInt64
  3346. else
  3347. Result:=ADefault;
  3348. end;
  3349. function TJSONObject.Get(const AName: String; ADefault: QWord): QWord;
  3350. Var
  3351. D : TJSONData;
  3352. begin
  3353. D:=Find(AName,jtNumber);
  3354. If D<>Nil then
  3355. Result:=D.AsQWord
  3356. else
  3357. Result:=ADefault;
  3358. end;
  3359. {$ENDIF}
  3360. function TJSONObject.Get(const AName: String; ADefault: Boolean
  3361. ): Boolean;
  3362. Var
  3363. D : TJSONData;
  3364. begin
  3365. D:=Find(AName,jtBoolean);
  3366. If D<>Nil then
  3367. Result:=D.AsBoolean
  3368. else
  3369. Result:=ADefault;
  3370. end;
  3371. function TJSONObject.Get(const AName: String; ADefault: TJSONStringType
  3372. ): TJSONStringType;
  3373. Var
  3374. D : TJSONData;
  3375. begin
  3376. D:=Find(AName,jtString);
  3377. If (D<>Nil) then
  3378. Result:=D.AsString
  3379. else
  3380. Result:=ADefault;
  3381. end;
  3382. {$IFNDEF PAS2JS}
  3383. function TJSONObject.Get(const AName: String; ADefault: TJSONUnicodeStringType
  3384. ): TJSONUnicodeStringType;
  3385. Var
  3386. D : TJSONData;
  3387. begin
  3388. D:=Find(AName,jtString);
  3389. If (D<>Nil) then
  3390. Result:=D.AsUnicodeString
  3391. else
  3392. Result:=ADefault;
  3393. end;
  3394. {$ENDIF}
  3395. function TJSONObject.Get(const AName: String; ADefault: TJSONArray
  3396. ): TJSONArray;
  3397. Var
  3398. D : TJSONData;
  3399. begin
  3400. D:=Find(AName,jtArray);
  3401. If (D<>Nil) then
  3402. Result:=TJSONArray(D)
  3403. else
  3404. Result:=ADefault;
  3405. end;
  3406. function TJSONObject.Get(const AName: String; ADefault: TJSONObject
  3407. ): TJSONObject;
  3408. Var
  3409. D : TJSONData;
  3410. begin
  3411. D:=Find(AName,jtObject);
  3412. If (D<>Nil) then
  3413. Result:=TJSONObject(D)
  3414. else
  3415. Result:=ADefault;
  3416. end;
  3417. function TJSONObject.Find(const AName: String): TJSONData;
  3418. {$IFDEF PAS2JS}
  3419. begin
  3420. if FHash.hasOwnProperty('%'+AName) then
  3421. Result:=TJSONData(FHash['%'+AName])
  3422. else
  3423. Result:=nil;
  3424. end;
  3425. {$else}
  3426. Var
  3427. I : Integer;
  3428. begin
  3429. I:=IndexOfName(AName);
  3430. If (I<>-1) then
  3431. Result:=Items[i]
  3432. else
  3433. Result:=Nil;
  3434. end;
  3435. {$ENDIF}
  3436. function TJSONObject.Find(const AName: String; AType: TJSONType): TJSONData;
  3437. begin
  3438. Result:=Find(AName);
  3439. If Assigned(Result) and (Result.JSONType<>AType) then
  3440. Result:=Nil;
  3441. end;
  3442. function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONData): boolean;
  3443. begin
  3444. AValue := Find(key);
  3445. Result := assigned(AValue);
  3446. end;
  3447. function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONObject): boolean;
  3448. var
  3449. v: TJSONData;
  3450. begin
  3451. v := Find(key);
  3452. Result := assigned(v) and (v.JSONType = jtObject);
  3453. if Result then
  3454. AValue := TJSONObject(v);
  3455. end;
  3456. function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONArray): boolean;
  3457. var
  3458. v: TJSONData;
  3459. begin
  3460. v := Find(key);
  3461. Result := assigned(v) and (v.JSONType = jtArray);
  3462. if Result then
  3463. AValue := TJSONArray(v);
  3464. end;
  3465. function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONString): boolean;
  3466. var
  3467. v: TJSONData;
  3468. begin
  3469. v := Find(key);
  3470. Result := assigned(v) and (v.JSONType = jtString);
  3471. if Result then
  3472. AValue := TJSONString(v);
  3473. end;
  3474. function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONBoolean): boolean;
  3475. var
  3476. v: TJSONData;
  3477. begin
  3478. v := Find(key);
  3479. Result := assigned(v) and (v.JSONType = jtBoolean);
  3480. if Result then
  3481. AValue := TJSONBoolean(v);
  3482. end;
  3483. function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONNumber): boolean;
  3484. var
  3485. v: TJSONData;
  3486. begin
  3487. v := Find(key);
  3488. Result := assigned(v) and (v.JSONType = jtNumber);
  3489. if Result then
  3490. AValue := TJSONNumber(v);
  3491. end;
  3492. initialization
  3493. // Need to force initialization;
  3494. TJSONData.DetermineElementSeparators;
  3495. TJSONObject.DetermineElementQuotes;
  3496. end.