fpjson.pp 64 KB

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