fpjson.pp 75 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030
  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. variants,
  17. SysUtils,
  18. classes,
  19. contnrs;
  20. type
  21. TJSONtype = (jtUnknown, jtNumber, jtString, jtBoolean, jtNull, jtArray, jtObject);
  22. TJSONInstanceType = (jitUnknown, jitNumberInteger,jitNumberInt64,jitNumberQWord,jitNumberFloat,
  23. jitString, jitBoolean, jitNull, jitArray, jitObject);
  24. TJSONFloat = Double;
  25. TJSONStringType = AnsiString;
  26. TJSONCharType = AnsiChar;
  27. PJSONCharType = ^TJSONCharType;
  28. TFormatOption = (foSingleLineArray, // Array without CR/LF : all on one line
  29. foSingleLineObject, // Object without CR/LF : all on one line
  30. foDoNotQuoteMembers, // Do not quote object member names.
  31. foUseTabchar, // Use tab characters instead of spaces.
  32. foSkipWhiteSpace); // Do not use whitespace at all
  33. TFormatOptions = set of TFormatOption;
  34. Const
  35. DefaultIndentSize = 2;
  36. DefaultFormat = [];
  37. AsJSONFormat = [foSingleLineArray,foSingleLineObject]; // These options make FormatJSON behave as AsJSON
  38. AsCompressedJSON = [foSingleLineArray,foSingleLineObject,foskipWhiteSpace]; // These options make FormatJSON behave as AsJSON with TJSONData.CompressedJSON=True
  39. AsCompactJSON = [foSingleLineArray,foSingleLineObject,foskipWhiteSpace,foDoNotQuoteMembers]; // These options make FormatJSON behave as AsJSON with TJSONData.CompressedJSON=True and TJSONObject.UnquotedMemberNames=True
  40. Type
  41. TJSONData = Class;
  42. { TMJBaseObjectEnumerator }
  43. TJSONEnum = Record
  44. Key : TJSONStringType;
  45. KeyNum : Integer;
  46. Value : TJSONData;
  47. end;
  48. TBaseJSONEnumerator = class
  49. public
  50. function GetCurrent: TJSONEnum; virtual; abstract;
  51. function MoveNext : Boolean; virtual; abstract;
  52. property Current: TJSONEnum read GetCurrent;
  53. end;
  54. { TMJObjectEnumerator }
  55. { TJSONData }
  56. TJSONData = class(TObject)
  57. private
  58. Const
  59. ElementSeps : Array[Boolean] of TJSONStringType = (', ',',');
  60. Class Var FCompressedJSON : Boolean;
  61. Class Var FElementSep : TJSONStringType;
  62. class procedure DetermineElementSeparators;
  63. class function GetCompressedJSON: Boolean; static;
  64. class procedure SetCompressedJSON(AValue: Boolean); static;
  65. protected
  66. Class Procedure DoError(Const Msg : String);
  67. Class Procedure DoError(Const Fmt : String; const Args : Array of const);
  68. Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; virtual;
  69. function GetAsBoolean: Boolean; virtual; abstract;
  70. function GetAsFloat: TJSONFloat; virtual; abstract;
  71. function GetAsInteger: Integer; virtual; abstract;
  72. function GetAsInt64: Int64; virtual; abstract;
  73. function GetAsQWord: QWord; virtual; abstract;
  74. function GetIsNull: Boolean; virtual;
  75. procedure SetAsBoolean(const AValue: Boolean); virtual; abstract;
  76. procedure SetAsFloat(const AValue: TJSONFloat); virtual; abstract;
  77. procedure SetAsInteger(const AValue: Integer); virtual; abstract;
  78. procedure SetAsInt64(const AValue: Int64); virtual; abstract;
  79. procedure SetAsQword(const AValue: QWord); virtual; abstract;
  80. function GetAsJSON: TJSONStringType; virtual; abstract;
  81. function GetAsString: TJSONStringType; virtual; abstract;
  82. procedure SetAsString(const AValue: TJSONStringType); virtual; abstract;
  83. function GetValue: variant; virtual; abstract;
  84. procedure SetValue(const AValue: variant); virtual; abstract;
  85. function GetItem(Index : Integer): TJSONData; virtual;
  86. procedure SetItem(Index : Integer; const AValue: TJSONData); virtual;
  87. Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; virtual;
  88. function GetCount: Integer; virtual;
  89. Public
  90. Class function JSONType: TJSONType; virtual;
  91. Class Property CompressedJSON : Boolean Read GetCompressedJSON Write SetCompressedJSON;
  92. public
  93. Constructor Create; virtual;
  94. Procedure Clear; virtual; Abstract;
  95. Procedure DumpJSON(S : TStream);
  96. // Get enumerator
  97. function GetEnumerator: TBaseJSONEnumerator; virtual;
  98. Function FindPath(Const APath : TJSONStringType) : TJSONdata;
  99. Function GetPath(Const APath : TJSONStringType) : TJSONdata;
  100. Function Clone : TJSONData; virtual; abstract;
  101. Function FormatJSON(Options : TFormatOptions = DefaultFormat; Indentsize : Integer = DefaultIndentSize) : TJSONStringType;
  102. property Count: Integer read GetCount;
  103. property Items[Index: Integer]: TJSONData read GetItem write SetItem;
  104. property Value: variant read GetValue write SetValue;
  105. Property AsString : TJSONStringType Read GetAsString Write SetAsString;
  106. Property AsFloat : TJSONFloat Read GetAsFloat Write SetAsFloat;
  107. Property AsInteger : Integer Read GetAsInteger Write SetAsInteger;
  108. Property AsInt64 : Int64 Read GetAsInt64 Write SetAsInt64;
  109. Property AsQWord : QWord Read GetAsQWord Write SetAsQword;
  110. Property AsBoolean : Boolean Read GetAsBoolean Write SetAsBoolean;
  111. Property IsNull : Boolean Read GetIsNull;
  112. Property AsJSON : TJSONStringType Read GetAsJSON;
  113. end;
  114. TJSONDataClass = Class of TJSONData;
  115. TJSONNumberType = (ntFloat,ntInteger,ntInt64,ntQWord);
  116. TJSONNumber = class(TJSONData)
  117. protected
  118. public
  119. class function JSONType: TJSONType; override;
  120. class function NumberType : TJSONNumberType; virtual; abstract;
  121. end;
  122. { TJSONFloatNumber }
  123. TJSONFloatNumber = class(TJSONNumber)
  124. Private
  125. FValue : TJSONFloat;
  126. protected
  127. function GetAsBoolean: Boolean; override;
  128. function GetAsFloat: TJSONFloat; override;
  129. function GetAsInteger: Integer; override;
  130. function GetAsInt64: Int64; override;
  131. function GetAsQWord: QWord; override;
  132. procedure SetAsBoolean(const AValue: Boolean); override;
  133. procedure SetAsFloat(const AValue: TJSONFloat); override;
  134. procedure SetAsInteger(const AValue: Integer); override;
  135. procedure SetAsInt64(const AValue: Int64); override;
  136. procedure SetAsQword(const AValue: QWord); override;
  137. function GetAsJSON: TJSONStringType; override;
  138. function GetAsString: TJSONStringType; override;
  139. procedure SetAsString(const AValue: TJSONStringType); override;
  140. function GetValue: variant; override;
  141. procedure SetValue(const AValue: variant); override;
  142. public
  143. Constructor Create(AValue : TJSONFloat); reintroduce;
  144. class function NumberType : TJSONNumberType; override;
  145. Procedure Clear; override;
  146. Function Clone : TJSONData; override;
  147. end;
  148. TJSONFloatNumberClass = Class of TJSONFloatNumber;
  149. { TJSONIntegerNumber }
  150. TJSONIntegerNumber = class(TJSONNumber)
  151. Private
  152. FValue : Integer;
  153. protected
  154. function GetAsBoolean: Boolean; override;
  155. function GetAsFloat: TJSONFloat; override;
  156. function GetAsInteger: Integer; override;
  157. function GetAsInt64: Int64; override;
  158. function GetAsQWord: QWord; override;
  159. procedure SetAsBoolean(const AValue: Boolean); override;
  160. procedure SetAsFloat(const AValue: TJSONFloat); override;
  161. procedure SetAsInteger(const AValue: Integer); override;
  162. procedure SetAsInt64(const AValue: Int64); override;
  163. procedure SetAsQword(const AValue: QWord); override;
  164. function GetAsJSON: TJSONStringType; override;
  165. function GetAsString: TJSONStringType; override;
  166. procedure SetAsString(const AValue: TJSONStringType); override;
  167. function GetValue: variant; override;
  168. procedure SetValue(const AValue: variant); override;
  169. public
  170. Constructor Create(AValue : Integer); reintroduce;
  171. class function NumberType : TJSONNumberType; override;
  172. Procedure Clear; override;
  173. Function Clone : TJSONData; override;
  174. end;
  175. TJSONIntegerNumberClass = Class of TJSONIntegerNumber;
  176. { TJSONInt64Number }
  177. TJSONInt64Number = class(TJSONNumber)
  178. Private
  179. FValue : Int64;
  180. protected
  181. function GetAsBoolean: Boolean; override;
  182. function GetAsFloat: TJSONFloat; override;
  183. function GetAsInteger: Integer; override;
  184. function GetAsInt64: Int64; override;
  185. function GetAsQWord: QWord; override;
  186. procedure SetAsBoolean(const AValue: Boolean); override;
  187. procedure SetAsFloat(const AValue: TJSONFloat); override;
  188. procedure SetAsInteger(const AValue: Integer); override;
  189. procedure SetAsInt64(const AValue: Int64); override;
  190. procedure SetAsQword(const AValue: QWord); override;
  191. function GetAsJSON: TJSONStringType; override;
  192. function GetAsString: TJSONStringType; override;
  193. procedure SetAsString(const AValue: TJSONStringType); override;
  194. function GetValue: variant; override;
  195. procedure SetValue(const AValue: variant); override;
  196. public
  197. Constructor Create(AValue : Int64); reintroduce;
  198. class function NumberType : TJSONNumberType; override;
  199. Procedure Clear; override;
  200. Function Clone : TJSONData; override;
  201. end;
  202. TJSONInt64NumberClass = Class of TJSONInt64Number;
  203. { TJSONQWordNumber }
  204. TJSONQWordNumber = class(TJSONNumber)
  205. Private
  206. FValue : Qword;
  207. protected
  208. function GetAsBoolean: Boolean; override;
  209. function GetAsFloat: TJSONFloat; override;
  210. function GetAsInteger: Integer; override;
  211. function GetAsInt64: Int64; override;
  212. function GetAsQWord: QWord; override;
  213. procedure SetAsBoolean(const AValue: Boolean); override;
  214. procedure SetAsFloat(const AValue: TJSONFloat); override;
  215. procedure SetAsInteger(const AValue: Integer); override;
  216. procedure SetAsInt64(const AValue: Int64); override;
  217. procedure SetAsQword(const AValue: QWord); override;
  218. function GetAsJSON: TJSONStringType; override;
  219. function GetAsString: TJSONStringType; override;
  220. procedure SetAsString(const AValue: TJSONStringType); override;
  221. function GetValue: variant; override;
  222. procedure SetValue(const AValue: variant); override;
  223. public
  224. Constructor Create(AValue : QWord); reintroduce;
  225. class function NumberType : TJSONNumberType; override;
  226. Procedure Clear; override;
  227. Function Clone : TJSONData; override;
  228. end;
  229. TJSONQWordNumberClass = Class of TJSONQWordNumber;
  230. { TJSONString }
  231. TJSONString = class(TJSONData)
  232. Private
  233. FValue: TJSONStringType;
  234. protected
  235. function GetValue: Variant; override;
  236. procedure SetValue(const AValue: Variant); override;
  237. function GetAsBoolean: Boolean; override;
  238. function GetAsFloat: TJSONFloat; override;
  239. function GetAsInteger: Integer; override;
  240. function GetAsInt64: Int64; override;
  241. function GetAsQWord: QWord; override;
  242. procedure SetAsBoolean(const AValue: Boolean); override;
  243. procedure SetAsFloat(const AValue: TJSONFloat); override;
  244. procedure SetAsInteger(const AValue: Integer); override;
  245. procedure SetAsInt64(const AValue: Int64); override;
  246. procedure SetAsQword(const AValue: QWord); override;
  247. function GetAsJSON: TJSONStringType; override;
  248. function GetAsString: TJSONStringType; override;
  249. procedure SetAsString(const AValue: TJSONStringType); override;
  250. public
  251. Constructor Create(const AValue : TJSONStringType); reintroduce;
  252. class function JSONType: TJSONType; override;
  253. Procedure Clear; override;
  254. Function Clone : TJSONData; override;
  255. end;
  256. TJSONStringClass = Class of TJSONString;
  257. { TJSONboolean }
  258. TJSONBoolean = class(TJSONData)
  259. Private
  260. FValue: Boolean;
  261. protected
  262. function GetValue: Variant; override;
  263. procedure SetValue(const AValue: Variant); override;
  264. function GetAsBoolean: Boolean; override;
  265. function GetAsFloat: TJSONFloat; override;
  266. function GetAsInteger: Integer; override;
  267. function GetAsInt64: Int64; override;
  268. function GetAsQWord: QWord; override;
  269. procedure SetAsBoolean(const AValue: Boolean); override;
  270. procedure SetAsFloat(const AValue: TJSONFloat); override;
  271. procedure SetAsInteger(const AValue: Integer); override;
  272. procedure SetAsInt64(const AValue: Int64); override;
  273. procedure SetAsQword(const AValue: QWord); override;
  274. function GetAsJSON: TJSONStringType; override;
  275. function GetAsString: TJSONStringType; override;
  276. procedure SetAsString(const AValue: TJSONStringType); override;
  277. public
  278. Constructor Create(AValue : Boolean); reintroduce;
  279. class function JSONType: TJSONType; override;
  280. Procedure Clear; override;
  281. Function Clone : TJSONData; override;
  282. end;
  283. TJSONBooleanClass = Class of TJSONBoolean;
  284. { TJSONnull }
  285. TJSONNull = class(TJSONData)
  286. protected
  287. Procedure Converterror(From : Boolean);
  288. function GetAsBoolean: Boolean; override;
  289. function GetAsFloat: TJSONFloat; override;
  290. function GetAsInteger: Integer; override;
  291. function GetAsInt64: Int64; override;
  292. function GetAsQWord: QWord; override;
  293. function GetIsNull: Boolean; override;
  294. procedure SetAsBoolean(const AValue: Boolean); override;
  295. procedure SetAsFloat(const AValue: TJSONFloat); override;
  296. procedure SetAsInteger(const AValue: Integer); override;
  297. procedure SetAsInt64(const AValue: Int64); override;
  298. procedure SetAsQword(const AValue: QWord); override;
  299. function GetAsJSON: TJSONStringType; override;
  300. function GetAsString: TJSONStringType; override;
  301. procedure SetAsString(const AValue: TJSONStringType); override;
  302. function GetValue: variant; override;
  303. procedure SetValue(const AValue: variant); override;
  304. public
  305. class function JSONType: TJSONType; override;
  306. Procedure Clear; override;
  307. Function Clone : TJSONData; override;
  308. end;
  309. TJSONNullClass = Class of TJSONNull;
  310. TJSONArrayIterator = procedure(Item: TJSONData; Data: TObject; var Continue: Boolean) of object;
  311. { TJSONArray }
  312. TJSONObject = Class;
  313. TJSONArray = class(TJSONData)
  314. Private
  315. FList : TFPObjectList;
  316. function GetArrays(Index : Integer): TJSONArray;
  317. function GetBooleans(Index : Integer): Boolean;
  318. function GetFloats(Index : Integer): TJSONFloat;
  319. function GetIntegers(Index : Integer): Integer;
  320. function GetInt64s(Index : Integer): Int64;
  321. function GetNulls(Index : Integer): Boolean;
  322. function GetObjects(Index : Integer): TJSONObject;
  323. function GetQWords(Index : Integer): QWord;
  324. function GetStrings(Index : Integer): TJSONStringType;
  325. function GetTypes(Index : Integer): TJSONType;
  326. procedure SetArrays(Index : Integer; const AValue: TJSONArray);
  327. procedure SetBooleans(Index : Integer; const AValue: Boolean);
  328. procedure SetFloats(Index : Integer; const AValue: TJSONFloat);
  329. procedure SetIntegers(Index : Integer; const AValue: Integer);
  330. procedure SetInt64s(Index : Integer; const AValue: Int64);
  331. procedure SetObjects(Index : Integer; const AValue: TJSONObject);
  332. procedure SetQWords(Index : Integer; AValue: QWord);
  333. procedure SetStrings(Index : Integer; const AValue: TJSONStringType);
  334. protected
  335. Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; override;
  336. Procedure Converterror(From : Boolean);
  337. function GetAsBoolean: Boolean; override;
  338. function GetAsFloat: TJSONFloat; override;
  339. function GetAsInteger: Integer; override;
  340. function GetAsInt64: Int64; override;
  341. function GetAsQWord: QWord; override;
  342. procedure SetAsBoolean(const AValue: Boolean); override;
  343. procedure SetAsFloat(const AValue: TJSONFloat); override;
  344. procedure SetAsInteger(const AValue: Integer); override;
  345. procedure SetAsInt64(const AValue: Int64); override;
  346. procedure SetAsQword(const AValue: QWord); override;
  347. function GetAsJSON: TJSONStringType; override;
  348. function GetAsString: TJSONStringType; override;
  349. procedure SetAsString(const AValue: TJSONStringType); override;
  350. function GetValue: variant; override;
  351. procedure SetValue(const AValue: variant); override;
  352. function GetCount: Integer; override;
  353. function GetItem(Index : Integer): TJSONData; override;
  354. procedure SetItem(Index : Integer; const AValue: TJSONData); override;
  355. Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; override;
  356. public
  357. Constructor Create; overload; reintroduce;
  358. Constructor Create(const Elements : Array of Const); overload;
  359. Destructor Destroy; override;
  360. class function JSONType: TJSONType; override;
  361. Function Clone : TJSONData; override;
  362. // Examine
  363. procedure Iterate(Iterator : TJSONArrayIterator; Data: TObject);
  364. function IndexOf(obj: TJSONData): Integer;
  365. function GetEnumerator: TBaseJSONEnumerator; override;
  366. // Manipulate
  367. Procedure Clear; override;
  368. function Add(Item : TJSONData): Integer;
  369. function Add(I : Integer): Integer;
  370. function Add(I : Int64): Int64;
  371. function Add(I : QWord): QWord;
  372. function Add(const S : String): Integer;
  373. function Add: Integer;
  374. function Add(F : TJSONFloat): Integer;
  375. function Add(B : Boolean): Integer;
  376. function Add(AnArray : TJSONArray): Integer;
  377. function Add(AnObject: TJSONObject): Integer;
  378. Procedure Delete(Index : Integer);
  379. procedure Exchange(Index1, Index2: Integer);
  380. function Extract(Item: TJSONData): TJSONData;
  381. function Extract(Index : Integer): TJSONData;
  382. procedure Insert(Index: Integer);
  383. procedure Insert(Index: Integer; Item : TJSONData);
  384. procedure Insert(Index: Integer; I : Integer);
  385. procedure Insert(Index: Integer; I : Int64);
  386. procedure Insert(Index: Integer; I : QWord);
  387. procedure Insert(Index: Integer; const S : String);
  388. procedure Insert(Index: Integer; F : TJSONFloat);
  389. procedure Insert(Index: Integer; B : Boolean);
  390. procedure Insert(Index: Integer; AnArray : TJSONArray);
  391. procedure Insert(Index: Integer; AnObject: TJSONObject);
  392. procedure Move(CurIndex, NewIndex: Integer);
  393. Procedure Remove(Item : TJSONData);
  394. // Easy Access Properties.
  395. property Items;default;
  396. Property Types[Index : Integer] : TJSONType Read GetTypes;
  397. Property Nulls[Index : Integer] : Boolean Read GetNulls;
  398. Property Integers[Index : Integer] : Integer Read GetIntegers Write SetIntegers;
  399. Property Int64s[Index : Integer] : Int64 Read GetInt64s Write SetInt64s;
  400. Property QWords[Index : Integer] : QWord Read GetQWords Write SetQWords;
  401. Property Strings[Index : Integer] : TJSONStringType Read GetStrings Write SetStrings;
  402. Property Floats[Index : Integer] : TJSONFloat Read GetFloats Write SetFloats;
  403. Property Booleans[Index : Integer] : Boolean Read GetBooleans Write SetBooleans;
  404. Property Arrays[Index : Integer] : TJSONArray Read GetArrays Write SetArrays;
  405. Property Objects[Index : Integer] : TJSONObject Read GetObjects Write SetObjects;
  406. end;
  407. TJSONArrayClass = Class of TJSONArray;
  408. TJSONObjectIterator = procedure(Const AName : TJSONStringType; Item: TJSONData; Data: TObject; var Continue: Boolean) of object;
  409. { TJSONObject }
  410. TJSONObject = class(TJSONData)
  411. private
  412. Const
  413. ElementStart : Array[Boolean] of TJSONStringType = ('"','');
  414. SpacedQuoted : Array[Boolean] of TJSONStringType = ('" : ',' : ');
  415. UnSpacedQuoted : Array[Boolean] of TJSONStringType = ('":',':');
  416. ObjStartSeps : Array[Boolean] of TJSONStringType = ('{ ','{');
  417. ObjEndSeps : Array[Boolean] of TJSONStringType = (' }','}');
  418. Class var FUnquotedMemberNames: Boolean;
  419. Class var FObjStartSep,FObjEndSep,FElementEnd,FElementStart : TJSONStringType;
  420. Class procedure DetermineElementQuotes;
  421. Private
  422. FHash : TFPHashObjectList; // Careful : Names limited to 255 chars.
  423. function GetArrays(const AName : String): TJSONArray;
  424. function GetBooleans(const AName : String): Boolean;
  425. function GetElements(const AName: string): TJSONData;
  426. function GetFloats(const AName : String): TJSONFloat;
  427. function GetIntegers(const AName : String): Integer;
  428. function GetInt64s(const AName : String): Int64;
  429. function GetIsNull(const AName : String): Boolean; reintroduce;
  430. function GetNameOf(Index : Integer): TJSONStringType;
  431. function GetObjects(const AName : String): TJSONObject;
  432. function GetQWords(AName : String): QWord;
  433. function GetStrings(const AName : String): TJSONStringType;
  434. function GetTypes(const AName : String): TJSONType;
  435. procedure SetArrays(const AName : String; const AValue: TJSONArray);
  436. procedure SetBooleans(const AName : String; const AValue: Boolean);
  437. procedure SetElements(const AName: string; const AValue: TJSONData);
  438. procedure SetFloats(const AName : String; const AValue: TJSONFloat);
  439. procedure SetIntegers(const AName : String; const AValue: Integer);
  440. procedure SetInt64s(const AName : String; const AValue: Int64);
  441. procedure SetIsNull(const AName : String; const AValue: Boolean);
  442. procedure SetObjects(const AName : String; const AValue: TJSONObject);
  443. procedure SetQWords(AName : String; AValue: QWord);
  444. procedure SetStrings(const AName : String; const AValue: TJSONStringType);
  445. class function GetUnquotedMemberNames: Boolean; static;
  446. class procedure SetUnquotedMemberNames(AValue: Boolean); static;
  447. protected
  448. Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; override;
  449. Procedure Converterror(From : Boolean);
  450. function GetAsBoolean: Boolean; override;
  451. function GetAsFloat: TJSONFloat; override;
  452. function GetAsInteger: Integer; override;
  453. function GetAsInt64: Int64; override;
  454. function GetAsQWord: QWord; override;
  455. procedure SetAsBoolean(const AValue: Boolean); override;
  456. procedure SetAsFloat(const AValue: TJSONFloat); override;
  457. procedure SetAsInteger(const AValue: Integer); override;
  458. procedure SetAsInt64(const AValue: Int64); override;
  459. procedure SetAsQword(const AValue: QWord); override;
  460. function GetAsJSON: TJSONStringType; override;
  461. function GetAsString: TJSONStringType; override;
  462. procedure SetAsString(const AValue: TJSONStringType); override;
  463. function GetValue: variant; override;
  464. procedure SetValue(const AValue: variant); override;
  465. function GetCount: Integer; override;
  466. function GetItem(Index : Integer): TJSONData; override;
  467. procedure SetItem(Index : Integer; const AValue: TJSONData); override;
  468. Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; override;
  469. public
  470. constructor Create; reintroduce;
  471. Constructor Create(const Elements : Array of Const); overload;
  472. destructor Destroy; override;
  473. class function JSONType: TJSONType; override;
  474. Class Property UnquotedMemberNames : Boolean Read GetUnquotedMemberNames Write SetUnquotedMemberNames;
  475. Function Clone : TJSONData; override;
  476. function GetEnumerator: TBaseJSONEnumerator; override;
  477. // Examine
  478. procedure Iterate(Iterator : TJSONObjectIterator; Data: TObject);
  479. function IndexOf(Item: TJSONData): Integer;
  480. Function IndexOfName(const AName: TJSONStringType; CaseInsensitive : Boolean = False): Integer;
  481. Function Find(Const AName : String) : TJSONData; overload;
  482. Function Find(Const AName : String; AType : TJSONType) : TJSONData; overload;
  483. Function Get(Const AName : String) : Variant;
  484. Function Get(Const AName : String; ADefault : TJSONFloat) : TJSONFloat;
  485. Function Get(Const AName : String; ADefault : Integer) : Integer;
  486. Function Get(Const AName : String; ADefault : Int64) : Int64;
  487. Function Get(Const AName : String; ADefault : QWord) : QWord;
  488. Function Get(Const AName : String; ADefault : Boolean) : Boolean;
  489. Function Get(Const AName : String; ADefault : TJSONStringType) : TJSONStringTYpe;
  490. Function Get(Const AName : String; ADefault : TJSONArray) : TJSONArray;
  491. Function Get(Const AName : String; ADefault : TJSONObject) : TJSONObject;
  492. // Manipulate
  493. Procedure Clear; override;
  494. function Add(const AName: TJSONStringType; AValue: TJSONData): Integer; overload;
  495. function Add(const AName: TJSONStringType; AValue: Boolean): Integer; overload;
  496. function Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer; overload;
  497. function Add(const AName, AValue: TJSONStringType): Integer; overload;
  498. function Add(const AName: TJSONStringType; Avalue: Integer): Integer; overload;
  499. function Add(const AName: TJSONStringType; Avalue: Int64): Integer; overload;
  500. function Add(const AName: TJSONStringType; Avalue: QWord): Integer; overload;
  501. function Add(const AName: TJSONStringType): Integer; overload;
  502. function Add(const AName: TJSONStringType; AValue : TJSONArray): Integer; overload;
  503. procedure Delete(Index : Integer);
  504. procedure Delete(Const AName : string);
  505. procedure Remove(Item : TJSONData);
  506. Function Extract(Index : Integer) : TJSONData;
  507. Function Extract(Const AName : string) : TJSONData;
  508. // Easy access properties.
  509. property Names[Index : Integer] : TJSONStringType read GetNameOf;
  510. property Elements[AName: string] : TJSONData read GetElements write SetElements; default;
  511. Property Types[AName : String] : TJSONType Read GetTypes;
  512. Property Nulls[AName : String] : Boolean Read GetIsNull Write SetIsNull;
  513. Property Floats[AName : String] : TJSONFloat Read GetFloats Write SetFloats;
  514. Property Integers[AName : String] : Integer Read GetIntegers Write SetIntegers;
  515. Property Int64s[AName : String] : Int64 Read GetInt64s Write SetInt64s;
  516. Property QWords[AName : String] : QWord Read GetQWords Write SetQWords;
  517. Property Strings[AName : String] : TJSONStringType Read GetStrings Write SetStrings;
  518. Property Booleans[AName : String] : Boolean Read GetBooleans Write SetBooleans;
  519. Property Arrays[AName : String] : TJSONArray Read GetArrays Write SetArrays;
  520. Property Objects[AName : String] : TJSONObject Read GetObjects Write SetObjects;
  521. end;
  522. TJSONObjectClass = Class of TJSONObject;
  523. EJSON = Class(Exception);
  524. TJSONParserHandler = Procedure(AStream : TStream; Const AUseUTF8 : Boolean; Out Data : TJSONData);
  525. Function SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass) : TJSONDataClass;
  526. Function GetJSONInstanceType(AType : TJSONInstanceType) : TJSONDataClass;
  527. Function StringToJSONString(const S : TJSONStringType) : TJSONStringType;
  528. Function JSONStringToString(const S : TJSONStringType) : TJSONStringType;
  529. Function JSONTypeName(JSONType : TJSONType) : String;
  530. // These functions create JSONData structures, taking into account the instance types
  531. Function CreateJSON : TJSONNull;
  532. Function CreateJSON(Data : Boolean) : TJSONBoolean;
  533. Function CreateJSON(Data : Integer) : TJSONIntegerNumber;
  534. Function CreateJSON(Data : Int64) : TJSONInt64Number;
  535. Function CreateJSON(Data : QWord) : TJSONQWordNumber;
  536. Function CreateJSON(Data : TJSONFloat) : TJSONFloatNumber;
  537. Function CreateJSON(Data : TJSONStringType) : TJSONString;
  538. Function CreateJSONArray(Data : Array of const) : TJSONArray;
  539. Function CreateJSONObject(Data : Array of const) : TJSONObject;
  540. // These functions rely on a callback. If the callback is not set, they will raise an error.
  541. // When the jsonparser unit is included in the project, the callback is automatically set.
  542. Function GetJSON(Const JSON : TJSONStringType; Const UseUTF8 : Boolean = True) : TJSONData;
  543. Function GetJSON(Const JSON : TStream; Const UseUTF8 : Boolean = True) : TJSONData;
  544. Function SetJSONParserHandler(AHandler : TJSONParserHandler) : TJSONParserHandler;
  545. Function GetJSONParserHandler : TJSONParserHandler;
  546. implementation
  547. Uses typinfo;
  548. Resourcestring
  549. SErrCannotConvertFromNull = 'Cannot convert data from Null value';
  550. SErrCannotConvertToNull = 'Cannot convert data to Null value';
  551. SErrCannotConvertFromArray = 'Cannot convert data from array value';
  552. SErrCannotConvertToArray = 'Cannot convert data to array value';
  553. SErrCannotConvertFromObject = 'Cannot convert data from object value';
  554. SErrCannotConvertToObject = 'Cannot convert data to object value';
  555. SErrInvalidFloat = 'Invalid float value : %s';
  556. SErrInvalidInteger = 'Invalid float value : %s';
  557. SErrCannotSetNotIsNull = 'IsNull cannot be set to False';
  558. SErrCannotAddArrayTwice = 'Adding an array object to an array twice is not allowed';
  559. SErrCannotAddObjectTwice = 'Adding an object to an array twice is not allowed';
  560. SErrUnknownTypeInConstructor = 'Unknown type in JSON%s constructor: %d';
  561. SErrNotJSONData = 'Cannot add object of type %s to TJSON%s';
  562. SErrPointerNotNil = 'Cannot add non-nil pointer to JSON%s';
  563. SErrOddNumber = 'TJSONObject must be constructed with name,value pairs';
  564. SErrNameMustBeString = 'TJSONObject constructor element name at pos %d is not a string';
  565. SErrNonexistentElement = 'Unknown object member: "%s"';
  566. SErrPathElementNotFound = 'Path "%s" invalid: element "%s" not found.';
  567. SErrWrongInstanceClass = 'Cannot set instance class: %s does not descend from %s.';
  568. SErrNoParserHandler = 'No JSON parser handler installed. Recompile your project with the jsonparser unit included';
  569. Var
  570. DefaultJSONInstanceTypes :
  571. Array [TJSONInstanceType] of TJSONDataClass = (TJSONData, TJSONIntegerNumber,
  572. TJSONInt64Number, TJSONQWordNumber, TJSONFloatNumber, TJSONString, TJSONBoolean, TJSONNull, TJSONArray,
  573. TJSONObject);
  574. Const
  575. MinJSONInstanceTypes :
  576. Array [TJSONInstanceType] of TJSONDataClass = (TJSONData, TJSONIntegerNumber,
  577. TJSONInt64Number, TJSONQWordNumber, TJSONFloatNumber, TJSONString, TJSONBoolean, TJSONNull, TJSONArray,
  578. TJSONObject);
  579. function SetJSONInstanceType(AType: TJSONInstanceType; AClass: TJSONDataClass): TJSONDataClass;
  580. begin
  581. if AClass=Nil then
  582. TJSONData.DoError(SErrWrongInstanceClass,['Nil',MinJSONInstanceTypes[AType].ClassName]);
  583. if Not AClass.InheritsFrom(MinJSONINstanceTypes[AType]) then
  584. TJSONData.DoError(SErrWrongInstanceClass,[AClass.ClassName,MinJSONInstanceTypes[AType].ClassName]);
  585. Result:=DefaultJSONInstanceTypes[AType];
  586. DefaultJSONINstanceTypes[AType]:=AClass;
  587. end;
  588. function GetJSONInstanceType(AType: TJSONInstanceType): TJSONDataClass;
  589. begin
  590. Result:=DefaultJSONInstanceTypes[AType]
  591. end;
  592. Function StringToJSONString(const S : TJSONStringType) : TJSONStringType;
  593. Var
  594. I,J,L : Integer;
  595. P : PJSONCharType;
  596. begin
  597. I:=1;
  598. J:=1;
  599. Result:='';
  600. L:=Length(S);
  601. P:=PJSONCharType(S);
  602. While I<=L do
  603. begin
  604. if (AnsiChar(P^) in ['"','/','\',#8,#9,#10,#12,#13]) then
  605. begin
  606. Result:=Result+Copy(S,J,I-J);
  607. Case P^ of
  608. '\' : Result:=Result+'\\';
  609. '/' : Result:=Result+'\/';
  610. '"' : Result:=Result+'\"';
  611. #8 : Result:=Result+'\b';
  612. #9 : Result:=Result+'\t';
  613. #10 : Result:=Result+'\n';
  614. #12 : Result:=Result+'\f';
  615. #13 : Result:=Result+'\r';
  616. end;
  617. J:=I+1;
  618. end;
  619. Inc(I);
  620. Inc(P);
  621. end;
  622. Result:=Result+Copy(S,J,I-1);
  623. end;
  624. Function JSONStringToString(const S : TJSONStringType) : TJSONStringType;
  625. Var
  626. I,J,L : Integer;
  627. P : PJSONCharType;
  628. w : String;
  629. begin
  630. I:=1;
  631. J:=1;
  632. L:=Length(S);
  633. Result:='';
  634. P:=PJSONCharType(S);
  635. While (I<=L) do
  636. begin
  637. if (P^='\') then
  638. begin
  639. Result:=Result+Copy(S,J,I-J);
  640. Inc(P);
  641. If (P^<>#0) then
  642. begin
  643. Inc(I);
  644. Case AnsiChar(P^) of
  645. '\','"','/'
  646. : Result:=Result+P^;
  647. 'b' : Result:=Result+#8;
  648. 't' : Result:=Result+#9;
  649. 'n' : Result:=Result+#10;
  650. 'f' : Result:=Result+#12;
  651. 'r' : Result:=Result+#13;
  652. 'u' : begin
  653. W:=Copy(S,I+1,4);
  654. Inc(I,4);
  655. Inc(P,4);
  656. Result:=Result+WideChar(StrToInt('$'+W));
  657. end;
  658. end;
  659. end;
  660. J:=I+1;
  661. end;
  662. Inc(I);
  663. Inc(P);
  664. end;
  665. Result:=Result+Copy(S,J,I-J+1);
  666. end;
  667. function JSONTypeName(JSONType: TJSONType): String;
  668. begin
  669. Result:=GetEnumName(TypeInfo(TJSONType),Ord(JSONType));
  670. end;
  671. function CreateJSON: TJSONNull;
  672. begin
  673. Result:=TJSONNullClass(DefaultJSONInstanceTypes[jitNull]).Create
  674. end;
  675. function CreateJSON(Data: Boolean): TJSONBoolean;
  676. begin
  677. Result:=TJSONBooleanClass(DefaultJSONInstanceTypes[jitBoolean]).Create(Data);
  678. end;
  679. function CreateJSON(Data: Integer): TJSONIntegerNumber;
  680. begin
  681. Result:=TJSONIntegerNumberCLass(DefaultJSONInstanceTypes[jitNumberInteger]).Create(Data);
  682. end;
  683. function CreateJSON(Data: Int64): TJSONInt64Number;
  684. begin
  685. Result:=TJSONInt64NumberCLass(DefaultJSONInstanceTypes[jitNumberInt64]).Create(Data);
  686. end;
  687. function CreateJSON(Data: QWord): TJSONQWordNumber;
  688. begin
  689. Result:=TJSONQWordNumberClass(DefaultJSONInstanceTypes[jitNumberQWord]).Create(Data);
  690. end;
  691. function CreateJSON(Data: TJSONFloat): TJSONFloatNumber;
  692. begin
  693. Result:=TJSONFloatNumberCLass(DefaultJSONInstanceTypes[jitNumberFloat]).Create(Data);
  694. end;
  695. function CreateJSON(Data: TJSONStringType): TJSONString;
  696. begin
  697. Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
  698. end;
  699. function CreateJSONArray(Data: array of const): TJSONArray;
  700. begin
  701. Result:=TJSONArrayCLass(DefaultJSONInstanceTypes[jitArray]).Create(Data);
  702. end;
  703. function CreateJSONObject(Data: array of const): TJSONObject;
  704. begin
  705. Result:=TJSONObjectCLass(DefaultJSONInstanceTypes[jitObject]).Create(Data);
  706. end;
  707. Var
  708. JPH : TJSONParserHandler;
  709. function GetJSON(const JSON: TJSONStringType; Const UseUTF8: Boolean): TJSONData;
  710. Var
  711. SS : TStringStream;
  712. begin
  713. SS:=TStringStream.Create(JSON);
  714. try
  715. Result:=GetJSON(SS,UseUTF8);
  716. finally
  717. SS.Free;
  718. end;
  719. end;
  720. function GetJSON(Const JSON: TStream; Const UseUTF8: Boolean): TJSONData;
  721. begin
  722. Result:=Nil;
  723. If (JPH=Nil) then
  724. TJSONData.DoError(SErrNoParserHandler);
  725. JPH(JSON,UseUTF8,Result);
  726. end;
  727. function SetJSONParserHandler(AHandler: TJSONParserHandler): TJSONParserHandler;
  728. begin
  729. Result:=JPH;
  730. JPH:=AHandler;
  731. end;
  732. function GetJSONParserHandler: TJSONParserHandler;
  733. begin
  734. Result:=JPH;
  735. end;
  736. Type
  737. { TJSONEnumerator }
  738. TJSONEnumerator = class(TBaseJSONEnumerator)
  739. Private
  740. FData : TJSONData;
  741. public
  742. Constructor Create(AData : TJSONData);
  743. function GetCurrent: TJSONEnum; override;
  744. function MoveNext : Boolean; override;
  745. end;
  746. { TJSONArrayEnumerator }
  747. TJSONArrayEnumerator = class(TBaseJSONEnumerator)
  748. Private
  749. FData : TJSONArray;
  750. FCurrent : Integer;
  751. public
  752. Constructor Create(AData : TJSONArray);
  753. function GetCurrent: TJSONEnum; override;
  754. function MoveNext : Boolean; override;
  755. end;
  756. { TJSONObjectEnumerator }
  757. TJSONObjectEnumerator = class(TBaseJSONEnumerator)
  758. Private
  759. FData : TJSONObject;
  760. FCurrent : Integer;
  761. public
  762. Constructor Create(AData : TJSONObject);
  763. function GetCurrent: TJSONEnum; override;
  764. function MoveNext : Boolean; override;
  765. end;
  766. { TJSONQWordNumber }
  767. function TJSONQWordNumber.GetAsBoolean: Boolean;
  768. begin
  769. Result:=FValue<>0;
  770. end;
  771. function TJSONQWordNumber.GetAsFloat: TJSONFloat;
  772. begin
  773. Result:= FValue;
  774. end;
  775. function TJSONQWordNumber.GetAsInteger: Integer;
  776. begin
  777. Result := FValue;
  778. end;
  779. function TJSONQWordNumber.GetAsInt64: Int64;
  780. begin
  781. Result := FValue;
  782. end;
  783. function TJSONQWordNumber.GetAsQWord: QWord;
  784. begin
  785. Result := FValue;
  786. end;
  787. procedure TJSONQWordNumber.SetAsBoolean(const AValue: Boolean);
  788. begin
  789. FValue:=Ord(AValue);
  790. end;
  791. procedure TJSONQWordNumber.SetAsFloat(const AValue: TJSONFloat);
  792. begin
  793. FValue:=Round(AValue);
  794. end;
  795. procedure TJSONQWordNumber.SetAsInteger(const AValue: Integer);
  796. begin
  797. FValue:=AValue;
  798. end;
  799. procedure TJSONQWordNumber.SetAsInt64(const AValue: Int64);
  800. begin
  801. FValue := AValue;
  802. end;
  803. procedure TJSONQWordNumber.SetAsQword(const AValue: QWord);
  804. begin
  805. FValue:=AValue;
  806. end;
  807. function TJSONQWordNumber.GetAsJSON: TJSONStringType;
  808. begin
  809. Result:=AsString;
  810. end;
  811. function TJSONQWordNumber.GetAsString: TJSONStringType;
  812. begin
  813. Result:=IntToStr(FValue);
  814. end;
  815. procedure TJSONQWordNumber.SetAsString(const AValue: TJSONStringType);
  816. begin
  817. FValue:=StrToQWord(AValue);
  818. end;
  819. function TJSONQWordNumber.GetValue: variant;
  820. begin
  821. Result:=FValue;
  822. end;
  823. procedure TJSONQWordNumber.SetValue(const AValue: variant);
  824. begin
  825. FValue:=AValue;
  826. end;
  827. constructor TJSONQWordNumber.Create(AValue: QWord);
  828. begin
  829. FValue := AValue;
  830. end;
  831. class function TJSONQWordNumber.NumberType: TJSONNumberType;
  832. begin
  833. Result:=ntQWord;
  834. end;
  835. procedure TJSONQWordNumber.Clear;
  836. begin
  837. FValue:=0;
  838. end;
  839. function TJSONQWordNumber.Clone: TJSONData;
  840. begin
  841. Result:=TJSONQWordNumberClass(ClassType).Create(Self.FValue);
  842. end;
  843. constructor TJSONObjectEnumerator.Create(AData: TJSONObject);
  844. begin
  845. FData:=AData;
  846. FCurrent:=-1;
  847. end;
  848. function TJSONObjectEnumerator.GetCurrent: TJSONEnum;
  849. begin
  850. Result.KeyNum:=FCurrent;
  851. Result.Key:=FData.Names[FCurrent];
  852. Result.Value:=FData.Items[FCurrent];
  853. end;
  854. function TJSONObjectEnumerator.MoveNext: Boolean;
  855. begin
  856. Inc(FCurrent);
  857. Result:=FCurrent<FData.Count;
  858. end;
  859. { TJSONArrayEnumerator }
  860. constructor TJSONArrayEnumerator.Create(AData: TJSONArray);
  861. begin
  862. FData:=AData;
  863. FCurrent:=-1;
  864. end;
  865. function TJSONArrayEnumerator.GetCurrent: TJSONEnum;
  866. begin
  867. Result.KeyNum:=FCurrent;
  868. Result.Key:=IntToStr(FCurrent);
  869. Result.Value:=FData.Items[FCurrent];
  870. end;
  871. function TJSONArrayEnumerator.MoveNext: Boolean;
  872. begin
  873. Inc(FCurrent);
  874. Result:=FCurrent<FData.Count;
  875. end;
  876. { TJSONEnumerator }
  877. constructor TJSONEnumerator.Create(AData: TJSONData);
  878. begin
  879. FData:=AData;
  880. end;
  881. function TJSONEnumerator.GetCurrent: TJSONEnum;
  882. begin
  883. Result.Key:='';
  884. Result.KeyNum:=0;
  885. Result.Value:=FData;
  886. FData:=Nil;
  887. end;
  888. function TJSONEnumerator.MoveNext: Boolean;
  889. begin
  890. Result:=FData<>Nil;
  891. end;
  892. { TJSONData }
  893. function TJSONData.GetItem(Index : Integer): TJSONData;
  894. begin
  895. Result:=nil;
  896. end;
  897. function TJSONData.GetCount: Integer;
  898. begin
  899. Result:=0;
  900. end;
  901. constructor TJSONData.Create;
  902. begin
  903. Clear;
  904. end;
  905. procedure TJSONData.DumpJSON(S: TStream);
  906. Procedure W(T : String);
  907. begin
  908. if (T<>'') then
  909. S.WriteBuffer(T[1],Length(T)*SizeOf(Char));
  910. end;
  911. Var
  912. I,C : Integer;
  913. O : TJSONObject;
  914. begin
  915. Case JSONType of
  916. jtObject :
  917. begin
  918. O:=TJSONObject(Self);
  919. W('{');
  920. For I:=0 to O.Count-1 do
  921. begin
  922. if (I>0) then
  923. W(',');
  924. W('"');
  925. W(StringToJSONString(O.Names[i]));
  926. W('":');
  927. O.Items[I].DumpJSON(S);
  928. end;
  929. W('}');
  930. end;
  931. jtArray :
  932. begin
  933. W('[');
  934. For I:=0 to Count-1 do
  935. begin
  936. if (I>0) then
  937. W(',');
  938. Items[I].DumpJSON(S);
  939. end;
  940. W(']');
  941. end
  942. else
  943. W(AsJSON)
  944. end;
  945. end;
  946. class function TJSONData.GetCompressedJSON: Boolean; static;
  947. begin
  948. Result:=FCompressedJSON;
  949. end;
  950. class procedure TJSONData.DetermineElementSeparators;
  951. begin
  952. FElementSep:=ElementSeps[FCompressedJSON];
  953. end;
  954. class procedure TJSONData.SetCompressedJSON(AValue: Boolean); static;
  955. begin
  956. if AValue=FCompressedJSON then exit;
  957. FCompressedJSON:=AValue;
  958. DetermineElementSeparators;
  959. TJSONObject.DetermineElementQuotes;
  960. end;
  961. class procedure TJSONData.DoError(const Msg: String);
  962. begin
  963. Raise EJSON.Create(Msg);
  964. end;
  965. class procedure TJSONData.DoError(const Fmt: String;
  966. const Args: array of const);
  967. begin
  968. Raise EJSON.CreateFmt(Fmt,Args);
  969. end;
  970. function TJSONData.DoFindPath(const APath: TJSONStringType; out
  971. NotFound: TJSONStringType): TJSONdata;
  972. begin
  973. If APath<>'' then
  974. begin
  975. NotFound:=APath;
  976. Result:=Nil;
  977. end
  978. else
  979. Result:=Self;
  980. end;
  981. function TJSONData.GetIsNull: Boolean;
  982. begin
  983. Result:=False;
  984. end;
  985. class function TJSONData.JSONType: TJSONType;
  986. begin
  987. JSONType:=jtUnknown;
  988. end;
  989. function TJSONData.GetEnumerator: TBaseJSONEnumerator;
  990. begin
  991. Result:=TJSONEnumerator.Create(Self);
  992. end;
  993. function TJSONData.FindPath(const APath: TJSONStringType): TJSONdata;
  994. Var
  995. M : String;
  996. begin
  997. Result:=DoFindPath(APath,M);
  998. end;
  999. function TJSONData.GetPath(const APath: TJSONStringType): TJSONdata;
  1000. Var
  1001. M : String;
  1002. begin
  1003. Result:=DoFindPath(APath,M);
  1004. If Result=Nil then
  1005. DoError(SErrPathElementNotFound,[APath,M]);
  1006. end;
  1007. procedure TJSONData.SetItem(Index : Integer; const AValue:
  1008. TJSONData);
  1009. begin
  1010. // Do Nothing
  1011. end;
  1012. function TJSONData.FormatJSON(Options: TFormatOptions; Indentsize: Integer
  1013. ): TJSONStringType;
  1014. begin
  1015. Result:=DoFormatJSON(Options,0,IndentSize);
  1016. end;
  1017. function TJSONData.DoFormatJSON(Options: TFormatOptions; CurrentIndent,
  1018. Indent: Integer): TJSONStringType;
  1019. begin
  1020. Result:=AsJSON;
  1021. end;
  1022. { TJSONnumber }
  1023. class function TJSONnumber.JSONType: TJSONType;
  1024. begin
  1025. Result:=jtNumber;
  1026. end;
  1027. { TJSONstring }
  1028. class function TJSONString.JSONType: TJSONType;
  1029. begin
  1030. Result:=jtString;
  1031. end;
  1032. procedure TJSONString.Clear;
  1033. begin
  1034. FValue:='';
  1035. end;
  1036. function TJSONString.Clone: TJSONData;
  1037. begin
  1038. Result:=TJSONStringClass(ClassType).Create(Self.FValue);
  1039. end;
  1040. function TJSONString.GetValue: Variant;
  1041. begin
  1042. Result:=FValue;
  1043. end;
  1044. procedure TJSONString.SetValue(const AValue: Variant);
  1045. begin
  1046. FValue:=AValue;
  1047. end;
  1048. function TJSONString.GetAsBoolean: Boolean;
  1049. begin
  1050. Result:=StrToBool(FValue);
  1051. end;
  1052. function TJSONString.GetAsFloat: TJSONFloat;
  1053. Var
  1054. C : Integer;
  1055. begin
  1056. Val(FValue,Result,C);
  1057. If (C<>0) then
  1058. If Not TryStrToFloat(FValue,Result) then
  1059. Raise EConvertError.CreateFmt(SErrInvalidFloat,[FValue]);
  1060. end;
  1061. function TJSONString.GetAsInteger: Integer;
  1062. begin
  1063. Result:=StrToInt(FValue);
  1064. end;
  1065. function TJSONString.GetAsInt64: Int64;
  1066. begin
  1067. Result:=StrToInt64(FValue);
  1068. end;
  1069. function TJSONString.GetAsQWord: QWord;
  1070. begin
  1071. Result:=StrToQWord(FValue);
  1072. end;
  1073. procedure TJSONString.SetAsBoolean(const AValue: Boolean);
  1074. begin
  1075. FValue:=BoolToStr(AValue);
  1076. end;
  1077. procedure TJSONString.SetAsFloat(const AValue: TJSONFloat);
  1078. begin
  1079. FValue:=FloatToStr(AValue);
  1080. end;
  1081. procedure TJSONString.SetAsInteger(const AValue: Integer);
  1082. begin
  1083. FValue:=IntToStr(AValue);
  1084. end;
  1085. procedure TJSONString.SetAsInt64(const AValue: Int64);
  1086. begin
  1087. FValue:=IntToStr(AValue);
  1088. end;
  1089. procedure TJSONString.SetAsQword(const AValue: QWord);
  1090. begin
  1091. FValue:=IntToStr(AValue);
  1092. end;
  1093. function TJSONString.GetAsJSON: TJSONStringType;
  1094. begin
  1095. Result:='"'+StringToJSONString(FValue)+'"';
  1096. end;
  1097. function TJSONString.GetAsString: TJSONStringType;
  1098. begin
  1099. Result:=FValue;
  1100. end;
  1101. procedure TJSONString.SetAsString(const AValue: TJSONStringType);
  1102. begin
  1103. FValue:=AValue;
  1104. end;
  1105. constructor TJSONString.Create(const AValue: TJSONStringType);
  1106. begin
  1107. FValue:=AValue;
  1108. end;
  1109. { TJSONboolean }
  1110. function TJSONBoolean.GetValue: Variant;
  1111. begin
  1112. Result:=FValue;
  1113. end;
  1114. class function TJSONBoolean.JSONType: TJSONType;
  1115. begin
  1116. Result:=jtBoolean;
  1117. end;
  1118. procedure TJSONBoolean.Clear;
  1119. begin
  1120. FValue:=False;
  1121. end;
  1122. function TJSONBoolean.Clone: TJSONData;
  1123. begin
  1124. Result:=TJSONBooleanClass(Self.ClassType).Create(Self.Fvalue);
  1125. end;
  1126. procedure TJSONBoolean.SetValue(const AValue: Variant);
  1127. begin
  1128. FValue:=boolean(AValue);
  1129. end;
  1130. function TJSONBoolean.GetAsBoolean: Boolean;
  1131. begin
  1132. Result:=FValue;
  1133. end;
  1134. function TJSONBoolean.GetAsFloat: TJSONFloat;
  1135. begin
  1136. Result:=Ord(FValue);
  1137. end;
  1138. function TJSONBoolean.GetAsInteger: Integer;
  1139. begin
  1140. Result:=Ord(FValue);
  1141. end;
  1142. function TJSONBoolean.GetAsInt64: Int64;
  1143. begin
  1144. Result:=Ord(FValue);
  1145. end;
  1146. function TJSONBoolean.GetAsQWord: QWord;
  1147. begin
  1148. Result:=Ord(FValue);
  1149. end;
  1150. procedure TJSONBoolean.SetAsBoolean(const AValue: Boolean);
  1151. begin
  1152. FValue:=AValue;
  1153. end;
  1154. procedure TJSONBoolean.SetAsFloat(const AValue: TJSONFloat);
  1155. begin
  1156. FValue:=(AValue<>0)
  1157. end;
  1158. procedure TJSONBoolean.SetAsInteger(const AValue: Integer);
  1159. begin
  1160. FValue:=(AValue<>0)
  1161. end;
  1162. procedure TJSONBoolean.SetAsInt64(const AValue: Int64);
  1163. begin
  1164. FValue:=(AValue<>0)
  1165. end;
  1166. procedure TJSONBoolean.SetAsQword(const AValue: QWord);
  1167. begin
  1168. FValue:=(AValue<>0)
  1169. end;
  1170. function TJSONBoolean.GetAsJSON: TJSONStringType;
  1171. begin
  1172. If FValue then
  1173. Result:='true'
  1174. else
  1175. Result:='false';
  1176. end;
  1177. function TJSONBoolean.GetAsString: TJSONStringType;
  1178. begin
  1179. Result:=BoolToStr(FValue, True);
  1180. end;
  1181. procedure TJSONBoolean.SetAsString(const AValue: TJSONStringType);
  1182. begin
  1183. FValue:=StrToBool(AValue);
  1184. end;
  1185. constructor TJSONBoolean.Create(AValue: Boolean);
  1186. begin
  1187. FValue:=AValue;
  1188. end;
  1189. { TJSONnull }
  1190. procedure TJSONNull.Converterror(From: Boolean);
  1191. begin
  1192. If From then
  1193. DoError(SErrCannotConvertFromNull)
  1194. else
  1195. DoError(SErrCannotConvertToNull);
  1196. end;
  1197. {$warnings off}
  1198. function TJSONNull.GetAsBoolean: Boolean;
  1199. begin
  1200. ConvertError(True);
  1201. end;
  1202. function TJSONNull.GetAsFloat: TJSONFloat;
  1203. begin
  1204. ConvertError(True);
  1205. end;
  1206. function TJSONNull.GetAsInteger: Integer;
  1207. begin
  1208. ConvertError(True);
  1209. end;
  1210. function TJSONNull.GetAsInt64: Int64;
  1211. begin
  1212. ConvertError(True);
  1213. end;
  1214. function TJSONNull.GetAsQWord: QWord;
  1215. begin
  1216. ConvertError(True);
  1217. end;
  1218. function TJSONNull.GetIsNull: Boolean;
  1219. begin
  1220. Result:=True;
  1221. end;
  1222. procedure TJSONNull.SetAsBoolean(const AValue: Boolean);
  1223. begin
  1224. ConvertError(False);
  1225. end;
  1226. procedure TJSONNull.SetAsFloat(const AValue: TJSONFloat);
  1227. begin
  1228. ConvertError(False);
  1229. end;
  1230. procedure TJSONNull.SetAsInteger(const AValue: Integer);
  1231. begin
  1232. ConvertError(False);
  1233. end;
  1234. procedure TJSONNull.SetAsInt64(const AValue: Int64);
  1235. begin
  1236. ConvertError(False);
  1237. end;
  1238. procedure TJSONNull.SetAsQword(const AValue: QWord);
  1239. begin
  1240. ConvertError(False);
  1241. end;
  1242. function TJSONNull.GetAsJSON: TJSONStringType;
  1243. begin
  1244. Result:='null';
  1245. end;
  1246. function TJSONNull.GetAsString: TJSONStringType;
  1247. begin
  1248. ConvertError(True);
  1249. end;
  1250. procedure TJSONNull.SetAsString(const AValue: TJSONStringType);
  1251. begin
  1252. ConvertError(True);
  1253. end;
  1254. function TJSONNull.GetValue: variant;
  1255. begin
  1256. Result:=variants.Null;
  1257. end;
  1258. procedure TJSONNull.SetValue(const AValue: variant);
  1259. begin
  1260. ConvertError(False);
  1261. end;
  1262. class function TJSONNull.JSONType: TJSONType;
  1263. begin
  1264. Result:=jtNull;
  1265. end;
  1266. procedure TJSONNull.Clear;
  1267. begin
  1268. // Do nothing
  1269. end;
  1270. function TJSONNull.Clone: TJSONData;
  1271. begin
  1272. Result:=TJSONNullClass(Self.ClassType).Create;
  1273. end;
  1274. {$warnings on}
  1275. { TJSONFloatNumber }
  1276. function TJSONFloatNumber.GetAsBoolean: Boolean;
  1277. begin
  1278. Result:=(FValue<>0);
  1279. end;
  1280. function TJSONFloatNumber.GetAsFloat: TJSONFloat;
  1281. begin
  1282. Result:=FValue;
  1283. end;
  1284. function TJSONFloatNumber.GetAsInteger: Integer;
  1285. begin
  1286. Result:=Round(FValue);
  1287. end;
  1288. function TJSONFloatNumber.GetAsInt64: Int64;
  1289. begin
  1290. Result:=Round(FValue);
  1291. end;
  1292. function TJSONFloatNumber.GetAsQWord: QWord;
  1293. begin
  1294. Result:=Round(FValue);
  1295. end;
  1296. procedure TJSONFloatNumber.SetAsBoolean(const AValue: Boolean);
  1297. begin
  1298. FValue:=Ord(AValue);
  1299. end;
  1300. procedure TJSONFloatNumber.SetAsFloat(const AValue: TJSONFloat);
  1301. begin
  1302. FValue:=AValue;
  1303. end;
  1304. procedure TJSONFloatNumber.SetAsInteger(const AValue: Integer);
  1305. begin
  1306. FValue:=AValue;
  1307. end;
  1308. procedure TJSONFloatNumber.SetAsInt64(const AValue: Int64);
  1309. begin
  1310. FValue:=AValue;
  1311. end;
  1312. procedure TJSONFloatNumber.SetAsQword(const AValue: QWord);
  1313. begin
  1314. FValue:=AValue;
  1315. end;
  1316. function TJSONFloatNumber.GetAsJSON: TJSONStringType;
  1317. begin
  1318. Result:=AsString;
  1319. end;
  1320. function TJSONFloatNumber.GetAsString: TJSONStringType;
  1321. begin
  1322. Str(FValue,Result);
  1323. // Str produces a ' ' in front where the - can go.
  1324. if (Result<>'') and (Result[1]=' ') then
  1325. Delete(Result,1,1);
  1326. end;
  1327. procedure TJSONFloatNumber.SetAsString(const AValue: TJSONStringType);
  1328. Var
  1329. C : Integer;
  1330. begin
  1331. Val(AValue,FValue,C);
  1332. If (C<>0) then
  1333. Raise EConvertError.CreateFmt(SErrInvalidFloat,[AValue]);
  1334. end;
  1335. function TJSONFloatNumber.GetValue: variant;
  1336. begin
  1337. Result:=FValue;
  1338. end;
  1339. procedure TJSONFloatNumber.SetValue(const AValue: variant);
  1340. begin
  1341. FValue:=AValue;
  1342. end;
  1343. constructor TJSONFloatNumber.Create(AValue: TJSONFloat);
  1344. begin
  1345. FValue:=AValue;
  1346. end;
  1347. class function TJSONFloatNumber.NumberType: TJSONNumberType;
  1348. begin
  1349. Result:=ntFloat;
  1350. end;
  1351. procedure TJSONFloatNumber.Clear;
  1352. begin
  1353. FValue:=0;
  1354. end;
  1355. function TJSONFloatNumber.Clone: TJSONData;
  1356. begin
  1357. Result:=TJSONFloatNumberClass(ClassType).Create(Self.FValue);
  1358. end;
  1359. { TJSONIntegerNumber }
  1360. function TJSONIntegerNumber.GetAsBoolean: Boolean;
  1361. begin
  1362. Result:=FValue<>0;
  1363. end;
  1364. function TJSONIntegerNumber.GetAsFloat: TJSONFloat;
  1365. begin
  1366. Result:=Ord(FValue);
  1367. end;
  1368. function TJSONIntegerNumber.GetAsInteger: Integer;
  1369. begin
  1370. Result:=FValue;
  1371. end;
  1372. function TJSONIntegerNumber.GetAsInt64: Int64;
  1373. begin
  1374. Result:=FValue;
  1375. end;
  1376. function TJSONIntegerNumber.GetAsQWord: QWord;
  1377. begin
  1378. result:=FValue;
  1379. end;
  1380. procedure TJSONIntegerNumber.SetAsBoolean(const AValue: Boolean);
  1381. begin
  1382. FValue:=Ord(AValue);
  1383. end;
  1384. procedure TJSONIntegerNumber.SetAsFloat(const AValue: TJSONFloat);
  1385. begin
  1386. FValue:=Round(AValue);
  1387. end;
  1388. procedure TJSONIntegerNumber.SetAsInteger(const AValue: Integer);
  1389. begin
  1390. FValue:=AValue;
  1391. end;
  1392. procedure TJSONIntegerNumber.SetAsInt64(const AValue: Int64);
  1393. begin
  1394. FValue:=AValue;
  1395. end;
  1396. procedure TJSONIntegerNumber.SetAsQword(const AValue: QWord);
  1397. begin
  1398. FValue:=AValue;
  1399. end;
  1400. function TJSONIntegerNumber.GetAsJSON: TJSONStringType;
  1401. begin
  1402. Result:=AsString;
  1403. end;
  1404. function TJSONIntegerNumber.GetAsString: TJSONStringType;
  1405. begin
  1406. Result:=IntToStr(FValue)
  1407. end;
  1408. procedure TJSONIntegerNumber.SetAsString(const AValue: TJSONStringType);
  1409. begin
  1410. FValue:=StrToInt(AValue);
  1411. end;
  1412. function TJSONIntegerNumber.GetValue: variant;
  1413. begin
  1414. Result:=FValue;
  1415. end;
  1416. procedure TJSONIntegerNumber.SetValue(const AValue: variant);
  1417. begin
  1418. FValue:=AValue;
  1419. end;
  1420. constructor TJSONIntegerNumber.Create(AValue: Integer);
  1421. begin
  1422. FValue:=AValue;
  1423. end;
  1424. class function TJSONIntegerNumber.NumberType: TJSONNumberType;
  1425. begin
  1426. Result:=ntInteger;
  1427. end;
  1428. procedure TJSONIntegerNumber.Clear;
  1429. begin
  1430. FValue:=0;
  1431. end;
  1432. function TJSONIntegerNumber.Clone: TJSONData;
  1433. begin
  1434. Result:=TJSONIntegerNumberClass(ClassType).Create(Self.FValue);
  1435. end;
  1436. { TJSONInt64Number }
  1437. function TJSONInt64Number.GetAsInt64: Int64;
  1438. begin
  1439. Result := FValue;
  1440. end;
  1441. function TJSONInt64Number.GetAsQWord: QWord;
  1442. begin
  1443. Result := FValue;
  1444. end;
  1445. procedure TJSONInt64Number.SetAsInt64(const AValue: Int64);
  1446. begin
  1447. FValue := AValue;
  1448. end;
  1449. procedure TJSONInt64Number.SetAsQword(const AValue: QWord);
  1450. begin
  1451. FValue := AValue;
  1452. end;
  1453. function TJSONInt64Number.GetAsBoolean: Boolean;
  1454. begin
  1455. Result:=FValue<>0;
  1456. end;
  1457. function TJSONInt64Number.GetAsFloat: TJSONFloat;
  1458. begin
  1459. Result:= FValue;
  1460. end;
  1461. function TJSONInt64Number.GetAsInteger: Integer;
  1462. begin
  1463. Result := FValue;
  1464. end;
  1465. procedure TJSONInt64Number.SetAsBoolean(const AValue: Boolean);
  1466. begin
  1467. FValue:=Ord(AValue);
  1468. end;
  1469. procedure TJSONInt64Number.SetAsFloat(const AValue: TJSONFloat);
  1470. begin
  1471. FValue:=Round(AValue);
  1472. end;
  1473. procedure TJSONInt64Number.SetAsInteger(const AValue: Integer);
  1474. begin
  1475. FValue:=AValue;
  1476. end;
  1477. function TJSONInt64Number.GetAsJSON: TJSONStringType;
  1478. begin
  1479. Result:=AsString;
  1480. end;
  1481. function TJSONInt64Number.GetAsString: TJSONStringType;
  1482. begin
  1483. Result:=IntToStr(FValue)
  1484. end;
  1485. procedure TJSONInt64Number.SetAsString(const AValue: TJSONStringType);
  1486. begin
  1487. FValue:=StrToInt64(AValue);
  1488. end;
  1489. function TJSONInt64Number.GetValue: variant;
  1490. begin
  1491. Result:=FValue;
  1492. end;
  1493. procedure TJSONInt64Number.SetValue(const AValue: variant);
  1494. begin
  1495. FValue:=AValue;
  1496. end;
  1497. constructor TJSONInt64Number.Create(AValue: Int64);
  1498. begin
  1499. FValue := AValue;
  1500. end;
  1501. class function TJSONInt64Number.NumberType: TJSONNumberType;
  1502. begin
  1503. Result:=ntInt64;
  1504. end;
  1505. procedure TJSONInt64Number.Clear;
  1506. begin
  1507. FValue:=0;
  1508. end;
  1509. function TJSONInt64Number.Clone: TJSONData;
  1510. begin
  1511. Result:=TJSONInt64NumberClass(ClassType).Create(Self.FValue);
  1512. end;
  1513. { TJSONArray }
  1514. function TJSONArray.GetBooleans(Index : Integer): Boolean;
  1515. begin
  1516. Result:=Items[Index].AsBoolean;
  1517. end;
  1518. function TJSONArray.GetArrays(Index : Integer): TJSONArray;
  1519. begin
  1520. Result:=Items[Index] as TJSONArray;
  1521. end;
  1522. function TJSONArray.GetFloats(Index : Integer): TJSONFloat;
  1523. begin
  1524. Result:=Items[Index].AsFloat;
  1525. end;
  1526. function TJSONArray.GetIntegers(Index : Integer): Integer;
  1527. begin
  1528. Result:=Items[Index].AsInteger;
  1529. end;
  1530. function TJSONArray.GetInt64s(Index : Integer): Int64;
  1531. begin
  1532. Result:=Items[Index].AsInt64;
  1533. end;
  1534. function TJSONArray.GetNulls(Index : Integer): Boolean;
  1535. begin
  1536. Result:=Items[Index].IsNull;
  1537. end;
  1538. function TJSONArray.GetObjects(Index : Integer): TJSONObject;
  1539. begin
  1540. Result:=Items[Index] as TJSONObject;
  1541. end;
  1542. function TJSONArray.GetQWords(Index : Integer): QWord;
  1543. begin
  1544. Result:=Items[Index].AsQWord;
  1545. end;
  1546. function TJSONArray.GetStrings(Index : Integer): TJSONStringType;
  1547. begin
  1548. Result:=Items[Index].AsString;
  1549. end;
  1550. function TJSONArray.GetTypes(Index : Integer): TJSONType;
  1551. begin
  1552. Result:=Items[Index].JSONType;
  1553. end;
  1554. procedure TJSONArray.SetArrays(Index : Integer; const AValue: TJSONArray);
  1555. begin
  1556. Items[Index]:=AValue;
  1557. end;
  1558. procedure TJSONArray.SetBooleans(Index : Integer; const AValue: Boolean);
  1559. begin
  1560. Items[Index]:=CreateJSON(AValue);
  1561. end;
  1562. procedure TJSONArray.SetFloats(Index : Integer; const AValue: TJSONFloat);
  1563. begin
  1564. Items[Index]:=CreateJSON(AValue);
  1565. end;
  1566. procedure TJSONArray.SetIntegers(Index : Integer; const AValue: Integer);
  1567. begin
  1568. Items[Index]:=CreateJSON(AValue);
  1569. end;
  1570. procedure TJSONArray.SetInt64s(Index : Integer; const AValue: Int64);
  1571. begin
  1572. Items[Index]:=CreateJSON(AValue);
  1573. end;
  1574. procedure TJSONArray.SetObjects(Index : Integer; const AValue: TJSONObject);
  1575. begin
  1576. Items[Index]:=AValue;
  1577. end;
  1578. procedure TJSONArray.SetQWords(Index : Integer; AValue: QWord);
  1579. begin
  1580. Items[Index]:=CreateJSON(AValue);
  1581. end;
  1582. procedure TJSONArray.SetStrings(Index : Integer; const AValue: TJSONStringType);
  1583. begin
  1584. Items[Index]:=CreateJSON(AValue);
  1585. end;
  1586. function TJSONArray.DoFindPath(const APath: TJSONStringType; out
  1587. NotFound: TJSONStringType): TJSONdata;
  1588. Var
  1589. P,I : integer;
  1590. E : String;
  1591. begin
  1592. if (APath<>'') and (APath[1]='[') then
  1593. begin
  1594. P:=Pos(']',APath);
  1595. I:=-1;
  1596. If (P>2) then
  1597. I:=StrToIntDef(Copy(APath,2,P-2),-1);
  1598. If (I>=0) and (I<Count) then
  1599. begin
  1600. E:=APath;
  1601. System.Delete(E,1,P);
  1602. Result:=Items[i].DoFindPath(E,NotFound);
  1603. end
  1604. else
  1605. begin
  1606. Result:=Nil;
  1607. If (P>0) then
  1608. NotFound:=Copy(APath,1,P)
  1609. else
  1610. NotFound:=APath;
  1611. end;
  1612. end
  1613. else
  1614. Result:=inherited DoFindPath(APath, NotFound);
  1615. end;
  1616. procedure TJSONArray.Converterror(From: Boolean);
  1617. begin
  1618. If From then
  1619. DoError(SErrCannotConvertFromArray)
  1620. else
  1621. DoError(SErrCannotConvertToArray);
  1622. end;
  1623. {$warnings off}
  1624. function TJSONArray.GetAsBoolean: Boolean;
  1625. begin
  1626. ConvertError(True);
  1627. end;
  1628. function TJSONArray.GetAsFloat: TJSONFloat;
  1629. begin
  1630. ConvertError(True);
  1631. end;
  1632. function TJSONArray.GetAsInteger: Integer;
  1633. begin
  1634. ConvertError(True);
  1635. end;
  1636. function TJSONArray.GetAsInt64: Int64;
  1637. begin
  1638. ConvertError(True);
  1639. end;
  1640. function TJSONArray.GetAsQWord: QWord;
  1641. begin
  1642. ConvertError(True);
  1643. end;
  1644. procedure TJSONArray.SetAsBoolean(const AValue: Boolean);
  1645. begin
  1646. ConvertError(False);
  1647. end;
  1648. procedure TJSONArray.SetAsFloat(const AValue: TJSONFloat);
  1649. begin
  1650. ConvertError(False);
  1651. end;
  1652. procedure TJSONArray.SetAsInteger(const AValue: Integer);
  1653. begin
  1654. ConvertError(False);
  1655. end;
  1656. procedure TJSONArray.SetAsInt64(const AValue: Int64);
  1657. begin
  1658. ConvertError(False);
  1659. end;
  1660. procedure TJSONArray.SetAsQword(const AValue: QWord);
  1661. begin
  1662. ConvertError(False);
  1663. end;
  1664. {$warnings on}
  1665. function TJSONArray.GetAsJSON: TJSONStringType;
  1666. Var
  1667. I : Integer;
  1668. Sep : String;
  1669. begin
  1670. Sep:=TJSONData.FElementSep;
  1671. Result:='[';
  1672. For I:=0 to Count-1 do
  1673. begin
  1674. Result:=Result+Items[i].AsJSON;
  1675. If (I<Count-1) then
  1676. Result:=Result+Sep;
  1677. end;
  1678. Result:=Result+']';
  1679. end;
  1680. {$warnings off}
  1681. Function IndentString(Options : TFormatOptions; Indent : Integer) : TJSONStringType;
  1682. begin
  1683. If (foUseTabChar in Options) then
  1684. Result:=StringofChar(#9,Indent)
  1685. else
  1686. Result:=StringOfChar(' ',Indent);
  1687. end;
  1688. function TJSONArray.DoFormatJSON(Options: TFormatOptions; CurrentIndent,
  1689. Indent: Integer): TJSONStringType;
  1690. Var
  1691. I : Integer;
  1692. MultiLine : Boolean;
  1693. SkipWhiteSpace : Boolean;
  1694. Ind : String;
  1695. begin
  1696. Result:='[';
  1697. MultiLine:=Not (foSingleLineArray in Options);
  1698. SkipWhiteSpace:=foSkipWhiteSpace in Options;
  1699. Ind:=IndentString(Options, CurrentIndent+Indent);
  1700. if MultiLine then
  1701. Result:=Result+sLineBreak;
  1702. For I:=0 to Count-1 do
  1703. begin
  1704. if MultiLine then
  1705. Result:=Result+Ind;
  1706. Result:=Result+Items[i].DoFormatJSON(Options,CurrentIndent+Indent,Indent);
  1707. If (I<Count-1) then
  1708. if MultiLine then
  1709. Result:=Result+','
  1710. else
  1711. Result:=Result+ElementSeps[SkipWhiteSpace];
  1712. if MultiLine then
  1713. Result:=Result+sLineBreak
  1714. end;
  1715. if MultiLine then
  1716. Result:=Result+IndentString(Options, CurrentIndent);
  1717. Result:=Result+']';
  1718. end;
  1719. function TJSONArray.GetAsString: TJSONStringType;
  1720. begin
  1721. ConvertError(True);
  1722. end;
  1723. procedure TJSONArray.SetAsString(const AValue: TJSONStringType);
  1724. begin
  1725. ConvertError(False);
  1726. end;
  1727. function TJSONArray.GetValue: variant;
  1728. begin
  1729. ConvertError(True);
  1730. end;
  1731. procedure TJSONArray.SetValue(const AValue: variant);
  1732. begin
  1733. ConvertError(False);
  1734. end;
  1735. {$warnings on}
  1736. function TJSONArray.GetCount: Integer;
  1737. begin
  1738. Result:=Flist.Count;
  1739. end;
  1740. function TJSONArray.GetItem(Index: Integer): TJSONData;
  1741. begin
  1742. Result:=FList[Index] as TJSONData;
  1743. end;
  1744. procedure TJSONArray.SetItem(Index: Integer; const AValue: TJSONData);
  1745. begin
  1746. If (Index=FList.Count) then
  1747. FList.Add(AValue)
  1748. else
  1749. FList[Index]:=AValue;
  1750. end;
  1751. constructor TJSONArray.Create;
  1752. begin
  1753. Flist:=TFPObjectList.Create(True);
  1754. end;
  1755. Function VarRecToJSON(Const Element : TVarRec; const SourceType : String) : TJSONData;
  1756. begin
  1757. Result:=Nil;
  1758. With Element do
  1759. case VType of
  1760. vtInteger : Result:=CreateJSON(VInteger);
  1761. vtBoolean : Result:=CreateJSON(VBoolean);
  1762. vtChar : Result:=CreateJSON(VChar);
  1763. vtExtended : Result:=CreateJSON(VExtended^);
  1764. vtString : Result:=CreateJSON(vString^);
  1765. vtAnsiString : Result:=CreateJSON(AnsiString(vAnsiString));
  1766. vtPChar : Result:=CreateJSON(StrPas(VPChar));
  1767. vtPointer : If (VPointer<>Nil) then
  1768. TJSONData.DoError(SErrPointerNotNil,[SourceType])
  1769. else
  1770. Result:=CreateJSON();
  1771. vtCurrency : Result:=CreateJSON(vCurrency^);
  1772. vtInt64 : Result:=CreateJSON(vInt64^);
  1773. vtObject : if (VObject is TJSONData) then
  1774. Result:=TJSONData(VObject)
  1775. else
  1776. TJSONData.DoError(SErrNotJSONData,[VObject.ClassName,SourceType]);
  1777. //vtVariant :
  1778. else
  1779. TJSONData.DoError(SErrUnknownTypeInConstructor,[SourceType,VType])
  1780. end;
  1781. end;
  1782. constructor TJSONArray.Create(const Elements: array of const);
  1783. Var
  1784. I : integer;
  1785. J : TJSONData;
  1786. begin
  1787. Create;
  1788. For I:=Low(Elements) to High(Elements) do
  1789. begin
  1790. J:=VarRecToJSON(Elements[i],'Array');
  1791. Add(J);
  1792. end;
  1793. end;
  1794. destructor TJSONArray.Destroy;
  1795. begin
  1796. FreeAndNil(FList);
  1797. inherited Destroy;
  1798. end;
  1799. class function TJSONArray.JSONType: TJSONType;
  1800. begin
  1801. Result:=jtArray;
  1802. end;
  1803. function TJSONArray.Clone: TJSONData;
  1804. Var
  1805. A : TJSONArray;
  1806. I : Integer;
  1807. begin
  1808. A:=TJSONArrayClass(ClassType).Create;
  1809. try
  1810. For I:=0 to Count-1 do
  1811. A.Add(Self.Items[I].Clone);
  1812. Result:=A;
  1813. except
  1814. A.Free;
  1815. Raise;
  1816. end;
  1817. end;
  1818. procedure TJSONArray.Iterate(Iterator: TJSONArrayIterator; Data: TObject);
  1819. Var
  1820. I : Integer;
  1821. Cont : Boolean;
  1822. begin
  1823. I:=0;
  1824. Cont:=True;
  1825. While (I<FList.Count) and cont do
  1826. begin
  1827. Iterator(Items[i],Data,Cont);
  1828. Inc(I);
  1829. end;
  1830. end;
  1831. function TJSONArray.IndexOf(obj: TJSONData): Integer;
  1832. begin
  1833. Result:=FList.IndexOf(Obj);
  1834. end;
  1835. function TJSONArray.GetEnumerator: TBaseJSONEnumerator;
  1836. begin
  1837. Result:=TJSONArrayEnumerator.Create(Self);
  1838. end;
  1839. procedure TJSONArray.Clear;
  1840. begin
  1841. FList.Clear;
  1842. end;
  1843. function TJSONArray.Add(Item: TJSONData): Integer;
  1844. begin
  1845. Result:=FList.Add(Item);
  1846. end;
  1847. function TJSONArray.Add(I: Integer): Integer;
  1848. begin
  1849. Result:=Add(CreateJSON(I));
  1850. end;
  1851. function TJSONArray.Add(I: Int64): Int64;
  1852. begin
  1853. Result:=Add(CreateJSON(I));
  1854. end;
  1855. function TJSONArray.Add(I: QWord): QWord;
  1856. begin
  1857. Result:=Add(CreateJSON(I));
  1858. end;
  1859. function TJSONArray.Add(const S: String): Integer;
  1860. begin
  1861. Result:=Add(CreateJSON(S));
  1862. end;
  1863. function TJSONArray.Add: Integer;
  1864. begin
  1865. Result:=Add(CreateJSON);
  1866. end;
  1867. function TJSONArray.Add(F: TJSONFloat): Integer;
  1868. begin
  1869. Result:=Add(CreateJSON(F));
  1870. end;
  1871. function TJSONArray.Add(B: Boolean): Integer;
  1872. begin
  1873. Result:=Add(CreateJSON(B));
  1874. end;
  1875. function TJSONArray.Add(AnArray: TJSONArray): Integer;
  1876. begin
  1877. If (IndexOf(AnArray)<>-1) then
  1878. DoError(SErrCannotAddArrayTwice);
  1879. Result:=Add(TJSONData(AnArray));
  1880. end;
  1881. function TJSONArray.Add(AnObject: TJSONObject): Integer;
  1882. begin
  1883. If (IndexOf(AnObject)<>-1) then
  1884. DoError(SErrCannotAddObjectTwice);
  1885. Result:=Add(TJSONData(AnObject));
  1886. end;
  1887. procedure TJSONArray.Delete(Index: Integer);
  1888. begin
  1889. FList.Delete(Index);
  1890. end;
  1891. procedure TJSONArray.Exchange(Index1, Index2: Integer);
  1892. begin
  1893. FList.Exchange(Index1, Index2);
  1894. end;
  1895. function TJSONArray.Extract(Item: TJSONData): TJSONData;
  1896. begin
  1897. Result := TJSONData(FList.Extract(Item));
  1898. end;
  1899. function TJSONArray.Extract(Index: Integer): TJSONData;
  1900. begin
  1901. Result := TJSONData(FList.Extract(FList.Items[Index]));
  1902. end;
  1903. procedure TJSONArray.Insert(Index: Integer);
  1904. begin
  1905. Insert(Index,CreateJSON);
  1906. end;
  1907. procedure TJSONArray.Insert(Index: Integer; Item: TJSONData);
  1908. begin
  1909. FList.Insert(Index, Item);
  1910. end;
  1911. procedure TJSONArray.Insert(Index: Integer; I: Integer);
  1912. begin
  1913. FList.Insert(Index, CreateJSON(I));
  1914. end;
  1915. procedure TJSONArray.Insert(Index: Integer; I: Int64);
  1916. begin
  1917. FList.Insert(Index, CreateJSON(I));
  1918. end;
  1919. procedure TJSONArray.Insert(Index: Integer; I: QWord);
  1920. begin
  1921. FList.Insert(Index, CreateJSON(I));
  1922. end;
  1923. procedure TJSONArray.Insert(Index: Integer; const S: String);
  1924. begin
  1925. FList.Insert(Index, CreateJSON(S));
  1926. end;
  1927. procedure TJSONArray.Insert(Index: Integer; F: TJSONFloat);
  1928. begin
  1929. FList.Insert(Index, CreateJSON(F));
  1930. end;
  1931. procedure TJSONArray.Insert(Index: Integer; B: Boolean);
  1932. begin
  1933. FList.Insert(Index, CreateJSON(B));
  1934. end;
  1935. procedure TJSONArray.Insert(Index: Integer; AnArray: TJSONArray);
  1936. begin
  1937. if (IndexOf(AnArray)<>-1) then
  1938. DoError(SErrCannotAddArrayTwice);
  1939. FList.Insert(Index, AnArray);
  1940. end;
  1941. procedure TJSONArray.Insert(Index: Integer; AnObject: TJSONObject);
  1942. begin
  1943. if (IndexOf(AnObject)<>-1) then
  1944. DoError(SErrCannotAddObjectTwice);
  1945. FList.Insert(Index, AnObject);
  1946. end;
  1947. procedure TJSONArray.Move(CurIndex, NewIndex: Integer);
  1948. begin
  1949. FList.Move(CurIndex, NewIndex);
  1950. end;
  1951. procedure TJSONArray.Remove(Item: TJSONData);
  1952. begin
  1953. FList.Remove(Item);
  1954. end;
  1955. { TJSONObject }
  1956. function TJSONObject.GetArrays(const AName: String): TJSONArray;
  1957. begin
  1958. Result:=GetElements(AName) as TJSONArray;
  1959. end;
  1960. function TJSONObject.GetBooleans(const AName: String): Boolean;
  1961. begin
  1962. Result:=GetElements(AName).AsBoolean;
  1963. end;
  1964. function TJSONObject.GetElements(const AName: string): TJSONData;
  1965. begin
  1966. Result:=TJSONData(FHash.Find(AName));
  1967. If (Result=Nil) then
  1968. DoError(SErrNonexistentElement,[AName]);
  1969. end;
  1970. function TJSONObject.GetFloats(const AName: String): TJSONFloat;
  1971. begin
  1972. Result:=GetElements(AName).AsFloat;
  1973. end;
  1974. function TJSONObject.GetIntegers(const AName: String): Integer;
  1975. begin
  1976. Result:=GetElements(AName).AsInteger;
  1977. end;
  1978. function TJSONObject.GetInt64s(const AName: String): Int64;
  1979. begin
  1980. Result:=GetElements(AName).AsInt64;
  1981. end;
  1982. function TJSONObject.GetIsNull(const AName: String): Boolean;
  1983. begin
  1984. Result:=GetElements(AName).IsNull;
  1985. end;
  1986. function TJSONObject.GetNameOf(Index: Integer): TJSONStringType;
  1987. begin
  1988. Result:=FHash.NameOfIndex(Index);
  1989. end;
  1990. function TJSONObject.GetObjects(const AName : String): TJSONObject;
  1991. begin
  1992. Result:=GetElements(AName) as TJSONObject;
  1993. end;
  1994. function TJSONObject.GetQWords(AName : String): QWord;
  1995. begin
  1996. Result:=GetElements(AName).AsQWord;
  1997. end;
  1998. function TJSONObject.GetStrings(const AName : String): TJSONStringType;
  1999. begin
  2000. Result:=GetElements(AName).AsString;
  2001. end;
  2002. function TJSONObject.GetTypes(const AName : String): TJSONType;
  2003. begin
  2004. Result:=Getelements(Aname).JSONType;
  2005. end;
  2006. class function TJSONObject.GetUnquotedMemberNames: Boolean; static;
  2007. begin
  2008. Result:=FUnquotedMemberNames;
  2009. end;
  2010. procedure TJSONObject.SetArrays(const AName : String; const AValue: TJSONArray);
  2011. begin
  2012. SetElements(AName,AVAlue);
  2013. end;
  2014. procedure TJSONObject.SetBooleans(const AName : String; const AValue: Boolean);
  2015. begin
  2016. SetElements(AName,CreateJSON(AVAlue));
  2017. end;
  2018. procedure TJSONObject.SetElements(const AName: string; const AValue: TJSONData);
  2019. Var
  2020. Index : Integer;
  2021. begin
  2022. Index:=FHash.FindIndexOf(AName);
  2023. If (Index=-1) then
  2024. FHash.Add(AName,AValue)
  2025. else
  2026. FHash.Items[Index]:=AValue; // Will free the previous value.
  2027. end;
  2028. procedure TJSONObject.SetFloats(const AName : String; const AValue: TJSONFloat);
  2029. begin
  2030. SetElements(AName,CreateJSON(AVAlue));
  2031. end;
  2032. procedure TJSONObject.SetIntegers(const AName : String; const AValue: Integer);
  2033. begin
  2034. SetElements(AName,CreateJSON(AVAlue));
  2035. end;
  2036. procedure TJSONObject.SetInt64s(const AName : String; const AValue: Int64);
  2037. begin
  2038. SetElements(AName,CreateJSON(AVAlue));
  2039. end;
  2040. procedure TJSONObject.SetIsNull(const AName : String; const AValue: Boolean);
  2041. begin
  2042. If Not AValue then
  2043. DoError(SErrCannotSetNotIsNull);
  2044. SetElements(AName,CreateJSON);
  2045. end;
  2046. procedure TJSONObject.SetObjects(const AName : String; const AValue: TJSONObject);
  2047. begin
  2048. SetElements(AName,AValue);
  2049. end;
  2050. procedure TJSONObject.SetQWords(AName : String; AValue: QWord);
  2051. begin
  2052. SetElements(AName,CreateJSON(AVAlue));
  2053. end;
  2054. procedure TJSONObject.SetStrings(const AName : String; const AValue: TJSONStringType);
  2055. begin
  2056. SetElements(AName,CreateJSON(AVAlue));
  2057. end;
  2058. class procedure TJSONObject.DetermineElementQuotes;
  2059. begin
  2060. FObjStartSep:=ObjStartSeps[TJSONData.FCompressedJSON];
  2061. FObjEndSep:=ObjEndSeps[TJSONData.FCompressedJSON];
  2062. if TJSONData.FCompressedJSON then
  2063. FElementEnd:=UnSpacedQuoted[FUnquotedMemberNames]
  2064. else
  2065. FElementEnd:=SpacedQuoted[FUnquotedMemberNames];
  2066. FElementStart:=ElementStart[FUnquotedMemberNames]
  2067. end;
  2068. class procedure TJSONObject.SetUnquotedMemberNames(AValue: Boolean); static;
  2069. begin
  2070. if FUnquotedMemberNames=AValue then exit;
  2071. FUnquotedMemberNames:=AValue;
  2072. DetermineElementQuotes;
  2073. end;
  2074. function TJSONObject.DoFindPath(const APath: TJSONStringType; out
  2075. NotFound: TJSONStringType): TJSONdata;
  2076. Var
  2077. N: TJSONStringType;
  2078. L,P,P2 : Integer;
  2079. begin
  2080. If (APath='') then
  2081. Exit(Self);
  2082. N:=APath;
  2083. L:=Length(N);
  2084. P:=1;
  2085. While (P<L) and (N[P]='.') do
  2086. inc(P);
  2087. P2:=P;
  2088. While (P2<=L) and (Not (N[P2] in ['.','['])) do
  2089. inc(P2);
  2090. N:=Copy(APath,P,P2-P);
  2091. If (N='') then
  2092. Result:=Self
  2093. else
  2094. begin
  2095. Result:=Find(N);
  2096. If Result=Nil then
  2097. NotFound:=N+Copy(APath,P2,L-P2)
  2098. else
  2099. begin
  2100. N:=Copy(APath,P2,L-P2+1);
  2101. Result:=Result.DoFindPath(N,NotFound);
  2102. end;
  2103. end;
  2104. end;
  2105. procedure TJSONObject.Converterror(From: Boolean);
  2106. begin
  2107. If From then
  2108. DoError(SErrCannotConvertFromObject)
  2109. else
  2110. DoError(SErrCannotConvertToObject);
  2111. end;
  2112. {$warnings off}
  2113. function TJSONObject.GetAsBoolean: Boolean;
  2114. begin
  2115. ConvertError(True);
  2116. end;
  2117. function TJSONObject.GetAsFloat: TJSONFloat;
  2118. begin
  2119. ConvertError(True);
  2120. end;
  2121. function TJSONObject.GetAsInteger: Integer;
  2122. begin
  2123. ConvertError(True);
  2124. end;
  2125. function TJSONObject.GetAsInt64: Int64;
  2126. begin
  2127. ConvertError(True);
  2128. end;
  2129. function TJSONObject.GetAsQWord: QWord;
  2130. begin
  2131. ConvertError(True);
  2132. end;
  2133. procedure TJSONObject.SetAsBoolean(const AValue: Boolean);
  2134. begin
  2135. ConvertError(False);
  2136. end;
  2137. procedure TJSONObject.SetAsFloat(const AValue: TJSONFloat);
  2138. begin
  2139. ConvertError(False);
  2140. end;
  2141. procedure TJSONObject.SetAsInteger(const AValue: Integer);
  2142. begin
  2143. ConvertError(False);
  2144. end;
  2145. procedure TJSONObject.SetAsInt64(const AValue: Int64);
  2146. begin
  2147. ConvertError(False);
  2148. end;
  2149. procedure TJSONObject.SetAsQword(const AValue: QWord);
  2150. begin
  2151. ConvertError(False);
  2152. end;
  2153. {$warnings on}
  2154. function TJSONObject.GetAsJSON: TJSONStringType;
  2155. Var
  2156. I : Integer;
  2157. Sep : String;
  2158. begin
  2159. Sep:=TJSONData.FElementSep;
  2160. Result:='';
  2161. For I:=0 to Count-1 do
  2162. begin
  2163. If (Result<>'') then
  2164. Result:=Result+Sep;
  2165. Result:=Result+FElementStart+StringToJSONString(Names[i])+FElementEnd+Items[I].AsJSON;
  2166. end;
  2167. If (Result<>'') then
  2168. Result:=FObjStartSep+Result+FObjEndSep
  2169. else
  2170. Result:='{}';
  2171. end;
  2172. {$warnings off}
  2173. function TJSONObject.GetAsString: TJSONStringType;
  2174. begin
  2175. ConvertError(True);
  2176. end;
  2177. procedure TJSONObject.SetAsString(const AValue: TJSONStringType);
  2178. begin
  2179. ConvertError(False);
  2180. end;
  2181. function TJSONObject.GetValue: variant;
  2182. begin
  2183. ConvertError(True);
  2184. end;
  2185. procedure TJSONObject.SetValue(const AValue: variant);
  2186. begin
  2187. ConvertError(False);
  2188. end;
  2189. {$warnings on}
  2190. function TJSONObject.GetCount: Integer;
  2191. begin
  2192. Result:=FHash.Count;
  2193. end;
  2194. function TJSONObject.GetItem(Index: Integer): TJSONData;
  2195. begin
  2196. Result:=TJSONData(FHash.Items[Index]);
  2197. end;
  2198. procedure TJSONObject.SetItem(Index: Integer; const AValue: TJSONData);
  2199. begin
  2200. FHash.Items[Index]:=AValue;
  2201. end;
  2202. constructor TJSONObject.Create;
  2203. begin
  2204. FHash:=TFPHashObjectList.Create(True);
  2205. end;
  2206. constructor TJSONObject.Create(const Elements: array of const);
  2207. Var
  2208. I : integer;
  2209. AName : String;
  2210. J : TJSONData;
  2211. begin
  2212. Create;
  2213. If ((High(Elements)-Low(Elements)) mod 2)=0 then
  2214. DoError(SErrOddNumber);
  2215. I:=Low(Elements);
  2216. While I<=High(Elements) do
  2217. begin
  2218. With Elements[i] do
  2219. Case VType of
  2220. vtChar : AName:=VChar;
  2221. vtString : AName:=vString^;
  2222. vtAnsiString : AName:=(AnsiString(vAnsiString));
  2223. vtPChar : AName:=StrPas(VPChar);
  2224. else
  2225. DoError(SErrNameMustBeString,[I+1]);
  2226. end;
  2227. If (ANAme='') then
  2228. DoError(SErrNameMustBeString,[I+1]);
  2229. Inc(I);
  2230. J:=VarRecToJSON(Elements[i],'Object');
  2231. Add(AName,J);
  2232. Inc(I);
  2233. end;
  2234. end;
  2235. destructor TJSONObject.Destroy;
  2236. begin
  2237. FreeAndNil(FHash);
  2238. inherited Destroy;
  2239. end;
  2240. class function TJSONObject.JSONType: TJSONType;
  2241. begin
  2242. Result:=jtObject;
  2243. end;
  2244. function TJSONObject.Clone: TJSONData;
  2245. Var
  2246. O : TJSONObject;
  2247. I: Integer;
  2248. begin
  2249. O:=TJSONObjectClass(ClassType).Create;
  2250. try
  2251. For I:=0 to Count-1 do
  2252. O.Add(Self.Names[I],Self.Items[I].Clone);
  2253. Result:=O;
  2254. except
  2255. FreeAndNil(O);
  2256. Raise;
  2257. end;
  2258. end;
  2259. function TJSONObject.GetEnumerator: TBaseJSONEnumerator;
  2260. begin
  2261. Result:=TJSONObjectEnumerator.Create(Self);
  2262. end;
  2263. function TJSONObject.DoFormatJSON(Options: TFormatOptions; CurrentIndent,
  2264. Indent: Integer): TJSONStringType;
  2265. Var
  2266. i : Integer;
  2267. S : TJSONStringType;
  2268. MultiLine,UseQuotes, SkipWhiteSpace : Boolean;
  2269. NSep,Sep,Ind : String;
  2270. begin
  2271. Result:='';
  2272. UseQuotes:=Not (foDoNotQuoteMembers in options);
  2273. MultiLine:=Not (foSingleLineObject in Options);
  2274. SkipWhiteSpace:=foSkipWhiteSpace in Options;
  2275. CurrentIndent:=CurrentIndent+Indent;
  2276. Ind:=IndentString(Options, CurrentIndent);
  2277. If SkipWhiteSpace then
  2278. NSep:=':'
  2279. else
  2280. NSep:=' : ';
  2281. If MultiLine then
  2282. Sep:=','+SLineBreak+Ind
  2283. else if SkipWhiteSpace then
  2284. Sep:=','
  2285. else
  2286. Sep:=', ';
  2287. For I:=0 to Count-1 do
  2288. begin
  2289. If (I>0) then
  2290. Result:=Result+Sep
  2291. else If MultiLine then
  2292. Result:=Result+Ind;
  2293. S:=StringToJSONString(Names[i]);
  2294. If UseQuotes then
  2295. S:='"'+S+'"';
  2296. Result:=Result+S+NSep+Items[I].DoFormatJSON(Options,CurrentIndent,Indent);
  2297. end;
  2298. If (Result<>'') then
  2299. begin
  2300. if MultiLine then
  2301. Result:='{'+sLineBreak+Result+sLineBreak+indentString(options,CurrentIndent-Indent)+'}'
  2302. else
  2303. Result:=ObjStartSeps[SkipWhiteSpace]+Result+ObjEndSeps[SkipWhiteSpace]
  2304. end
  2305. else
  2306. Result:='{}';
  2307. end;
  2308. procedure TJSONObject.Iterate(Iterator: TJSONObjectIterator; Data: TObject);
  2309. Var
  2310. I : Integer;
  2311. Cont : Boolean;
  2312. begin
  2313. I:=0;
  2314. Cont:=True;
  2315. While (I<FHash.Count) and cont do
  2316. begin
  2317. Iterator(Names[I],Items[i],Data,Cont);
  2318. Inc(I);
  2319. end;
  2320. end;
  2321. function TJSONObject.IndexOf(Item: TJSONData): Integer;
  2322. begin
  2323. Result:=FHash.IndexOf(Item);
  2324. end;
  2325. function TJSONObject.IndexOfName(const AName: TJSONStringType; CaseInsensitive : Boolean = False): Integer;
  2326. begin
  2327. Result:=FHash.FindIndexOf(AName);
  2328. if (Result=-1) and CaseInsensitive then
  2329. begin
  2330. Result:=Count-1;
  2331. While (Result>=0) and (CompareText(Names[Result],AName)<>0) do
  2332. Dec(Result);
  2333. end;
  2334. end;
  2335. procedure TJSONObject.Clear;
  2336. begin
  2337. FHash.Clear;
  2338. end;
  2339. function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONData
  2340. ): Integer;
  2341. begin
  2342. Result:=FHash.Add(AName,AValue);
  2343. end;
  2344. function TJSONObject.Add(const AName: TJSONStringType; AValue: Boolean
  2345. ): Integer;
  2346. begin
  2347. Result:=Add(AName,CreateJSON(AValue));
  2348. end;
  2349. function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer;
  2350. begin
  2351. Result:=Add(AName,CreateJSON(AValue));
  2352. end;
  2353. function TJSONObject.Add(const AName, AValue: TJSONStringType): Integer;
  2354. begin
  2355. Result:=Add(AName,CreateJSON(AValue));
  2356. end;
  2357. function TJSONObject.Add(const AName: TJSONStringType; Avalue: Integer): Integer;
  2358. begin
  2359. Result:=Add(AName,CreateJSON(AValue));
  2360. end;
  2361. function TJSONObject.Add(const AName: TJSONStringType; Avalue: Int64): Integer;
  2362. begin
  2363. Result:=Add(AName,CreateJSON(AValue));
  2364. end;
  2365. function TJSONObject.Add(const AName: TJSONStringType; Avalue: QWord): Integer;
  2366. begin
  2367. Result:=Add(AName,CreateJSON(AValue));
  2368. end;
  2369. function TJSONObject.Add(const AName: TJSONStringType): Integer;
  2370. begin
  2371. Result:=Add(AName,CreateJSON);
  2372. end;
  2373. function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONArray
  2374. ): Integer;
  2375. begin
  2376. Result:=Add(AName,TJSONData(AValue));
  2377. end;
  2378. procedure TJSONObject.Delete(Index: Integer);
  2379. begin
  2380. FHash.Delete(Index);
  2381. end;
  2382. procedure TJSONObject.Delete(const AName: string);
  2383. Var
  2384. I : Integer;
  2385. begin
  2386. I:=IndexOfName(AName);
  2387. if (I<>-1) then
  2388. Delete(I);
  2389. end;
  2390. procedure TJSONObject.Remove(Item: TJSONData);
  2391. begin
  2392. FHash.Remove(Item);
  2393. end;
  2394. function TJSONObject.Extract(Index: Integer): TJSONData;
  2395. begin
  2396. Result:=Items[Index];
  2397. FHash.Extract(Result);
  2398. end;
  2399. function TJSONObject.Extract(const AName: string): TJSONData;
  2400. Var
  2401. I : Integer;
  2402. begin
  2403. I:=IndexOfName(AName);
  2404. if (I<>-1) then
  2405. Result:=Extract(I)
  2406. else
  2407. Result:=Nil
  2408. end;
  2409. function TJSONObject.Get(const AName: String): Variant;
  2410. Var
  2411. I : Integer;
  2412. begin
  2413. I:=IndexOfName(AName);
  2414. If (I<>-1) then
  2415. Result:=Items[i].Value
  2416. else
  2417. Result:=Null;
  2418. end;
  2419. function TJSONObject.Get(const AName: String; ADefault: TJSONFloat
  2420. ): TJSONFloat;
  2421. Var
  2422. D : TJSONData;
  2423. begin
  2424. D:=Find(AName,jtNumber);
  2425. If D<>Nil then
  2426. Result:=D.AsFloat
  2427. else
  2428. Result:=ADefault;
  2429. end;
  2430. function TJSONObject.Get(const AName: String; ADefault: Integer
  2431. ): Integer;
  2432. Var
  2433. D : TJSONData;
  2434. begin
  2435. D:=Find(AName,jtNumber);
  2436. If D<>Nil then
  2437. Result:=D.AsInteger
  2438. else
  2439. Result:=ADefault;
  2440. end;
  2441. function TJSONObject.Get(const AName: String; ADefault: Int64): Int64;
  2442. Var
  2443. D : TJSONData;
  2444. begin
  2445. D:=Find(AName,jtNumber);
  2446. If D<>Nil then
  2447. Result:=D.AsInt64
  2448. else
  2449. Result:=ADefault;
  2450. end;
  2451. function TJSONObject.Get(const AName: String; ADefault: QWord): QWord;
  2452. Var
  2453. D : TJSONData;
  2454. begin
  2455. D:=Find(AName,jtNumber);
  2456. If D<>Nil then
  2457. Result:=D.AsQWord
  2458. else
  2459. Result:=ADefault;
  2460. end;
  2461. function TJSONObject.Get(const AName: String; ADefault: Boolean
  2462. ): Boolean;
  2463. Var
  2464. D : TJSONData;
  2465. begin
  2466. D:=Find(AName,jtBoolean);
  2467. If D<>Nil then
  2468. Result:=D.AsBoolean
  2469. else
  2470. Result:=ADefault;
  2471. end;
  2472. function TJSONObject.Get(const AName: String; ADefault: TJSONStringType
  2473. ): TJSONStringTYpe;
  2474. Var
  2475. D : TJSONData;
  2476. begin
  2477. D:=Find(AName,jtString);
  2478. If (D<>Nil) then
  2479. Result:=D.AsString
  2480. else
  2481. Result:=ADefault;
  2482. end;
  2483. function TJSONObject.Get(const AName: String; ADefault: TJSONArray
  2484. ): TJSONArray;
  2485. Var
  2486. D : TJSONData;
  2487. begin
  2488. D:=Find(AName,jtArray);
  2489. If (D<>Nil) then
  2490. Result:=TJSONArray(D)
  2491. else
  2492. Result:=ADefault;
  2493. end;
  2494. function TJSONObject.Get(const AName: String; ADefault: TJSONObject
  2495. ): TJSONObject;
  2496. Var
  2497. D : TJSONData;
  2498. begin
  2499. D:=Find(AName,jtObject);
  2500. If (D<>Nil) then
  2501. Result:=TJSONObject(D)
  2502. else
  2503. Result:=ADefault;
  2504. end;
  2505. function TJSONObject.Find(const AName: String): TJSONData;
  2506. Var
  2507. I : Integer;
  2508. begin
  2509. I:=IndexOfName(AName);
  2510. If (I<>-1) then
  2511. Result:=Items[i]
  2512. else
  2513. Result:=Nil;
  2514. end;
  2515. function TJSONObject.Find(const AName: String; AType: TJSONType): TJSONData;
  2516. begin
  2517. Result:=Find(AName);
  2518. If Assigned(Result) and (Result.JSONType<>AType) then
  2519. Result:=Nil;
  2520. end;
  2521. initialization
  2522. // Need to force initialization;
  2523. TJSONData.DetermineElementSeparators;
  2524. TJSONObject.DetermineElementQuotes;
  2525. end.