fpjson.pp 43 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752
  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. TJSONFloat = Extended;
  23. TJSONStringType = AnsiString;
  24. TJSONCharType = AnsiChar;
  25. PJSONCharType = ^TJSONCharType;
  26. { TJSONData }
  27. TJSONData = class(TObject)
  28. protected
  29. function GetAsBoolean: Boolean; virtual; abstract;
  30. function GetAsFloat: TJSONFloat; virtual; abstract;
  31. function GetAsInteger: Integer; virtual; abstract;
  32. function GetAsInt64: Int64; virtual; abstract;
  33. function GetIsNull: Boolean; virtual;
  34. procedure SetAsBoolean(const AValue: Boolean); virtual; abstract;
  35. procedure SetAsFloat(const AValue: TJSONFloat); virtual; abstract;
  36. procedure SetAsInteger(const AValue: Integer); virtual; abstract;
  37. procedure SetAsInt64(const AValue: Int64); virtual; abstract;
  38. function GetAsJSON: TJSONStringType; virtual; abstract;
  39. function GetAsString: TJSONStringType; virtual; abstract;
  40. procedure SetAsString(const AValue: TJSONStringType); virtual; abstract;
  41. function GetValue: variant; virtual; abstract;
  42. procedure SetValue(const AValue: variant); virtual; abstract;
  43. function GetItem(Index : Integer): TJSONData; virtual;
  44. procedure SetItem(Index : Integer; const AValue: TJSONData); virtual;
  45. function GetCount: Integer; virtual;
  46. public
  47. Constructor Create; virtual;
  48. Class function JSONType: TJSONType; virtual;
  49. Procedure Clear; virtual; Abstract;
  50. property Count: Integer read GetCount;
  51. property Items[Index: Integer]: TJSONData read GetItem write SetItem;
  52. property Value: variant read GetValue write SetValue;
  53. Property AsString : TJSONStringType Read GetAsString Write SetAsString;
  54. Property AsFloat : TJSONFloat Read GetAsFloat Write SetAsFloat;
  55. Property AsInteger : Integer Read GetAsInteger Write SetAsInteger;
  56. Property AsInt64 : Int64 Read GetAsInt64 Write SetAsInt64;
  57. Property AsBoolean : Boolean Read GetAsBoolean Write SetAsBoolean;
  58. Property IsNull : Boolean Read GetIsNull;
  59. Property AsJSON : TJSONStringType Read GetAsJSON;
  60. end;
  61. TJSONDataClass = Class of TJSONData;
  62. TJSONNumberType = (ntFloat,ntInteger,ntInt64);
  63. TJSONNumber = class(TJSONData)
  64. protected
  65. public
  66. class function JSONType: TJSONType; override;
  67. class function NumberType : TJSONNumberType; virtual; abstract;
  68. end;
  69. { TJSONFloatNumber }
  70. TJSONFloatNumber = class(TJSONNumber)
  71. Private
  72. FValue : TJSONFloat;
  73. protected
  74. function GetAsBoolean: Boolean; override;
  75. function GetAsFloat: TJSONFloat; override;
  76. function GetAsInteger: Integer; override;
  77. function GetAsInt64: Int64; override;
  78. procedure SetAsBoolean(const AValue: Boolean); override;
  79. procedure SetAsFloat(const AValue: TJSONFloat); override;
  80. procedure SetAsInteger(const AValue: Integer); override;
  81. procedure SetAsInt64(const AValue: Int64); override;
  82. function GetAsJSON: TJSONStringType; override;
  83. function GetAsString: TJSONStringType; override;
  84. procedure SetAsString(const AValue: TJSONStringType); override;
  85. function GetValue: variant; override;
  86. procedure SetValue(const AValue: variant); override;
  87. public
  88. Constructor Create(AValue : TJSONFloat); reintroduce;
  89. class function NumberType : TJSONNumberType; override;
  90. Procedure Clear; override;
  91. end;
  92. { TJSONIntegerNumber }
  93. TJSONIntegerNumber = class(TJSONNumber)
  94. Private
  95. FValue : Integer;
  96. protected
  97. function GetAsBoolean: Boolean; override;
  98. function GetAsFloat: TJSONFloat; override;
  99. function GetAsInteger: Integer; override;
  100. function GetAsInt64: Int64; override;
  101. procedure SetAsBoolean(const AValue: Boolean); override;
  102. procedure SetAsFloat(const AValue: TJSONFloat); override;
  103. procedure SetAsInteger(const AValue: Integer); override;
  104. procedure SetAsInt64(const AValue: Int64); override;
  105. function GetAsJSON: TJSONStringType; override;
  106. function GetAsString: TJSONStringType; override;
  107. procedure SetAsString(const AValue: TJSONStringType); override;
  108. function GetValue: variant; override;
  109. procedure SetValue(const AValue: variant); override;
  110. public
  111. Constructor Create(AValue : Integer); reintroduce;
  112. class function NumberType : TJSONNumberType; override;
  113. Procedure Clear; override;
  114. end;
  115. { TJSONInt64Number }
  116. TJSONInt64Number = class(TJSONNumber)
  117. Private
  118. FValue : Int64;
  119. protected
  120. function GetAsBoolean: Boolean; override;
  121. function GetAsFloat: TJSONFloat; override;
  122. function GetAsInteger: Integer; override;
  123. function GetAsInt64: Int64; override;
  124. procedure SetAsBoolean(const AValue: Boolean); override;
  125. procedure SetAsFloat(const AValue: TJSONFloat); override;
  126. procedure SetAsInteger(const AValue: Integer); override;
  127. procedure SetAsInt64(const AValue: Int64); override;
  128. function GetAsJSON: TJSONStringType; override;
  129. function GetAsString: TJSONStringType; override;
  130. procedure SetAsString(const AValue: TJSONStringType); override;
  131. function GetValue: variant; override;
  132. procedure SetValue(const AValue: variant); override;
  133. public
  134. Constructor Create(AValue : Int64); reintroduce;
  135. class function NumberType : TJSONNumberType; override;
  136. Procedure Clear; override;
  137. end;
  138. { TJSONString }
  139. TJSONString = class(TJSONData)
  140. Private
  141. FValue: TJSONStringType;
  142. protected
  143. function GetValue: Variant; override;
  144. procedure SetValue(const AValue: Variant); override;
  145. function GetAsBoolean: Boolean; override;
  146. function GetAsFloat: TJSONFloat; override;
  147. function GetAsInteger: Integer; override;
  148. function GetAsInt64: Int64; override;
  149. procedure SetAsBoolean(const AValue: Boolean); override;
  150. procedure SetAsFloat(const AValue: TJSONFloat); override;
  151. procedure SetAsInteger(const AValue: Integer); override;
  152. procedure SetAsInt64(const AValue: Int64); override;
  153. function GetAsJSON: TJSONStringType; override;
  154. function GetAsString: TJSONStringType; override;
  155. procedure SetAsString(const AValue: TJSONStringType); override;
  156. public
  157. Constructor Create(AValue : TJSONStringType); reintroduce;
  158. class function JSONType: TJSONType; override;
  159. Procedure Clear; override;
  160. end;
  161. { TJSONboolean }
  162. TJSONBoolean = class(TJSONData)
  163. Private
  164. FValue: Boolean;
  165. protected
  166. function GetValue: Variant; override;
  167. procedure SetValue(const AValue: Variant); override;
  168. function GetAsBoolean: Boolean; override;
  169. function GetAsFloat: TJSONFloat; override;
  170. function GetAsInteger: Integer; override;
  171. function GetAsInt64: Int64; override;
  172. procedure SetAsBoolean(const AValue: Boolean); override;
  173. procedure SetAsFloat(const AValue: TJSONFloat); override;
  174. procedure SetAsInteger(const AValue: Integer); override;
  175. procedure SetAsInt64(const AValue: Int64); override;
  176. function GetAsJSON: TJSONStringType; override;
  177. function GetAsString: TJSONStringType; override;
  178. procedure SetAsString(const AValue: TJSONStringType); override;
  179. public
  180. Constructor Create(AValue : Boolean); reintroduce;
  181. class function JSONType: TJSONType; override;
  182. Procedure Clear; override;
  183. end;
  184. { TJSONnull }
  185. TJSONNull = class(TJSONData)
  186. protected
  187. Procedure Converterror(From : Boolean);
  188. function GetAsBoolean: Boolean; override;
  189. function GetAsFloat: TJSONFloat; override;
  190. function GetAsInteger: Integer; override;
  191. function GetAsInt64: Int64; override;
  192. function GetIsNull: Boolean; override;
  193. procedure SetAsBoolean(const AValue: Boolean); override;
  194. procedure SetAsFloat(const AValue: TJSONFloat); override;
  195. procedure SetAsInteger(const AValue: Integer); override;
  196. procedure SetAsInt64(const AValue: Int64); override;
  197. function GetAsJSON: TJSONStringType; override;
  198. function GetAsString: TJSONStringType; override;
  199. procedure SetAsString(const AValue: TJSONStringType); override;
  200. function GetValue: variant; override;
  201. procedure SetValue(const AValue: variant); override;
  202. public
  203. class function JSONType: TJSONType; override;
  204. Procedure Clear; override;
  205. end;
  206. TJSONArrayIterator = procedure(Item: TJSONData; Data: TObject; var Continue: Boolean) of object;
  207. { TJSONArray }
  208. TJSONObject = Class;
  209. TJSONArray = class(TJSONData)
  210. Private
  211. FList : TFPObjectList;
  212. function GetArrays(Index : Integer): TJSONArray;
  213. function GetBooleans(Index : Integer): Boolean;
  214. function GetFloats(Index : Integer): TJSONFloat;
  215. function GetIntegers(Index : Integer): Integer;
  216. function GetInt64s(Index : Integer): Int64;
  217. function GetNulls(Index : Integer): Boolean;
  218. function GetObjects(Index : Integer): TJSONObject;
  219. function GetStrings(Index : Integer): TJSONStringType;
  220. function GetTypes(Index : Integer): TJSONType;
  221. procedure SetArrays(Index : Integer; const AValue: TJSONArray);
  222. procedure SetBooleans(Index : Integer; const AValue: Boolean);
  223. procedure SetFloats(Index : Integer; const AValue: TJSONFloat);
  224. procedure SetIntegers(Index : Integer; const AValue: Integer);
  225. procedure SetInt64s(Index : Integer; const AValue: Int64);
  226. procedure SetObjects(Index : Integer; const AValue: TJSONObject);
  227. procedure SetStrings(Index : Integer; const AValue: TJSONStringType);
  228. protected
  229. Procedure Converterror(From : Boolean);
  230. function GetAsBoolean: Boolean; override;
  231. function GetAsFloat: TJSONFloat; override;
  232. function GetAsInteger: Integer; override;
  233. function GetAsInt64: Int64; override;
  234. procedure SetAsBoolean(const AValue: Boolean); override;
  235. procedure SetAsFloat(const AValue: TJSONFloat); override;
  236. procedure SetAsInteger(const AValue: Integer); override;
  237. procedure SetAsInt64(const AValue: Int64); override;
  238. function GetAsJSON: TJSONStringType; override;
  239. function GetAsString: TJSONStringType; override;
  240. procedure SetAsString(const AValue: TJSONStringType); override;
  241. function GetValue: variant; override;
  242. procedure SetValue(const AValue: variant); override;
  243. function GetCount: Integer; override;
  244. function GetItem(Index : Integer): TJSONData; override;
  245. procedure SetItem(Index : Integer; const AValue: TJSONData); override;
  246. public
  247. Constructor Create; overload; reintroduce;
  248. Constructor Create(const Elements : Array of Const); overload;
  249. Destructor Destroy; override;
  250. class function JSONType: TJSONType; override;
  251. // Examine
  252. procedure Iterate(Iterator : TJSONArrayIterator; Data: TObject);
  253. function IndexOf(obj: TJSONData): Integer;
  254. // Manipulate
  255. Procedure Clear; override;
  256. function Add(Item : TJSONData): Integer;
  257. function Add(I : Integer): Integer;
  258. function Add(I : Int64): Int64;
  259. function Add(S : String): Integer;
  260. function Add: Integer;
  261. function Add(F : TJSONFloat): Integer;
  262. function Add(B : Boolean): Integer;
  263. function Add(AnArray : TJSONArray): Integer;
  264. function Add(AnObject: TJSONObject): Integer;
  265. Procedure Delete(Index : Integer);
  266. Procedure Remove(Item : TJSONData);
  267. // Easy Access Properties.
  268. property Items;default;
  269. Property Types[Index : Integer] : TJSONType Read GetTypes;
  270. Property Nulls[Index : Integer] : Boolean Read GetNulls;
  271. Property Integers[Index : Integer] : Integer Read GetIntegers Write SetIntegers;
  272. Property Int64s[Index : Integer] : Int64 Read GetInt64s Write SetInt64s;
  273. Property Strings[Index : Integer] : TJSONStringType Read GetStrings Write SetStrings;
  274. Property Floats[Index : Integer] : TJSONFloat Read GetFloats Write SetFloats;
  275. Property Booleans[Index : Integer] : Boolean Read GetBooleans Write SetBooleans;
  276. Property Arrays[Index : Integer] : TJSONArray Read GetArrays Write SetArrays;
  277. Property Objects[Index : Integer] : TJSONObject Read GetObjects Write SetObjects;
  278. end;
  279. TJSONObjectIterator = procedure(Const AName : TJSONStringType; Item: TJSONData; Data: TObject; var Continue: Boolean) of object;
  280. { TJSONObject }
  281. TJSONObject = class(TJSONData)
  282. private
  283. FHash : TFPHashObjectList; // Careful : Names limited to 255 chars.
  284. function GetArrays(AName : String): TJSONArray;
  285. function GetBooleans(AName : String): Boolean;
  286. function GetElements(AName: string): TJSONData;
  287. function GetFloats(AName : String): TJSONFloat;
  288. function GetIntegers(AName : String): Integer;
  289. function GetInt64s(AName : String): Int64;
  290. function GetIsNull(AName : String): Boolean; reintroduce;
  291. function GetNameOf(Index : Integer): TJSONStringType;
  292. function GetObjects(AName : String): TJSONObject;
  293. function GetStrings(AName : String): TJSONStringType;
  294. function GetTypes(AName : String): TJSONType;
  295. procedure SetArrays(AName : String; const AValue: TJSONArray);
  296. procedure SetBooleans(AName : String; const AValue: Boolean);
  297. procedure SetElements(AName: string; const AValue: TJSONData);
  298. procedure SetFloats(AName : String; const AValue: TJSONFloat);
  299. procedure SetIntegers(AName : String; const AValue: Integer);
  300. procedure SetInt64s(AName : String; const AValue: Int64);
  301. procedure SetIsNull(AName : String; const AValue: Boolean);
  302. procedure SetObjects(AName : String; const AValue: TJSONObject);
  303. procedure SetStrings(AName : String; const AValue: TJSONStringType);
  304. protected
  305. Procedure Converterror(From : Boolean);
  306. function GetAsBoolean: Boolean; override;
  307. function GetAsFloat: TJSONFloat; override;
  308. function GetAsInteger: Integer; override;
  309. function GetAsInt64: Int64; override;
  310. procedure SetAsBoolean(const AValue: Boolean); override;
  311. procedure SetAsFloat(const AValue: TJSONFloat); override;
  312. procedure SetAsInteger(const AValue: Integer); override;
  313. procedure SetAsInt64(const AValue: Int64); override;
  314. function GetAsJSON: TJSONStringType; override;
  315. function GetAsString: TJSONStringType; override;
  316. procedure SetAsString(const AValue: TJSONStringType); override;
  317. function GetValue: variant; override;
  318. procedure SetValue(const AValue: variant); override;
  319. function GetCount: Integer; override;
  320. function GetItem(Index : Integer): TJSONData; override;
  321. procedure SetItem(Index : Integer; const AValue: TJSONData); override;
  322. public
  323. constructor Create; reintroduce;
  324. Constructor Create(const Elements : Array of Const); overload;
  325. destructor Destroy; override;
  326. class function JSONType: TJSONType; override;
  327. // Examine
  328. procedure Iterate(Iterator : TJSONObjectIterator; Data: TObject);
  329. function IndexOf(Item: TJSONData): Integer;
  330. Function IndexOfName(const AName: TJSONStringType): Integer;
  331. // Manipulate
  332. Procedure Clear; override;
  333. function Add(const AName: TJSONStringType; AValue: TJSONData): Integer; overload;
  334. function Add(const AName: TJSONStringType; AValue: Boolean): Integer; overload;
  335. function Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer; overload;
  336. function Add(const AName: TJSONStringType; AValue: TJSONStringType): Integer; overload;
  337. function Add(const AName: TJSONStringType; Avalue: Integer): Integer; overload;
  338. function Add(const AName: TJSONStringType; Avalue: Int64): Integer; overload;
  339. function Add(const AName: TJSONStringType): Integer; overload;
  340. function Add(const AName: TJSONStringType; AValue : TJSONArray): Integer; overload;
  341. procedure Delete(Index : Integer);
  342. procedure Remove(Item : TJSONData);
  343. // Easy access properties.
  344. property Names[Index : Integer] : TJSONStringType read GetNameOf;
  345. property Elements[AName: string] : TJSONData read GetElements write SetElements; default;
  346. Property Types[AName : String] : TJSONType Read GetTypes;
  347. Property Nulls[AName : String] : Boolean Read GetIsNull Write SetIsNull;
  348. Property Floats[AName : String] : TJSONFloat Read GetFloats Write SetFloats;
  349. Property Integers[AName : String] : Integer Read GetIntegers Write SetIntegers;
  350. Property Int64s[AName : String] : Int64 Read GetInt64s Write SetInt64s;
  351. Property Strings[AName : String] : TJSONStringType Read GetStrings Write SetStrings;
  352. Property Booleans[AName : String] : Boolean Read GetBooleans Write SetBooleans;
  353. Property Arrays[AName : String] : TJSONArray Read GetArrays Write SetArrays;
  354. Property Objects[AName : String] : TJSONObject Read GetObjects Write SetObjects;
  355. end;
  356. EJSON = Class(Exception);
  357. Function StringToJSONString(S : TJSONStringType) : TJSONStringType;
  358. Function JSONStringToString(S : TJSONStringType) : TJSONStringType;
  359. implementation
  360. Resourcestring
  361. SErrCannotConvertFromNull = 'Cannot convert data from Null value';
  362. SErrCannotConvertToNull = 'Cannot convert data to Null value';
  363. SErrCannotConvertFromArray = 'Cannot convert data from array value';
  364. SErrCannotConvertToArray = 'Cannot convert data to array value';
  365. SErrCannotConvertFromObject = 'Cannot convert data from object value';
  366. SErrCannotConvertToObject = 'Cannot convert data to object value';
  367. SErrInvalidFloat = 'Invalid float value : %s';
  368. SErrInvalidInteger = 'Invalid float value : %s';
  369. SErrCannotSetNotIsNull = 'IsNull cannot be set to False';
  370. SErrCannotAddArrayTwice = 'Adding an array object to an array twice is not allowed';
  371. SErrCannotAddObjectTwice = 'Adding an object to an array twice is not allowed';
  372. SErrUnknownTypeInConstructor = 'Unknown type in JSON%s constructor: %d';
  373. SErrNotJSONData = 'Cannot add object of type %s to TJSON%s';
  374. SErrPointerNotNil = 'Cannot add non-nil pointer to JSON%s';
  375. SErrOddNumber = 'TJSONObject must be constructed with name,value pairs';
  376. SErrNameMustBeString = 'TJSONObject constructor element name at pos %d is not a string';
  377. Function StringToJSONString(S : TJSONStringType) : TJSONStringType;
  378. Var
  379. I,J,L : Integer;
  380. P : PJSONCharType;
  381. begin
  382. I:=1;
  383. J:=1;
  384. Result:='';
  385. L:=Length(S);
  386. P:=PJSONCharType(S);
  387. While I<=L do
  388. begin
  389. if (AnsiChar(P^) in ['"','/','\',#8,#9,#10,#12,#13]) then
  390. begin
  391. Result:=Result+Copy(S,J,I-J);
  392. Case P^ of
  393. '\' : Result:=Result+'\\';
  394. '/' : Result:=Result+'\/';
  395. '"' : Result:=Result+'\"';
  396. #8 : Result:=Result+'\b';
  397. #9 : Result:=Result+'\t';
  398. #10 : Result:=Result+'\n';
  399. #12 : Result:=Result+'\f';
  400. #13 : Result:=Result+'\r';
  401. end;
  402. J:=I+1;
  403. end;
  404. Inc(I);
  405. Inc(P);
  406. end;
  407. Result:=Result+Copy(S,J,I-1);
  408. end;
  409. Function JSONStringToString(S : TJSONStringType) : TJSONStringType;
  410. Var
  411. I,J,L : Integer;
  412. P : PJSONCharType;
  413. w : String;
  414. begin
  415. I:=1;
  416. J:=1;
  417. L:=Length(S);
  418. Result:='';
  419. P:=PJSONCharType(S);
  420. While (I<=L) do
  421. begin
  422. if (P^='\') then
  423. begin
  424. Result:=Result+Copy(S,J,I-J);
  425. Inc(P);
  426. If (P^<>#0) then
  427. begin
  428. Inc(I);
  429. Case AnsiChar(P^) of
  430. '\','"','/'
  431. : Result:=Result+P^;
  432. 'b' : Result:=Result+#8;
  433. 't' : Result:=Result+#9;
  434. 'n' : Result:=Result+#10;
  435. 'f' : Result:=Result+#12;
  436. 'r' : Result:=Result+#13;
  437. 'u' : begin
  438. W:=Copy(S,I+1,4);
  439. Inc(I,4);
  440. Inc(P,4);
  441. Result:=Result+WideChar(StrToInt('$'+W));
  442. end;
  443. end;
  444. end;
  445. J:=I+1;
  446. end;
  447. Inc(I);
  448. Inc(P);
  449. end;
  450. Result:=Result+Copy(S,J,I-J+1);
  451. end;
  452. { TJSONData }
  453. function TJSONData.GetItem(Index : Integer): TJSONData;
  454. begin
  455. Result:=nil;
  456. end;
  457. function TJSONData.GetCount: Integer;
  458. begin
  459. Result:=0;
  460. end;
  461. constructor TJSONData.Create;
  462. begin
  463. Clear;
  464. end;
  465. function TJSONData.GetIsNull: Boolean;
  466. begin
  467. Result:=False;
  468. end;
  469. class function TJSONData.JSONType: TJSONType;
  470. begin
  471. JSONType:=jtUnknown;
  472. end;
  473. procedure TJSONData.SetItem(Index : Integer; const AValue:
  474. TJSONData);
  475. begin
  476. // Do Nothing
  477. end;
  478. { TJSONnumber }
  479. class function TJSONnumber.JSONType: TJSONType;
  480. begin
  481. Result:=jtNumber;
  482. end;
  483. { TJSONstring }
  484. class function TJSONstring.JSONType: TJSONType;
  485. begin
  486. Result:=jtString;
  487. end;
  488. procedure TJSONString.Clear;
  489. begin
  490. FValue:='';
  491. end;
  492. function TJSONstring.GetValue: Variant;
  493. begin
  494. Result:=FValue;
  495. end;
  496. procedure TJSONstring.SetValue(const AValue: Variant);
  497. begin
  498. FValue:=AValue;
  499. end;
  500. function TJSONstring.GetAsBoolean: Boolean;
  501. begin
  502. Result:=StrToBool(FValue);
  503. end;
  504. function TJSONstring.GetAsFloat: TJSONFloat;
  505. Var
  506. C : Integer;
  507. begin
  508. Val(FValue,Result,C);
  509. If (C<>0) then
  510. If Not TryStrToFloat(FValue,Result) then
  511. Raise EConvertError.CreateFmt(SErrInvalidFloat,[FValue]);
  512. end;
  513. function TJSONstring.GetAsInteger: Integer;
  514. begin
  515. Result:=StrToInt(FValue);
  516. end;
  517. function TJSONstring.GetAsInt64: Int64;
  518. begin
  519. Result:=StrToInt64(FValue);
  520. end;
  521. procedure TJSONstring.SetAsBoolean(const AValue: Boolean);
  522. begin
  523. FValue:=BoolToStr(AValue);
  524. end;
  525. procedure TJSONstring.SetAsFloat(const AValue: TJSONFloat);
  526. begin
  527. FValue:=FloatToStr(AValue);
  528. end;
  529. procedure TJSONstring.SetAsInteger(const AValue: Integer);
  530. begin
  531. FValue:=IntToStr(AValue);
  532. end;
  533. procedure TJSONstring.SetAsInt64(const AValue: Int64);
  534. begin
  535. FValue:=IntToStr(AValue);
  536. end;
  537. function TJSONstring.GetAsJSON: TJSONStringType;
  538. begin
  539. Result:='"'+StringToJSONString(FValue)+'"';
  540. end;
  541. function TJSONstring.GetAsString: TJSONStringType;
  542. begin
  543. Result:=FValue;
  544. end;
  545. procedure TJSONstring.SetAsString(const AValue: TJSONStringType);
  546. begin
  547. FValue:=AValue;
  548. end;
  549. constructor TJSONstring.Create(AValue: TJSONStringType);
  550. begin
  551. FValue:=AValue;
  552. end;
  553. { TJSONboolean }
  554. function TJSONboolean.GetValue: Variant;
  555. begin
  556. Result:=FValue;
  557. end;
  558. class function TJSONboolean.JSONType: TJSONType;
  559. begin
  560. Result:=jtBoolean;
  561. end;
  562. procedure TJSONBoolean.Clear;
  563. begin
  564. FValue:=False;
  565. end;
  566. procedure TJSONboolean.SetValue(const AValue: Variant);
  567. begin
  568. FValue:=boolean(AValue);
  569. end;
  570. function TJSONboolean.GetAsBoolean: Boolean;
  571. begin
  572. Result:=FValue;
  573. end;
  574. function TJSONboolean.GetAsFloat: TJSONFloat;
  575. begin
  576. Result:=Ord(FValue);
  577. end;
  578. function TJSONboolean.GetAsInteger: Integer;
  579. begin
  580. Result:=Ord(FValue);
  581. end;
  582. function TJSONboolean.GetAsInt64: Int64;
  583. begin
  584. Result:=Ord(FValue);
  585. end;
  586. procedure TJSONboolean.SetAsBoolean(const AValue: Boolean);
  587. begin
  588. FValue:=AValue;
  589. end;
  590. procedure TJSONboolean.SetAsFloat(const AValue: TJSONFloat);
  591. begin
  592. FValue:=(AValue<>0)
  593. end;
  594. procedure TJSONboolean.SetAsInteger(const AValue: Integer);
  595. begin
  596. FValue:=(AValue<>0)
  597. end;
  598. procedure TJSONboolean.SetAsInt64(const AValue: Int64);
  599. begin
  600. FValue:=(AValue<>0)
  601. end;
  602. function TJSONboolean.GetAsJSON: TJSONStringType;
  603. begin
  604. If FValue then
  605. Result:='True'
  606. else
  607. Result:='False';
  608. end;
  609. function TJSONboolean.GetAsString: TJSONStringType;
  610. begin
  611. Result:=BoolToStr(FValue);
  612. end;
  613. procedure TJSONboolean.SetAsString(const AValue: TJSONStringType);
  614. begin
  615. FValue:=StrToBool(AValue);
  616. end;
  617. constructor TJSONboolean.Create(AValue: Boolean);
  618. begin
  619. FValue:=AValue;
  620. end;
  621. { TJSONnull }
  622. procedure TJSONnull.Converterror(From : Boolean);
  623. begin
  624. If From then
  625. Raise EJSON.Create(SErrCannotConvertFromNull)
  626. else
  627. Raise EJSON.Create(SErrCannotConvertToNull);
  628. end;
  629. {$warnings off}
  630. function TJSONnull.GetAsBoolean: Boolean;
  631. begin
  632. ConvertError(True);
  633. end;
  634. function TJSONnull.GetAsFloat: TJSONFloat;
  635. begin
  636. ConvertError(True);
  637. end;
  638. function TJSONnull.GetAsInteger: Integer;
  639. begin
  640. ConvertError(True);
  641. end;
  642. function TJSONnull.GetAsInt64: Int64;
  643. begin
  644. ConvertError(True);
  645. end;
  646. function TJSONnull.GetIsNull: Boolean;
  647. begin
  648. Result:=True;
  649. end;
  650. procedure TJSONnull.SetAsBoolean(const AValue: Boolean);
  651. begin
  652. ConvertError(False);
  653. end;
  654. procedure TJSONnull.SetAsFloat(const AValue: TJSONFloat);
  655. begin
  656. ConvertError(False);
  657. end;
  658. procedure TJSONnull.SetAsInteger(const AValue: Integer);
  659. begin
  660. ConvertError(False);
  661. end;
  662. procedure TJSONnull.SetAsInt64(const AValue: Int64);
  663. begin
  664. ConvertError(False);
  665. end;
  666. function TJSONnull.GetAsJSON: TJSONStringType;
  667. begin
  668. Result:='Null';
  669. end;
  670. function TJSONnull.GetAsString: TJSONStringType;
  671. begin
  672. ConvertError(True);
  673. end;
  674. procedure TJSONnull.SetAsString(const AValue: TJSONStringType);
  675. begin
  676. ConvertError(True);
  677. end;
  678. function TJSONnull.GetValue: Variant;
  679. begin
  680. Result:=variants.Null;
  681. end;
  682. procedure TJSONnull.SetValue(const AValue: variant);
  683. begin
  684. ConvertError(False);
  685. end;
  686. class function TJSONnull.JSONType: TJSONType;
  687. begin
  688. Result:=jtNull;
  689. end;
  690. procedure TJSONNull.Clear;
  691. begin
  692. // Do nothing
  693. end;
  694. {$warnings on}
  695. { TJSONFloatNumber }
  696. function TJSONFloatNumber.GetAsBoolean: Boolean;
  697. begin
  698. Result:=(FValue<>0);
  699. end;
  700. function TJSONFloatNumber.GetAsFloat: TJSONFloat;
  701. begin
  702. Result:=FValue;
  703. end;
  704. function TJSONFloatNumber.GetAsInteger: Integer;
  705. begin
  706. Result:=Round(FValue);
  707. end;
  708. function TJSONFloatNumber.GetAsInt64: Int64;
  709. begin
  710. Result:=Round(FValue);
  711. end;
  712. procedure TJSONFloatNumber.SetAsBoolean(const AValue: Boolean);
  713. begin
  714. FValue:=Ord(AValue);
  715. end;
  716. procedure TJSONFloatNumber.SetAsFloat(const AValue: TJSONFloat);
  717. begin
  718. FValue:=AValue;
  719. end;
  720. procedure TJSONFloatNumber.SetAsInteger(const AValue: Integer);
  721. begin
  722. FValue:=AValue;
  723. end;
  724. procedure TJSONFloatNumber.SetAsInt64(const AValue: Int64);
  725. begin
  726. FValue:=AValue;
  727. end;
  728. function TJSONFloatNumber.GetAsJSON: TJSONStringType;
  729. begin
  730. Result:=AsString;
  731. end;
  732. function TJSONFloatNumber.GetAsString: TJSONStringType;
  733. begin
  734. Str(FValue,Result);
  735. end;
  736. procedure TJSONFloatNumber.SetAsString(const AValue: TJSONStringType);
  737. Var
  738. C : Integer;
  739. begin
  740. Val(AValue,FValue,C);
  741. If (C<>0) then
  742. Raise EConvertError.CreateFmt(SErrInvalidFloat,[AValue]);
  743. end;
  744. function TJSONFloatNumber.GetValue: variant;
  745. begin
  746. Result:=FValue;
  747. end;
  748. procedure TJSONFloatNumber.SetValue(const AValue: variant);
  749. begin
  750. FValue:=AValue;
  751. end;
  752. constructor TJSONFloatNumber.Create(AValue: TJSONFloat);
  753. begin
  754. FValue:=AValue;
  755. end;
  756. class function TJSONFloatNumber.NumberType: TJSONNumberType;
  757. begin
  758. Result:=ntFloat;
  759. end;
  760. procedure TJSONFloatNumber.Clear;
  761. begin
  762. FValue:=0;
  763. end;
  764. { TJSONIntegerNumber }
  765. function TJSONIntegerNumber.GetAsBoolean: Boolean;
  766. begin
  767. Result:=FValue<>0;
  768. end;
  769. function TJSONIntegerNumber.GetAsFloat: TJSONFloat;
  770. begin
  771. Result:=Ord(FValue);
  772. end;
  773. function TJSONIntegerNumber.GetAsInteger: Integer;
  774. begin
  775. Result:=FValue;
  776. end;
  777. function TJSONIntegerNumber.GetAsInt64: Int64;
  778. begin
  779. Result:=FValue;
  780. end;
  781. procedure TJSONIntegerNumber.SetAsBoolean(const AValue: Boolean);
  782. begin
  783. FValue:=Ord(AValue);
  784. end;
  785. procedure TJSONIntegerNumber.SetAsFloat(const AValue: TJSONFloat);
  786. begin
  787. FValue:=Round(AValue);
  788. end;
  789. procedure TJSONIntegerNumber.SetAsInteger(const AValue: Integer);
  790. begin
  791. FValue:=AValue;
  792. end;
  793. procedure TJSONIntegerNumber.SetAsInt64(const AValue: Int64);
  794. begin
  795. FValue:=AValue;
  796. end;
  797. function TJSONIntegerNumber.GetAsJSON: TJSONStringType;
  798. begin
  799. Result:=AsString;
  800. end;
  801. function TJSONIntegerNumber.GetAsString: TJSONStringType;
  802. begin
  803. Result:=IntToStr(FValue)
  804. end;
  805. procedure TJSONIntegerNumber.SetAsString(const AValue: TJSONStringType);
  806. begin
  807. FValue:=StrToInt(AValue);
  808. end;
  809. function TJSONIntegerNumber.GetValue: variant;
  810. begin
  811. Result:=FValue;
  812. end;
  813. procedure TJSONIntegerNumber.SetValue(const AValue: variant);
  814. begin
  815. FValue:=AValue;
  816. end;
  817. constructor TJSONIntegerNumber.Create(AValue: Integer);
  818. begin
  819. FValue:=AValue;
  820. end;
  821. class function TJSONIntegerNumber.NumberType: TJSONNumberType;
  822. begin
  823. Result:=ntInteger;
  824. end;
  825. procedure TJSONIntegerNumber.Clear;
  826. begin
  827. FValue:=0;
  828. end;
  829. { TJSONInt64Number }
  830. function TJSONInt64Number.GetAsInt64: Int64;
  831. begin
  832. Result := FValue;
  833. end;
  834. procedure TJSONInt64Number.SetAsInt64(const AValue: Int64);
  835. begin
  836. FValue := AValue;
  837. end;
  838. function TJSONInt64Number.GetAsBoolean: Boolean;
  839. begin
  840. Result:=FValue<>0;
  841. end;
  842. function TJSONInt64Number.GetAsFloat: TJSONFloat;
  843. begin
  844. Result:= FValue;
  845. end;
  846. function TJSONInt64Number.GetAsInteger: Integer;
  847. begin
  848. Result := FValue;
  849. end;
  850. procedure TJSONInt64Number.SetAsBoolean(const AValue: Boolean);
  851. begin
  852. FValue:=Ord(AValue);
  853. end;
  854. procedure TJSONInt64Number.SetAsFloat(const AValue: TJSONFloat);
  855. begin
  856. FValue:=Round(AValue);
  857. end;
  858. procedure TJSONInt64Number.SetAsInteger(const AValue: Integer);
  859. begin
  860. FValue:=AValue;
  861. end;
  862. function TJSONInt64Number.GetAsJSON: TJSONStringType;
  863. begin
  864. Result:=AsString;
  865. end;
  866. function TJSONInt64Number.GetAsString: TJSONStringType;
  867. begin
  868. Result:=IntToStr(FValue)
  869. end;
  870. procedure TJSONInt64Number.SetAsString(const AValue: TJSONStringType);
  871. begin
  872. FValue:=StrToInt64(AValue);
  873. end;
  874. function TJSONInt64Number.GetValue: variant;
  875. begin
  876. Result:=FValue;
  877. end;
  878. procedure TJSONInt64Number.SetValue(const AValue: variant);
  879. begin
  880. FValue:=AValue;
  881. end;
  882. constructor TJSONInt64Number.Create(AValue: Int64);
  883. begin
  884. FValue := AValue;
  885. end;
  886. class function TJSONInt64Number.NumberType: TJSONNumberType;
  887. begin
  888. Result:=ntInt64;
  889. end;
  890. procedure TJSONInt64Number.Clear;
  891. begin
  892. FValue:=0;
  893. end;
  894. { TJSONArray }
  895. function TJSONArray.GetBooleans(Index : Integer): Boolean;
  896. begin
  897. Result:=Items[Index].AsBoolean;
  898. end;
  899. function TJSONArray.GetArrays(Index : Integer): TJSONArray;
  900. begin
  901. Result:=Items[Index] as TJSONArray;
  902. end;
  903. function TJSONArray.GetFloats(Index : Integer): TJSONFloat;
  904. begin
  905. Result:=Items[Index].AsFloat;
  906. end;
  907. function TJSONArray.GetIntegers(Index : Integer): Integer;
  908. begin
  909. Result:=Items[Index].AsInteger;
  910. end;
  911. function TJSONArray.GetInt64s(Index : Integer): Int64;
  912. begin
  913. Result:=Items[Index].AsInt64;
  914. end;
  915. function TJSONArray.GetNulls(Index : Integer): Boolean;
  916. begin
  917. Result:=Items[Index].IsNull;
  918. end;
  919. function TJSONArray.GetObjects(Index : Integer): TJSONObject;
  920. begin
  921. Result:=Items[Index] as TJSONObject;
  922. end;
  923. function TJSONArray.GetStrings(Index : Integer): TJSONStringType;
  924. begin
  925. Result:=Items[Index].AsString;
  926. end;
  927. function TJSONArray.GetTypes(Index : Integer): TJSONType;
  928. begin
  929. Result:=Items[Index].JSONType;
  930. end;
  931. procedure TJSONArray.SetArrays(Index : Integer; const AValue: TJSONArray);
  932. begin
  933. Items[Index]:=AValue;
  934. end;
  935. procedure TJSONArray.SetBooleans(Index : Integer; const AValue: Boolean);
  936. begin
  937. Items[Index]:=TJSonBoolean.Create(AValue);
  938. end;
  939. procedure TJSONArray.SetFloats(Index : Integer; const AValue: TJSONFloat);
  940. begin
  941. Items[Index]:=TJSONFloatNumber.Create(AValue);
  942. end;
  943. procedure TJSONArray.SetIntegers(Index : Integer; const AValue: Integer);
  944. begin
  945. Items[Index]:=TJSONIntegerNumber.Create(AValue);
  946. end;
  947. procedure TJSONArray.SetInt64s(Index : Integer; const AValue: Int64);
  948. begin
  949. Items[Index]:=TJSONInt64Number.Create(AValue);
  950. end;
  951. procedure TJSONArray.SetObjects(Index : Integer; const AValue: TJSONObject);
  952. begin
  953. Items[Index]:=AValue;
  954. end;
  955. procedure TJSONArray.SetStrings(Index : Integer; const AValue: TJSONStringType);
  956. begin
  957. Items[Index]:=TJSONString.Create(AValue);
  958. end;
  959. procedure TJSONArray.Converterror(From: Boolean);
  960. begin
  961. If From then
  962. Raise EJSON.Create(SErrCannotConvertFromArray)
  963. else
  964. Raise EJSON.Create(SErrCannotConvertToArray);
  965. end;
  966. {$warnings off}
  967. function TJSONArray.GetAsBoolean: Boolean;
  968. begin
  969. ConvertError(True);
  970. end;
  971. function TJSONArray.GetAsFloat: TJSONFloat;
  972. begin
  973. ConvertError(True);
  974. end;
  975. function TJSONArray.GetAsInteger: Integer;
  976. begin
  977. ConvertError(True);
  978. end;
  979. function TJSONArray.GetAsInt64: Int64;
  980. begin
  981. ConvertError(True);
  982. end;
  983. procedure TJSONArray.SetAsBoolean(const AValue: Boolean);
  984. begin
  985. ConvertError(False);
  986. end;
  987. procedure TJSONArray.SetAsFloat(const AValue: TJSONFloat);
  988. begin
  989. ConvertError(False);
  990. end;
  991. procedure TJSONArray.SetAsInteger(const AValue: Integer);
  992. begin
  993. ConvertError(False);
  994. end;
  995. procedure TJSONArray.SetAsInt64(const AValue: Int64);
  996. begin
  997. ConvertError(False);
  998. end;
  999. {$warnings on}
  1000. function TJSONArray.GetAsJSON: TJSONStringType;
  1001. Var
  1002. I : Integer;
  1003. begin
  1004. Result:='[';
  1005. For I:=0 to Count-1 do
  1006. begin
  1007. Result:=Result+Items[i].AsJSON;
  1008. If (I<Count-1) then
  1009. Result:=Result+', '
  1010. end;
  1011. Result:=Result+']';
  1012. end;
  1013. {$warnings off}
  1014. function TJSONArray.GetAsString: TJSONStringType;
  1015. begin
  1016. ConvertError(True);
  1017. end;
  1018. procedure TJSONArray.SetAsString(const AValue: TJSONStringType);
  1019. begin
  1020. ConvertError(False);
  1021. end;
  1022. function TJSONArray.GetValue: variant;
  1023. begin
  1024. ConvertError(True);
  1025. end;
  1026. procedure TJSONArray.SetValue(const AValue: variant);
  1027. begin
  1028. ConvertError(False);
  1029. end;
  1030. {$warnings on}
  1031. function TJSONArray.GetCount: Integer;
  1032. begin
  1033. Result:=Flist.Count;
  1034. end;
  1035. function TJSONArray.GetItem(Index: Integer): TJSONData;
  1036. begin
  1037. Result:=FList[Index] as TJSONData;
  1038. end;
  1039. procedure TJSONArray.SetItem(Index: Integer; const AValue: TJSONData);
  1040. begin
  1041. If (Index=FList.Count) then
  1042. FList.Add(AValue)
  1043. else
  1044. FList[Index]:=AValue;
  1045. end;
  1046. constructor TJSONArray.Create;
  1047. begin
  1048. Flist:=TFPObjectList.Create(True);
  1049. end;
  1050. Function VarRecToJSON(Const Element : TVarRec; SourceType : String) : TJSONData;
  1051. begin
  1052. Result:=Nil;
  1053. With Element do
  1054. case VType of
  1055. vtInteger : Result:=TJSONIntegerNumber.Create(VInteger);
  1056. vtBoolean : Result:=TJSONBoolean.Create(VBoolean);
  1057. vtChar : Result:=TJSONString.Create(VChar);
  1058. vtExtended : Result:=TJSONFloatNumber.Create(VExtended^);
  1059. vtString : Result:=TJSONString.Create(vString^);
  1060. vtAnsiString : Result:=TJSONString.Create(AnsiString(vAnsiString));
  1061. vtPChar : Result:=TJSONString.Create(StrPas(VPChar));
  1062. vtPointer : If (VPointer<>Nil) then
  1063. Raise EJSON.CreateFmt(SErrPointerNotNil,[SourceType])
  1064. else
  1065. Result:=TJSONNull.Create;
  1066. vtCurrency : Result:=TJSONFloatNumber.Create(vCurrency^);
  1067. vtInt64 : Result:=TJSONInt64Number.Create(vInt64^);
  1068. vtObject : if (VObject is TJSONData) then
  1069. Result:=TJSONData(VObject)
  1070. else
  1071. Raise EJSON.CreateFmt(SErrNotJSONData,[SourceType,VObject.ClassName]);
  1072. //vtVariant :
  1073. else
  1074. Raise EJSON.CreateFmt(SErrUnknownTypeInConstructor,[SourceType,VType])
  1075. end;
  1076. end;
  1077. constructor TJSONArray.Create(Const Elements: array of const);
  1078. Var
  1079. I : integer;
  1080. J : TJSONData;
  1081. begin
  1082. Create;
  1083. For I:=Low(Elements) to High(Elements) do
  1084. begin
  1085. J:=VarRecToJSON(Elements[i],'Array');
  1086. Add(J);
  1087. end;
  1088. end;
  1089. Destructor TJSONArray.Destroy;
  1090. begin
  1091. FreeAndNil(FList);
  1092. inherited Destroy;
  1093. end;
  1094. class function TJSONArray.JSONType: TJSONType;
  1095. begin
  1096. Result:=jtArray;
  1097. end;
  1098. procedure TJSONArray.Iterate(Iterator: TJSONArrayIterator; Data: TObject);
  1099. Var
  1100. I : Integer;
  1101. Cont : Boolean;
  1102. begin
  1103. I:=0;
  1104. Cont:=True;
  1105. While (I<FList.Count) and cont do
  1106. begin
  1107. Iterator(Items[i],Data,Cont);
  1108. Inc(I);
  1109. end;
  1110. end;
  1111. function TJSONArray.IndexOf(obj: TJSONData): Integer;
  1112. begin
  1113. Result:=FList.IndexOf(Obj);
  1114. end;
  1115. procedure TJSONArray.Clear;
  1116. begin
  1117. FList.Clear;
  1118. end;
  1119. function TJSONArray.Add(Item: TJSONData): Integer;
  1120. begin
  1121. Result:=FList.Add(Item);
  1122. end;
  1123. function TJSONArray.Add(I: Integer): Integer;
  1124. begin
  1125. Result:=Add(TJSONIntegerNumber.Create(I));
  1126. end;
  1127. function TJSONArray.Add(I: Int64): Int64;
  1128. begin
  1129. Result:=Add(TJSONInt64Number.Create(I));
  1130. end;
  1131. function TJSONArray.Add(S: String): Integer;
  1132. begin
  1133. Result:=Add(TJSONString.Create(S));
  1134. end;
  1135. function TJSONArray.Add: Integer;
  1136. begin
  1137. Result:=Add(TJSONNull.Create);
  1138. end;
  1139. function TJSONArray.Add(F: TJSONFloat): Integer;
  1140. begin
  1141. Result:=Add(TJSONFloatNumber.Create(F));
  1142. end;
  1143. function TJSONArray.Add(B: Boolean): Integer;
  1144. begin
  1145. Result:=Add(TJSONBoolean.Create(B));
  1146. end;
  1147. function TJSONArray.Add(AnArray: TJSONArray): Integer;
  1148. begin
  1149. If (IndexOf(AnArray)<>-1) then
  1150. Raise EJSON.Create(SErrCannotAddArrayTwice);
  1151. Result:=Add(TJSONData(AnArray));
  1152. end;
  1153. function TJSONArray.Add(AnObject: TJSONObject): Integer;
  1154. begin
  1155. If (IndexOf(AnObject)<>-1) then
  1156. Raise EJSON.Create(SErrCannotAddObjectTwice);
  1157. Result:=Add(TJSONData(AnObject));
  1158. end;
  1159. procedure TJSONArray.Delete(Index: Integer);
  1160. begin
  1161. FList.Delete(Index);
  1162. end;
  1163. procedure TJSONArray.Remove(Item: TJSONData);
  1164. begin
  1165. FList.Remove(Item);
  1166. end;
  1167. { TJSONObject }
  1168. function TJSONObject.GetArrays(AName : String): TJSONArray;
  1169. begin
  1170. Result:=GetElements(AName) as TJSONArray;
  1171. end;
  1172. function TJSONObject.GetBooleans(AName : String): Boolean;
  1173. begin
  1174. Result:=GetElements(AName).AsBoolean;
  1175. end;
  1176. function TJSONObject.GetElements(AName: string): TJSONData;
  1177. begin
  1178. Result:=TJSONData(FHash.Find(AName));
  1179. end;
  1180. function TJSONObject.GetFloats(AName : String): TJSONFloat;
  1181. begin
  1182. Result:=GetElements(AName).AsFloat;
  1183. end;
  1184. function TJSONObject.GetIntegers(AName : String): Integer;
  1185. begin
  1186. Result:=GetElements(AName).AsInteger;
  1187. end;
  1188. function TJSONObject.GetInt64s(AName : String): Int64;
  1189. begin
  1190. Result:=GetElements(AName).AsInt64;
  1191. end;
  1192. function TJSONObject.GetIsNull(AName : String): Boolean;
  1193. begin
  1194. Result:=GetElements(AName).IsNull;
  1195. end;
  1196. function TJSONObject.GetNameOf(Index: Integer): TJSONStringType;
  1197. begin
  1198. Result:=FHash.NameOfIndex(Index);
  1199. end;
  1200. function TJSONObject.GetObjects(AName : String): TJSONObject;
  1201. begin
  1202. Result:=GetElements(AName) as TJSONObject;
  1203. end;
  1204. function TJSONObject.GetStrings(AName : String): TJSONStringType;
  1205. begin
  1206. Result:=GetElements(AName).AsString;
  1207. end;
  1208. function TJSONObject.GetTypes(AName : String): TJSONType;
  1209. begin
  1210. Result:=Getelements(Aname).JSONType;
  1211. end;
  1212. procedure TJSONObject.SetArrays(AName : String; const AValue: TJSONArray);
  1213. begin
  1214. SetElements(AName,AVAlue);
  1215. end;
  1216. procedure TJSONObject.SetBooleans(AName : String; const AValue: Boolean);
  1217. begin
  1218. SetElements(AName,TJSONBoolean.Create(AVAlue));
  1219. end;
  1220. procedure TJSONObject.SetElements(AName: string; const AValue: TJSONData);
  1221. Var
  1222. Index : Integer;
  1223. begin
  1224. Index:=FHash.FindIndexOf(AName);
  1225. If (Index=-1) then
  1226. FHash.Add(AName,AValue)
  1227. else
  1228. FHash.Items[Index]:=AValue; // Will free the previous value.
  1229. end;
  1230. procedure TJSONObject.SetFloats(AName : String; const AValue: TJSONFloat);
  1231. begin
  1232. SetElements(AName,TJSONFloatNumber.Create(AVAlue));
  1233. end;
  1234. procedure TJSONObject.SetIntegers(AName : String; const AValue: Integer);
  1235. begin
  1236. SetElements(AName,TJSONIntegerNumber.Create(AVAlue));
  1237. end;
  1238. procedure TJSONObject.SetInt64s(AName : String; const AValue: Int64);
  1239. begin
  1240. SetElements(AName,TJSONInt64Number.Create(AVAlue));
  1241. end;
  1242. procedure TJSONObject.SetIsNull(AName : String; const AValue: Boolean);
  1243. begin
  1244. If Not AValue then
  1245. Raise EJSON.Create(SErrCannotSetNotIsNull);
  1246. SetElements(AName,TJSONNull.Create);
  1247. end;
  1248. procedure TJSONObject.SetObjects(AName : String; const AValue: TJSONObject);
  1249. begin
  1250. SetElements(AName,AValue);
  1251. end;
  1252. procedure TJSONObject.SetStrings(AName : String; const AValue: TJSONStringType);
  1253. begin
  1254. SetElements(AName,TJSONString.Create(AVAlue));
  1255. end;
  1256. procedure TJSONObject.Converterror(From: Boolean);
  1257. begin
  1258. If From then
  1259. Raise EJSON.Create(SErrCannotConvertFromObject)
  1260. else
  1261. Raise EJSON.Create(SErrCannotConvertToObject);
  1262. end;
  1263. {$warnings off}
  1264. function TJSONObject.GetAsBoolean: Boolean;
  1265. begin
  1266. ConvertError(True);
  1267. end;
  1268. function TJSONObject.GetAsFloat: TJSONFloat;
  1269. begin
  1270. ConvertError(True);
  1271. end;
  1272. function TJSONObject.GetAsInteger: Integer;
  1273. begin
  1274. ConvertError(True);
  1275. end;
  1276. function TJSONObject.GetAsInt64: Int64;
  1277. begin
  1278. ConvertError(True);
  1279. end;
  1280. procedure TJSONObject.SetAsBoolean(const AValue: Boolean);
  1281. begin
  1282. ConvertError(False);
  1283. end;
  1284. procedure TJSONObject.SetAsFloat(const AValue: TJSONFloat);
  1285. begin
  1286. ConvertError(False);
  1287. end;
  1288. procedure TJSONObject.SetAsInteger(const AValue: Integer);
  1289. begin
  1290. ConvertError(False);
  1291. end;
  1292. procedure TJSONObject.SetAsInt64(const AValue: Int64);
  1293. begin
  1294. ConvertError(False);
  1295. end;
  1296. {$warnings on}
  1297. function TJSONObject.GetAsJSON: TJSONStringType;
  1298. Var
  1299. I : Integer;
  1300. begin
  1301. Result:='';
  1302. For I:=0 to Count-1 do
  1303. begin
  1304. If (Result<>'') then
  1305. Result:=Result+', ';
  1306. Result:=Result+'"'+StringToJSONString(Names[i])+'" : '+Items[I].AsJSON;
  1307. end;
  1308. If (Result<>'') then
  1309. Result:='{ '+Result+' }'
  1310. else
  1311. Result:='{}';
  1312. end;
  1313. {$warnings off}
  1314. function TJSONObject.GetAsString: TJSONStringType;
  1315. begin
  1316. ConvertError(True);
  1317. end;
  1318. procedure TJSONObject.SetAsString(const AValue: TJSONStringType);
  1319. begin
  1320. ConvertError(False);
  1321. end;
  1322. function TJSONObject.GetValue: variant;
  1323. begin
  1324. ConvertError(True);
  1325. end;
  1326. procedure TJSONObject.SetValue(const AValue: variant);
  1327. begin
  1328. ConvertError(False);
  1329. end;
  1330. {$warnings on}
  1331. function TJSONObject.GetCount: Integer;
  1332. begin
  1333. Result:=FHash.Count;
  1334. end;
  1335. function TJSONObject.GetItem(Index: Integer): TJSONData;
  1336. begin
  1337. Result:=TJSONData(FHash.Items[Index]);
  1338. end;
  1339. procedure TJSONObject.SetItem(Index: Integer; const AValue: TJSONData);
  1340. begin
  1341. FHash.Items[Index]:=AValue;
  1342. end;
  1343. constructor TJSONObject.Create;
  1344. begin
  1345. FHash:=TFPHashObjectList.Create(True);
  1346. end;
  1347. constructor TJSONObject.Create(const Elements: array of const);
  1348. Var
  1349. I : integer;
  1350. AName : String;
  1351. J : TJSONData;
  1352. begin
  1353. Create;
  1354. If ((High(Elements)-Low(Elements)) mod 2)=0 then
  1355. Raise EJSON.Create(SErrOddNumber);
  1356. I:=Low(Elements);
  1357. While I<=High(Elements) do
  1358. begin
  1359. With Elements[i] do
  1360. Case VType of
  1361. vtChar : AName:=VChar;
  1362. vtString : AName:=vString^;
  1363. vtAnsiString : AName:=(AnsiString(vAnsiString));
  1364. vtPChar : AName:=StrPas(VPChar);
  1365. else
  1366. Raise EJSON.CreateFmt(SErrNameMustBeString,[I+1]);
  1367. end;
  1368. If (ANAme='') then
  1369. Raise EJSON.CreateFmt(SErrNameMustBeString,[I+1]);
  1370. Inc(I);
  1371. J:=VarRecToJSON(Elements[i],'Object');
  1372. Add(AName,J);
  1373. Inc(I);
  1374. end;
  1375. end;
  1376. destructor TJSONObject.Destroy;
  1377. begin
  1378. FreeAndNil(FHash);
  1379. inherited Destroy;
  1380. end;
  1381. class function TJSONObject.JSONType: TJSONType;
  1382. begin
  1383. Result:=jtObject;
  1384. end;
  1385. procedure TJSONObject.Iterate(Iterator: TJSONObjectIterator; Data: TObject);
  1386. Var
  1387. I : Integer;
  1388. Cont : Boolean;
  1389. begin
  1390. I:=0;
  1391. Cont:=True;
  1392. While (I<FHash.Count) and cont do
  1393. begin
  1394. Iterator(Names[I],Items[i],Data,Cont);
  1395. Inc(I);
  1396. end;
  1397. end;
  1398. function TJSONObject.IndexOf(Item: TJSONData): Integer;
  1399. begin
  1400. Result:=FHash.IndexOf(Item);
  1401. end;
  1402. function TJSONObject.IndexOfName(const AName: TJSONStringType): Integer;
  1403. begin
  1404. Result:=FHash.FindIndexOf(AName);
  1405. end;
  1406. procedure TJSONObject.Clear;
  1407. begin
  1408. FHash.Clear;
  1409. end;
  1410. function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONData
  1411. ): Integer;
  1412. begin
  1413. Result:=FHash.Add(AName,AValue);
  1414. end;
  1415. function TJSONObject.Add(const AName: TJSONStringType; AValue: Boolean
  1416. ): Integer;
  1417. begin
  1418. Result:=Add(AName,TJSONBoolean.Create(AValue));
  1419. end;
  1420. function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer;
  1421. begin
  1422. Result:=Add(AName,TJSONFloatNumber.Create(AValue));
  1423. end;
  1424. function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONStringType): Integer;
  1425. begin
  1426. Result:=Add(AName,TJSONString.Create(AValue));
  1427. end;
  1428. function TJSONObject.Add(const AName: TJSONStringType; Avalue: Integer): Integer;
  1429. begin
  1430. Result:=Add(AName,TJSONIntegerNumber.Create(AValue));
  1431. end;
  1432. function TJSONObject.Add(const AName: TJSONStringType; Avalue: Int64): Integer;
  1433. begin
  1434. Result:=Add(AName,TJSONInt64Number.Create(AValue));
  1435. end;
  1436. function TJSONObject.Add(const AName: TJSONStringType): Integer;
  1437. begin
  1438. Result:=Add(AName,TJSONNull.Create);
  1439. end;
  1440. function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONArray
  1441. ): Integer;
  1442. begin
  1443. Result:=Add(AName,TJSONData(AValue));
  1444. end;
  1445. procedure TJSONObject.Delete(Index: Integer);
  1446. begin
  1447. FHash.Delete(Index);
  1448. end;
  1449. procedure TJSONObject.Remove(Item: TJSONData);
  1450. begin
  1451. FHash.Remove(Item);
  1452. end;
  1453. end.