McJSON.pas 45 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644
  1. (*****************************************************************************
  2. The MIT License (MIT)
  3. Copyright (c) 2021 HydroByte Software
  4. Permission is hereby granted, free of charge, to any person obtaining a copy
  5. of this software and associated documentation files (the "Software"), to deal
  6. in the Software without restriction, including without limitation the rights
  7. to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  8. copies of the Software, and to permit persons to whom the Software is
  9. furnished to do so, subject to the following conditions:
  10. The above copyright notice and this permission notice shall be included in all
  11. copies or substantial portions of the Software.
  12. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  13. IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  14. FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  15. AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  16. LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  17. OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
  18. SOFTWARE.
  19. *****************************************************************************)
  20. unit McJSON;
  21. interface
  22. uses
  23. Classes, SysUtils;
  24. type
  25. EMcJsonException = class(Exception);
  26. TJItemType = (jitUnset, jitValue, jitObject, jitArray);
  27. TJValueType = (jvtString, jvtNumber, jvtBoolean, jvtNull);
  28. TMcJsonItemEnumerator = class;
  29. TMcJsonItem = class
  30. private
  31. fType : TJItemType; // item type (value/object/array)
  32. fKey : string; // item name
  33. fValue : string; // value (if item type is value)
  34. fValType: TJValueType; // value type (text/number/boolean)
  35. fChild : TList; // child nodes (if item type is object/array)
  36. fSpeedUp: Boolean; // flag to speed up the parse task
  37. // property getters
  38. function fGetCount: Integer;
  39. function fGetKey(aIdx: Integer): string;
  40. function fGetType: TJItemType;
  41. function fGetItemByKey(const aKey: string): TMcJsonItem;
  42. function fGetItemByIdx(aIdx: Integer): TMcJsonItem;
  43. function fHasChild: Boolean;
  44. function fIsNull : Boolean;
  45. // AsSomething getters
  46. function fGetAsJSON : string ;
  47. function fGetAsObject : TMcJsonItem;
  48. function fGetAsArray : TMcJsonItem;
  49. function fGetAsInteger: Integer ;
  50. function fGetAsDouble : Double ;
  51. function fGetAsString : string ;
  52. function fGetAsBoolean: Boolean ;
  53. function fGetAsNull : string ;
  54. // property setters
  55. procedure fSetType(aType: TJItemType);
  56. // AsSomething setters.
  57. procedure fSetAsJSON (aValue: string );
  58. procedure fSetAsObject (aValue: TMcJsonItem);
  59. procedure fSetAsArray (aValue: TMcJsonItem);
  60. procedure fSetAsInteger(aValue: Integer );
  61. procedure fSetAsDouble (aValue: Double );
  62. procedure fSetAsString (aValue: string );
  63. procedure fSetAsBoolean(aValue: Boolean );
  64. procedure fSetAsNull (aValue: string );
  65. // string single-pass parser
  66. function parse(const aCode: string; aPos, aLen: Integer): Integer;
  67. // read methods used by parse
  68. function readString (const aCode: string; out aStr:string; aPos, aLen: Integer): Integer;
  69. function readChar (const aCode: string; aChar: Char; aPos, aLen: Integer): Integer;
  70. function readKeyword(const aCode, aKeyword: string; aPos, aLen: Integer): Integer;
  71. function readValue (const aCode: string; aPos, aLen: Integer): Integer;
  72. function readObject (const aCode: string; aPos, aLen: Integer): Integer;
  73. function readArray (const aCode: string; aPos, aLen: Integer): Integer;
  74. function readNumber (const aCode: string; aPos, aLen: Integer): Integer;
  75. function readBoolean(const aCode: string; aPos, aLen: Integer): Integer;
  76. function readNull (const aCode: string; aPos, aLen: Integer): Integer;
  77. // aux functions used in ToString
  78. function sFormat(aHuman: Boolean): string;
  79. function sFormatItem(aStrS: TStringStream; const aIn, aNL, aSp: string): string;
  80. function isIndexValid(aIdx: Integer): Boolean;
  81. public
  82. property Count : Integer read fGetCount;
  83. property Key : string read fKey;
  84. property Value : string read fValue;
  85. property ItemType: TJItemType read fGetType write fSetType;
  86. property Keys [aIdx : Integer]: string read fGetKey;
  87. property Items [aIdx : Integer]: TMcJsonItem read fGetItemByIdx;
  88. property Values[const aKey: string ]: TMcJsonItem read fGetItemByKey; default;
  89. property HasChild: Boolean read fHasChild;
  90. property IsNull : Boolean read fIsNull;
  91. property SpeedUp : Boolean read fSpeedUp write fSpeedUp;
  92. // AsSomething properties
  93. property AsJSON : string read fGetAsJSON write fSetAsJSON ;
  94. property AsObject : TMcJsonItem read fGetAsObject write fSetAsObject ;
  95. property AsArray : TMcJsonItem read fGetAsArray write fSetAsArray ;
  96. property AsInteger: Integer read fGetAsInteger write fSetAsInteger;
  97. property AsNumber : Double read fGetAsDouble write fSetAsDouble ;
  98. property AsString : string read fGetAsString write fSetAsString ;
  99. property AsBoolean: Boolean read fGetAsBoolean write fSetAsBoolean;
  100. property AsNull : string read fGetAsNull write fSetAsNull ;
  101. constructor Create; overload;
  102. constructor Create(aJItemType: TJItemType); overload;
  103. constructor Create(const aItem: TMcJsonItem); overload;
  104. constructor Create(const aCode: string); overload;
  105. destructor Destroy; override;
  106. procedure Clear;
  107. function IndexOf(const aKey: string): Integer; overload;
  108. function Path(const aPath: string): TMcJsonItem; overload;
  109. function Add(const aKey: string = ''): TMcJsonItem; overload;
  110. function Add(const aKey: string; aItemType: TJItemType): TMcJsonItem; overload;
  111. function Add(aItemType: TJItemType): TMcJsonItem; overload;
  112. function Add(const aItem: TMcJsonItem): TMcJsonItem; overload;
  113. function Copy(const aItem: TMcJsonItem): TMcJsonItem; overload;
  114. function Clone: TMcJsonItem; overload;
  115. function Insert(const aKey: string; aIdx: Integer): TMcJsonItem; overload;
  116. function Insert(const aItem: TMcJsonItem; aIdx: Integer): TMcJsonItem; overload;
  117. function Delete(aIdx: Integer): Boolean; overload;
  118. function Delete(const aKey: string): Boolean; overload;
  119. function HasKey(const aKey: string): Boolean;
  120. function IsEqual(const aItem: TMcJsonItem): Boolean;
  121. function Check(const aStr: string; aSpeedUp: Boolean = False): Boolean;
  122. function CountItems: Integer;
  123. // array shortener
  124. function At(aIdx: Integer; const aKey: string = ''): TMcJsonItem; overload;
  125. function At(const aKey: string; aIdx: Integer = -1): TMcJsonItem; overload;
  126. function ToString: string; overload;
  127. function ToString(aHuman: Boolean = False): string; overload;
  128. function Minify(const aCode: string): string;
  129. procedure LoadFromStream(Stream: TStream; aUTF8: Boolean = True);
  130. procedure SaveToStream(Stream: TStream; aHuman: Boolean = True);
  131. procedure LoadFromFile(const aFileName: string; aUTF8: Boolean = True);
  132. procedure SaveToFile(const aFileName: string; aHuman: Boolean = True);
  133. function GetEnumerator: TMcJsonItemEnumerator;
  134. // helpers
  135. function GetTypeStr: string;
  136. function GetValueStr: string;
  137. function Qot(const aMsg: string): string;
  138. function QotKey(const aKey: string): string;
  139. procedure Error(const Msg: string; const S1: string = '';
  140. const S2: string = '';
  141. const S3: string = '');
  142. end;
  143. // TMcJsonItemEnumerator
  144. TMcJsonItemEnumerator = class
  145. strict private
  146. fItem : TMcJsonItem;
  147. fIndex: Integer;
  148. public
  149. constructor Create(aItem: TMcJsonItem);
  150. function GetCurrent: TMcJsonItem;
  151. function MoveNext: Boolean;
  152. property Current: TMcJsonItem read GetCurrent;
  153. end;
  154. // Auxiliary functions
  155. function GetItemTypeStr(aType: TJItemType): string;
  156. function GetValueTypeStr(aType: TJValueType): string;
  157. function UnEscapeUnicode(const aStr: string): string;
  158. function CheckIsUtf8(const aStr: AnsiString; out aAux: AnsiString): Boolean;
  159. implementation
  160. const C_MCJSON_VERSION = '1.0.1';
  161. const C_EMPTY_KEY = '__a3mptyStr__';
  162. resourcestring
  163. SItemNil = 'Object reference is nil: %s';
  164. SItemTypeInvalid = 'Invalid item type: expected "%s" got "%s"';
  165. SItemTypeConvValue = 'Can''t convert item "%s" with value "%s" to "%s"';
  166. SItemTypeConv = 'Can''t convert item "%s" to "%s"';
  167. SParsingError = 'Error while parsing text: "%s" at pos "%s"';
  168. SIndexInvalid = 'Invalid index: %s';
  169. const
  170. WHITESPACE: set of char = [#9, #10, #13, #32]; // \t(ab), \r(CR), \n(LF), spc
  171. LINEBREAK: set of char = [#10, #13];
  172. ESCAPES: set of char = ['b', 't', 'n', 'f', 'r', 'u', '"', '\', '/'];
  173. DIGITS: set of char = ['0'..'9'];
  174. SIGNS: set of char = ['+', '-'];
  175. CLOSES: set of char = ['}', ']'];
  176. HEXA: set of char = ['0'..'9', 'A'..'F', 'a'..'f'];
  177. PATHSEPS: set of char = ['\', '/', '.'];
  178. { ---------------------------------------------------------------------------- }
  179. { Auxiliary private functions }
  180. { ---------------------------------------------------------------------------- }
  181. function escapeChar(const aStr: string; aPos, aLen: Integer; out aUnk: Boolean): Integer;
  182. var
  183. n: Integer;
  184. begin
  185. aUnk := False;
  186. n := 1;
  187. if (aStr[aPos] = '\') then
  188. begin
  189. // check next char is escapable
  190. if (aPos < aLen) and
  191. (aStr[aPos+1] in ESCAPES) then
  192. begin
  193. // one char escapes
  194. if (aStr[aPos+1] <> 'u') then
  195. n := 2
  196. else
  197. // u+(4 hexa) escape
  198. begin
  199. if (aLen-aPos-1 > 4 ) and
  200. (aStr[aPos+2] in HEXA) and
  201. (aStr[aPos+3] in HEXA) and
  202. (aStr[aPos+4] in HEXA) and
  203. (aStr[aPos+5] in HEXA)
  204. then n := 6 // \u1234 (6 chars)
  205. else aUnk := True; // bad \u escape
  206. end
  207. // if not escapable
  208. end
  209. else aUnk := True;
  210. end;
  211. // return the gap escaped
  212. Result := n;
  213. end;
  214. function escapeWS(const aStr: string; aPos, aLen: Integer): Integer;
  215. var
  216. n,c: Integer;
  217. begin
  218. c := aPos;
  219. n := 0;
  220. while (c <= aLen) and (aStr[c] in WHITESPACE) do
  221. begin
  222. Inc(c);
  223. Inc(n);
  224. end;
  225. // return the gap escaped
  226. Result := n;
  227. end;
  228. // removes all the whitespaces from the begining of the line
  229. function trimWS(const aStr: string): string;
  230. var
  231. i, j, k, n, len: Integer;
  232. sRes: string;
  233. opn, unk: Boolean;
  234. begin
  235. i := 1;
  236. j := 1;
  237. len := Length(aStr);
  238. SetLength(sRes, len);
  239. opn := false;
  240. while ( i <= len ) do
  241. begin
  242. // check escapes
  243. n := escapeChar(aStr, i, len, unk);
  244. // control '"' for keys and string values.
  245. // if not escaped, toggle opn status
  246. if (n = 1) and (aStr[i] = '"') then
  247. opn := not opn;
  248. // ignore whitespaces chars
  249. if not (opn) and (aStr[i] in WHITESPACE) then
  250. Inc(i)
  251. else
  252. // copy n chars from aStr to sRes and move on
  253. begin
  254. for k := 1 to n do
  255. begin
  256. sRes[j] := aStr[i];
  257. Inc(i);
  258. Inc(j);
  259. end;
  260. end;
  261. end;
  262. if (j > 1) then
  263. SetLength(sRes, j-1);
  264. // result
  265. Result := sRes;
  266. end;
  267. { ---------------------------------------------------------------------------- }
  268. { TMcJsonItem }
  269. { ---------------------------------------------------------------------------- }
  270. function TMcJsonItem.fGetCount: Integer;
  271. begin
  272. if (Self = nil) then Error(SItemNil, 'get count');
  273. Result := fChild.Count;
  274. end;
  275. function TMcJsonItem.fGetKey(aIdx: Integer): string;
  276. var
  277. aItem: TMcJsonItem;
  278. begin
  279. if (Self = nil) then Error(SItemNil, 'get key');
  280. // return the key of the idx-th child
  281. Result := '';
  282. aItem := fGetItemByIdx(aIdx);
  283. Result := aItem.fKey;
  284. end;
  285. function TMcJsonItem.fGetType(): TJItemType;
  286. begin
  287. if (Self = nil) then Error(SItemNil, 'get type');
  288. Result := fType;
  289. end;
  290. function TMcJsonItem.fGetItemByKey(const aKey: string): TMcJsonItem;
  291. var
  292. idx: Integer;
  293. begin
  294. Result := nil;
  295. // check
  296. if (Self = nil) then Error(SItemNil, 'get item by key ' + Qot(aKey));
  297. // find index of item with aKey
  298. idx := Self.IndexOf(aKey);
  299. if (idx >= 0)
  300. then Result := TMcJsonItem(fChild[idx])
  301. else Error(SItemNil, 'get item by key ' + Qot(aKey));
  302. end;
  303. function TMcJsonItem.fGetItemByIdx(aIdx: Integer): TMcJsonItem;
  304. begin
  305. // check
  306. if (Self = nil) then Error(SItemNil, 'get item by index ' + IntToStr(aIdx));
  307. // type compatibility check
  308. if (fType <> jitObject) and
  309. (fType <> jitArray ) then
  310. Error(SItemNil, 'get item by index ' + IntToStr(aIdx));
  311. // range check
  312. if (not isIndexValid(aIdx)) then
  313. Error(SIndexInvalid, 'get item by index ' + IntToStr(aIdx));
  314. // return valid child at index aIdx
  315. Result := TMcJsonItem(fChild[aIdx]);
  316. end;
  317. function TMcJsonItem.fHasChild: Boolean;
  318. begin
  319. if (Self = nil) then Error(SItemNil, 'has child');
  320. Result := ( fChild.Count > 0 );
  321. end;
  322. function TMcJsonItem.fIsNull: Boolean;
  323. begin
  324. if (Self = nil) then Error(SItemNil, 'is null');
  325. Result := ( fValType = jvtNull );
  326. end;
  327. function TMcJsonItem.fGetAsJSON(): string;
  328. begin
  329. if (Self = nil) then Error(SItemNil, 'get as JSON');
  330. Result := ToString(False);
  331. end;
  332. function TMcJsonItem.fGetAsObject: TMcJsonItem;
  333. begin
  334. if (Self = nil ) then Error(SItemNil, 'get as object')
  335. else if (fType <> jitObject) then Error(SItemTypeInvalid, 'object', GetTypeStr);
  336. // return a compatible value type
  337. Result := Self;
  338. end;
  339. function TMcJsonItem.fGetAsArray: TMcJsonItem;
  340. begin
  341. if (Self = nil ) then Error(SItemNil, 'get as array')
  342. else if (fType <> jitArray) then Error(SItemTypeInvalid, 'array', GetTypeStr);
  343. // return a compatible value type
  344. Result := Self;
  345. end;
  346. function TMcJsonItem.fGetAsInteger: Integer;
  347. var
  348. Ans: Integer;
  349. Aux: Integer;
  350. begin
  351. Ans := 0;
  352. Aux := 0;
  353. if (Self = nil ) then Error(SItemNil, 'get as integer')
  354. else if (fType <> jitValue) then Error(SItemTypeInvalid, 'value', GetTypeStr);
  355. // return a compatible value type
  356. // try to convert
  357. try
  358. case fValType of
  359. jvtNumber : Ans := StrToInt(fValue); // expected
  360. jvtString : Ans := StrToInt(fValue); // convertion
  361. jvtBoolean: Ans := Integer(fValue = 'true'); // convertion
  362. else Aux := -1;
  363. end;
  364. except
  365. Error(SItemTypeConvValue, GetValueStr, fValue, 'integer');
  366. end;
  367. // can´t convert, value type does not permit it
  368. if (Aux = -1) then
  369. Error(SItemTypeConv, GetValueStr, 'integer');
  370. Result := Ans;
  371. end;
  372. function TMcJsonItem.fGetAsDouble: Double;
  373. var
  374. Ans: Double;
  375. Aux: Integer;
  376. begin
  377. Ans := 0.0;
  378. Aux := 0;
  379. if (Self = nil ) then Error(SItemNil, 'get as double')
  380. else if (fType <> jitValue) then Error(SItemTypeInvalid, 'value', GetTypeStr);
  381. // return a compatible value type
  382. // try to convert
  383. try
  384. case fValType of
  385. jvtNumber : Ans := StrToFloat(fValue); // expected
  386. jvtString : Ans := StrToFloat(fValue); // convertion
  387. jvtBoolean: Ans := Integer(fValue = 'true'); // convertion
  388. else Aux := -1;
  389. end;
  390. except
  391. Error(SItemTypeConvValue, GetValueStr, fValue, 'double');
  392. end;
  393. // can´t convert, value type does not permit it
  394. if (Aux = -1) then
  395. Error(SItemTypeConv, GetValueStr, 'double');
  396. Result := Ans;
  397. end;
  398. function TMcJsonItem.fGetAsString: string;
  399. begin
  400. if (Self = nil ) then Error(SItemNil, 'get as string')
  401. else if (fType <> jitValue) then Error(SItemTypeInvalid, 'value', GetTypeStr);
  402. // return fValue that is string already
  403. // no need to convert
  404. Result := fValue;
  405. end;
  406. function TMcJsonItem.fGetAsBoolean: Boolean;
  407. var
  408. Ans: Boolean;
  409. Aux: Integer;
  410. begin
  411. Ans := False;
  412. Aux := 0;
  413. if (Self = nil ) then Error(SItemNil, 'get as boolean')
  414. else if (fType <> jitValue) then Error(SItemTypeInvalid, 'value', GetTypeStr);
  415. // return a compatible value type
  416. // try to convert
  417. try
  418. case fValType of
  419. jvtBoolean: Ans := Boolean(fValue = 'true') ; // expected
  420. jvtString : Ans := Boolean(StrToInt(fValue)); // convertion
  421. jvtNumber : Ans := Boolean(StrToInt(fValue)); // convertion
  422. else Aux := -1;
  423. end;
  424. except
  425. Error(SItemTypeConvValue, GetValueStr, fValue, 'boolean');
  426. end;
  427. // can´t convert, value type does not permit it
  428. if (Aux = -1) then
  429. Error(SItemTypeConv, GetValueStr, 'boolean');
  430. Result := Ans;
  431. end;
  432. function TMcJsonItem.fGetAsNull: string;
  433. begin
  434. if (Self = nil ) then Error(SItemNil, 'get as null')
  435. else if (fType <> jitValue) then Error(SItemTypeInvalid, 'value', GetTypeStr);
  436. // return fValue that is string already
  437. // no need to convert (null does not convet to anything, not presume zero)
  438. Result := fValue;
  439. end;
  440. procedure TMcJsonItem.fSetType(aType: TJItemType);
  441. var
  442. i: Integer;
  443. begin
  444. if (Self = nil) then Error(SItemNil, 'set type');
  445. // if an array or object is converted to a number, clear all descendants
  446. if (aType = jitValue) and (fType <> jitValue) then
  447. begin
  448. Clear;
  449. // the default value type is text
  450. fValType := jvtString;
  451. end
  452. // if a number is converted to an object or array, then take away the value from it
  453. else if (aType <> jitValue) and (fType = jitValue) then
  454. begin
  455. fValue := '';
  456. end
  457. // if the array is converted into an object, then assign keys to all its elements
  458. else if (aType = jitObject) and (fType = jitArray) then
  459. begin
  460. for i := 0 to (fChild.Count - 1) do
  461. TMcJsonItem(fChild[i]).fKey := IntToStr(i);
  462. end
  463. // if an object is converted into an array, then remove the keys from its descendants
  464. else if (aType = jitArray) and (fType = jitObject) then
  465. begin
  466. for i := 0 to (fChild.Count - 1) do
  467. TMcJsonItem(fChild[i]).fKey := '';
  468. end;
  469. // return aked type
  470. fType := aType;
  471. end;
  472. procedure TMcJsonItem.fSetAsJSON(aValue: string);
  473. var
  474. c, len: Integer;
  475. begin
  476. if (Self = nil) then Error(SItemNil, 'set as JSON');
  477. Clear;
  478. len := Length(aValue);
  479. c := 1;
  480. try
  481. c := Self.parse(aValue, 1, len);
  482. except
  483. on EOutOfMemory do
  484. Error(SItemNil, 'out of memory with ' + IntToStr(CountItems) + ' items');
  485. end;
  486. // valid-JSON
  487. if (c < len) then
  488. Error(SParsingError, 'bad json', IntToStr(len));
  489. end;
  490. procedure TMcJsonItem.fSetAsObject(aValue: TMcJsonItem);
  491. begin
  492. if (Self = nil) then Error(SItemNil, 'set as object');
  493. // if unset, set as value
  494. if (fType <> jitObject) then fSetType(jitObject);
  495. // make a copy (parsing)
  496. Self.AsJSON := aValue.AsJSON;
  497. end;
  498. procedure TMcJsonItem.fSetAsArray(aValue: TMcJsonItem);
  499. begin
  500. if (Self = nil) then Error(SItemNil, 'set as array');
  501. // if unset, set as value
  502. if (fType <> jitArray) then fSetType(jitArray);
  503. // make a copy (parsing)
  504. Self.AsJSON := aValue.AsJSON;
  505. end;
  506. procedure TMcJsonItem.fSetAsInteger(aValue: Integer);
  507. var
  508. i: Integer;
  509. begin
  510. if (Self = nil ) then Error(SItemNil, 'set as integer');
  511. // if unset, set as value
  512. if (fType = jitUnset) then fSetType(jitValue);
  513. // if container, set aValue for each child
  514. if (fType = jitArray) or (fType = jitObject) then
  515. begin
  516. for i := 0 to (fChild.Count - 1) do
  517. TMcJsonItem(fChild[i]).AsInteger := aValue;
  518. end
  519. else
  520. begin
  521. if (fValType <> jvtNumber) then fValType := jvtNumber;
  522. // set aValue as string
  523. fValue := IntToStr(aValue);
  524. end;
  525. end;
  526. procedure TMcJsonItem.fSetAsDouble(aValue: Double);
  527. var
  528. i: Integer;
  529. begin
  530. if (Self = nil ) then Error(SItemNil, 'set as double');
  531. // if unset, set as value
  532. if (fType = jitUnset) then fSetType(jitValue);
  533. // if container, set aValue for each child
  534. if (fType = jitArray) or (fType = jitObject) then
  535. begin
  536. for i := 0 to (fChild.Count - 1) do
  537. TMcJsonItem(fChild[i]).AsNumber := aValue;
  538. end
  539. else
  540. begin
  541. if (fValType <> jvtNumber) then fValType := jvtNumber;
  542. // set aValue as string
  543. fValue := FloatToStr(aValue);
  544. end;
  545. end;
  546. procedure TMcJsonItem.fSetAsString(aValue: string);
  547. var
  548. i: Integer;
  549. begin
  550. if (Self = nil ) then Error(SItemNil, 'set as string');
  551. // if unset, set as value
  552. if (fType = jitUnset) then fSetType(jitValue);
  553. // if container, set aValue for each child
  554. if (fType = jitArray) or (fType = jitObject) then
  555. begin
  556. for i := 0 to (fChild.Count - 1) do
  557. TMcJsonItem(fChild[i]).AsString := aValue;
  558. end
  559. else
  560. begin
  561. if (fValType <> jvtString) then fValType := jvtString;
  562. // set aValue as string
  563. fValue := aValue;
  564. end;
  565. end;
  566. procedure TMcJsonItem.fSetAsBoolean(aValue: Boolean);
  567. var
  568. i: Integer;
  569. begin
  570. if (Self = nil ) then Error(SItemNil, 'set as boolean');
  571. // if unset, set as value
  572. if (fType = jitUnset) then fSetType(jitValue);
  573. // if container, set aValue for each child
  574. if (fType = jitArray) or (fType = jitObject) then
  575. begin
  576. for i := 0 to (fChild.Count - 1) do
  577. TMcJsonItem(fChild[i]).AsBoolean := aValue;
  578. end
  579. else
  580. begin
  581. if (fValType <> jvtBoolean) then fValType := jvtBoolean;
  582. // set aValue as string
  583. if aValue
  584. then fValue := 'true'
  585. else fValue := 'false';
  586. end;
  587. end;
  588. procedure TMcJsonItem.fSetAsNull(aValue: string);
  589. var
  590. i: Integer;
  591. begin
  592. if (Self = nil ) then Error(SItemNil, 'set as null');
  593. // if unset, set as value
  594. if (fType = jitUnset) then fSetType(jitValue);
  595. // if container, set aValue for each child
  596. if (fType = jitArray) or (fType = jitObject) then
  597. begin
  598. for i := 0 to (fChild.Count - 1) do
  599. TMcJsonItem(fChild[i]).AsNull := 'null'; // ignore aValue
  600. end
  601. else
  602. begin
  603. if (fValType <> jvtNull) then fValType := jvtNull;
  604. // set aValue as string
  605. fValue := 'null'; // ignore aValue
  606. end;
  607. end;
  608. function TMcJsonItem.parse(const aCode: string; aPos, aLen: Integer): Integer;
  609. begin
  610. Result := aPos;
  611. // check position
  612. if (aPos > aLen) then
  613. Exit;
  614. // escape white spaces
  615. Inc(aPos, escapeWS(aCode, aPos, aLen));
  616. // now in the first character our open parenthesis
  617. case aCode[aPos] of
  618. '{': aPos := readObject (aCode, aPos, aLen); // recursive
  619. '[': aPos := readArray (aCode, aPos, aLen); // recursive
  620. '"': aPos := readValue (aCode, aPos, aLen);
  621. '0'..'9', '+', '-': aPos := readNumber (aCode, aPos, aLen);
  622. 't', 'T', 'f', 'F': aPos := readBoolean(aCode, aPos, aLen);
  623. 'n', 'N': aPos := readNull (aCode, aPos, aLen);
  624. else
  625. begin
  626. // valid-JSON
  627. Error(SParsingError, 'invalid char', IntToStr(aPos));
  628. end;
  629. end;
  630. // escape white spaces
  631. Inc(aPos, escapeWS(aCode, aPos, aLen));
  632. // move on
  633. Result := aPos;
  634. end;
  635. function TMcJsonItem.readObject(const aCode: string; aPos, aLen: Integer): Integer;
  636. var
  637. c: Integer;
  638. aItem: TMcJsonItem;
  639. sKey : string;
  640. first: Boolean;
  641. begin
  642. // we got here because current symbol was '{'
  643. c := aPos+1;
  644. // escape white spaces
  645. Inc(c, escapeWS(aCode, c, aLen));
  646. // set item type
  647. Self.fSetType(jitObject);
  648. first := True;
  649. // reading values until we reach a '}'
  650. while ( (c <= aLen) and (aCode[c] <> '}') ) do
  651. begin
  652. // parse ','
  653. if (not first) then
  654. c := readChar(aCode, ',', c, aLen);
  655. first := False;
  656. // escape white spaces
  657. Inc(c, escapeWS(aCode, c, aLen));
  658. // parsing a "key", stop next to '"'
  659. c := readString(aCode, sKey, c, aLen);
  660. // check empty key like {"":"value"}
  661. if (sKey = '') then
  662. sKey := C_EMPTY_KEY;
  663. // create a new item with parsed key
  664. // check duplicate (subject to speed up flag)
  665. aItem := nil;
  666. if (fSpeedUp) then
  667. aItem := Self.Add(sKey)
  668. else
  669. begin
  670. // valid-JSON
  671. if (Self.IndexOf(sKey) < 0)
  672. then aItem := Self.Add(sKey)
  673. else Error(SParsingError, 'duplicated key ' + sKey, IntToStr(c));
  674. end;
  675. // escape white spaces
  676. Inc(c, escapeWS(aCode, c, aLen));
  677. // parse ':'
  678. c := readChar(aCode, ':', c, aLen);
  679. // escape white spaces
  680. Inc(c, escapeWS(aCode, c, aLen));
  681. // parsing a value (recursive)
  682. if (aItem <> nil) then
  683. c := aItem.parse(aCode, c, aLen);
  684. // move on
  685. Inc(c, escapeWS(aCode, c, aLen));
  686. end;
  687. // valid-JSON
  688. if (c > aLen) then
  689. Error(SParsingError, 'bad object', IntToStr(aLen))
  690. else if (aCode[c] <> '}') then
  691. Error(SParsingError, 'bad object', IntToStr(c) );
  692. // stop next to '}'
  693. Result := c+1;
  694. end;
  695. function TMcJsonItem.readArray(const aCode: string; aPos, aLen: Integer): Integer;
  696. var
  697. c: Integer;
  698. aItem: TMcJsonItem;
  699. first: Boolean;
  700. begin
  701. // we got here because current symbol was '['
  702. c := aPos+1;
  703. // escape white spaces
  704. Inc(c, escapeWS(aCode, c, aLen));
  705. // set item type
  706. Self.fSetType(jitArray);
  707. first := True;
  708. // reading values until we reach a ']'
  709. while ( (c <= aLen) and (aCode[c] <> ']') ) do
  710. begin
  711. // parse ','
  712. if (not first) then
  713. c := readChar(aCode, ',', c, aLen);
  714. first := False;
  715. // escape white spaces
  716. Inc(c, escapeWS(aCode, c, aLen));
  717. // Creating a new value (here explicity whith no key)
  718. aItem := Self.Add();
  719. // parsing values (recursive)
  720. c := aItem.parse(aCode, c, aLen); // 1,2,3 or {...},{...}
  721. if (c > aLen) then
  722. Error(SParsingError, 'bad array', IntToStr(aLen));
  723. // move on
  724. Inc(c, escapeWS(aCode, c, aLen));
  725. end;
  726. // valid-JSON
  727. if (c > aLen) then
  728. Error(SParsingError, 'bad object', IntToStr(aLen))
  729. else if (aCode[c] <> ']') then
  730. Error(SParsingError, 'bad array', IntToStr(c) );
  731. // stop next to ']'
  732. Result := c+1;
  733. end;
  734. function TMcJsonItem.readString(const aCode: string; out aStr:string; aPos, aLen: Integer): Integer;
  735. var
  736. c: Integer;
  737. unk: Boolean;
  738. begin
  739. aStr := '';
  740. c := aPos;
  741. if (aCode[aPos] = '"') then
  742. begin
  743. Inc(c);
  744. while ( (c <= aLen) and (aCode[c] <> '"') ) do
  745. begin
  746. // do escapes
  747. Inc(c, escapeChar(aCode, c, aLen, unk));
  748. // Valid-JSON: break lines
  749. if (c > aLen) or (aCode[c] in LINEBREAK) then
  750. Error(SParsingError, 'line break', IntToStr(c));
  751. // Valid-JSON: unknown escape
  752. if (unk) then
  753. Error(SParsingError, 'unknown escape', IntToStr(c));
  754. end;
  755. // copy between '"'
  756. if (aCode[c] = '"') then
  757. aStr := System.Copy(aCode, aPos+1, c-aPos-1); // "string" -> string
  758. end;
  759. // stop next to '"'
  760. if (c < aLen) then Inc(c);
  761. Result := c;
  762. end;
  763. function TMcJsonItem.readChar(const aCode: string; aChar: Char; aPos, aLen: Integer): Integer;
  764. begin
  765. if ( aCode[aPos] <> aChar ) then
  766. Error(SParsingError, 'expected ' + aChar + ' got ' + aCode[aPos], IntToStr(aPos));
  767. // stop next to aChar
  768. Result := aPos+1;
  769. end;
  770. function TMcJsonItem.readKeyword(const aCode, aKeyword: string; aPos, aLen: Integer): Integer;
  771. var
  772. len: Integer;
  773. sAux: string;
  774. begin
  775. len := Length(aKeyword);
  776. sAux := System.Copy(aCode, aPos, len);
  777. // valid-JSON
  778. if (Lowercase(sAux) <> aKeyword) then
  779. Error(SParsingError, 'invalid keyword ' + sAux, IntToStr(aPos));
  780. // stop next to keyword last char
  781. Result := aPos + len;
  782. end;
  783. function TMcJsonItem.readValue(const aCode: string; aPos, aLen: Integer): Integer;
  784. var
  785. c: Integer;
  786. sVal: string;
  787. begin
  788. // we got here because current symbol is '"'
  789. c := aPos;
  790. // parse a "value" -> value
  791. c := readString(aCode, sVal, c, aLen);
  792. // valid-JSON
  793. if (c > aLen) then
  794. Error(SParsingError, 'bad value', IntToStr(aLen));
  795. // set item and value types
  796. Self.fSetType(jitValue);
  797. Self.fValType := jvtString;
  798. Self.fValue := sVal;
  799. // stop next to '"'
  800. Result := c;
  801. end;
  802. function TMcJsonItem.readNumber(const aCode: string; aPos, aLen: Integer): Integer;
  803. var
  804. c, ePos: Integer;
  805. begin
  806. // we got here because current symbol was '+/-' or Digit
  807. c := aPos;
  808. // 1. sign (optional)
  809. if aCode[c] in SIGNS
  810. then Inc(c);
  811. // 2. some digits but not leading zeros
  812. while (aCode[c] in DIGITS) do
  813. Inc(c);
  814. // 3. decimal dot (optional)
  815. if aCode[c] = '.'
  816. then Inc(c);
  817. // 4. fractional digits (optional)
  818. while (aCode[c] in DIGITS) do
  819. Inc(c);
  820. // 5. scientific notation ...E-01
  821. if LowerCase(aCode[c]) = 'e' then
  822. begin
  823. ePos := c;
  824. Inc(c);
  825. if aCode[c] in SIGNS
  826. then Inc(c);
  827. while (aCode[c] in DIGITS) do
  828. Inc(c);
  829. // valid-JSON: bad scientific number
  830. if (ePos+1 = c) then
  831. Error(SParsingError, 'bad scientific number', IntToStr(c));
  832. end;
  833. // Result
  834. Self.fSetType(jitValue);
  835. Self.fValType := jvtNumber;
  836. Self.fValue := System.Copy(aCode, aPos, c-aPos);
  837. // escape white spaces
  838. Inc(c, escapeWS(aCode, c, aLen));
  839. // valid-JSON: not a number
  840. if not ((aCode[c] = ',' ) or
  841. (aCode[c] in CLOSES)) then
  842. Error(SParsingError, 'not a number', IntToStr(c));
  843. // valid-JSON: leading zero
  844. if (aCode[aPos] = '0') and (aPos < aLen) and (c-aPos > 1) and
  845. (aCode[aPos+1] <> '.') then
  846. Error(SParsingError, 'bad number, leading zero', IntToStr(c));
  847. // stop next to number last char
  848. Result := c;
  849. end;
  850. function TMcJsonItem.readBoolean(const aCode: string; aPos, aLen: Integer): Integer;
  851. var
  852. c: Integer;
  853. sAux: string;
  854. begin
  855. // we got here because current symbol was 't/T' or 'f/F'
  856. c := aPos;
  857. sAux := '';
  858. // check boolean value 'true'
  859. if (aCode[aPos] = 't') or
  860. (aCode[aPos] = 'T') then
  861. begin
  862. c := readKeyword(aCode, 'true', c, aLen);
  863. Self.fValue := 'true';
  864. end
  865. // check boolean value 'false'
  866. else if (aCode[aPos] = 'f') or
  867. (aCode[aPos] = 'F') then
  868. begin
  869. c := readKeyword(aCode, 'false', c, aLen);
  870. Self.fValue := 'false';
  871. end;
  872. // set item and value types
  873. Self.fSetType(jitValue);
  874. Self.fValType := jvtBoolean;
  875. // stop next to keyword last char
  876. Result := c;
  877. end;
  878. function TMcJsonItem.readNull(const aCode: string; aPos, aLen: Integer): Integer;
  879. var
  880. c: Integer;
  881. sAux: string;
  882. begin
  883. // we got here because current symbol was 'n/N'
  884. c := aPos;
  885. sAux := '';
  886. // check if null
  887. if (aCode[aPos] = 'n') or
  888. (aCode[aPos] = 'N') then
  889. begin
  890. c := readKeyword(aCode, 'null', c, aLen);
  891. Self.fValue := 'null';
  892. end;
  893. // set item and value types
  894. Self.fSetType(jitValue);
  895. Self.fValType := jvtNull;
  896. // stop next to keyword last char
  897. Result := c;
  898. end;
  899. function TMcJsonItem.sFormat(aHuman: Boolean): string;
  900. var
  901. strS: TStringStream;
  902. sNL, sSp: string;
  903. begin
  904. strS := TStringStream.Create('');
  905. try
  906. // new line
  907. if aHuman
  908. then sNL := #13#10
  909. else sNL := '';
  910. // key value separator
  911. if (aHuman)
  912. then sSp := ': '
  913. else sSp := ':';
  914. // call format item recursively
  915. SFormatItem(strS, '', sNL, sSp);
  916. // final result;
  917. Result := strS.DataString;
  918. finally
  919. strS.Free;
  920. end;
  921. end;
  922. function TMcJsonItem.sFormatItem(aStrS: TStringStream; const aIn, aNL, aSp: string): string;
  923. var
  924. i, len: Integer;
  925. sGoIn: string;
  926. begin
  927. Result := '';
  928. sGoIn := '';
  929. if (Self = nil) then
  930. Exit;
  931. case Self.fType of
  932. // format JSON object
  933. jitObject:
  934. begin
  935. if (fKey <> '') then
  936. aStrS.WriteString(QotKey(fKey) + aSp);
  937. aStrS.WriteString('{' + aNL);
  938. len := Self.Count - 1;
  939. // use aSp to define if aHuman is true.
  940. if (aSp <> ':') then sGoIn := aIn + ' ';
  941. // mount recursively
  942. for i := 0 to len do
  943. begin
  944. aStrS.WriteString(sGoIn);
  945. aStrS.WriteString(TMcJsonItem(fChild[i]).sFormatItem(aStrS, sGoIn, aNL, aSP) );
  946. if ( i < len ) then
  947. aStrS.WriteString(',' + aNL);
  948. end;
  949. aStrS.WriteString(aNL + aIn + '}');
  950. end;
  951. // format JSON array
  952. jitArray:
  953. begin
  954. if (fKey <> '') then
  955. aStrS.WriteString(QotKey(fKey) + aSp);
  956. aStrS.WriteString('[' + aNL);
  957. len := Self.Count - 1;
  958. // use aSp to define if aHuman is true.
  959. if (aSp <> ':') then sGoIn := aIn + ' ';
  960. // mount recursively
  961. for i := 0 to len do
  962. begin
  963. aStrS.WriteString(sGoIn);
  964. aStrS.WriteString(TMcJsonItem(fChild[i]).SFormatItem(aStrS, sGoIn, aNL, aSP) );
  965. if ( i < len ) then
  966. aStrS.WriteString(','+ aNL);
  967. end;
  968. aStrS.WriteString(aNL + aIn + ']');
  969. end;
  970. // format JSON key:value pair
  971. jitValue:
  972. begin
  973. if (fKey <> '') then
  974. aStrS.WriteString(QotKey(fKey) + aSp);
  975. if (fValType = jvtString)
  976. then aStrS.WriteString(Qot(fValue))
  977. else aStrS.WriteString( fValue );
  978. end;
  979. end;
  980. end;
  981. function TMcJsonItem.isIndexValid(aIdx: Integer): Boolean;
  982. var
  983. Ans: Boolean;
  984. begin
  985. if (fChild.Count <= 0)
  986. then Ans := (AIdx = 0)
  987. else Ans := (AIdx >= 0) and (AIdx < fChild.Count);
  988. Result := Ans;
  989. end;
  990. { ---------------------------------------------------------------------------- }
  991. { TMcJsonItem - Public methods }
  992. { ---------------------------------------------------------------------------- }
  993. constructor TMcJsonItem.Create;
  994. begin
  995. fChild := TList.Create;
  996. fType := jitUnset;
  997. fSpeedUp := True;
  998. end;
  999. constructor TMcJsonItem.Create(aJItemType: TJItemType);
  1000. begin
  1001. inherited Create;
  1002. Create;
  1003. Self.ItemType := aJItemType;
  1004. end;
  1005. constructor TMcJsonItem.Create(const aItem: TMcJsonItem);
  1006. begin
  1007. inherited Create;
  1008. Create;
  1009. Self.AsJSON := aItem.AsJSON;
  1010. end;
  1011. constructor TMcJsonItem.Create(const aCode: string);
  1012. begin
  1013. inherited Create;
  1014. Create;
  1015. try
  1016. Self.AsJSON := aCode;
  1017. except
  1018. Self.AsJSON := '';
  1019. end;
  1020. end;
  1021. destructor TMcJsonItem.Destroy;
  1022. begin
  1023. Clear;
  1024. fChild.Free;
  1025. inherited Destroy;
  1026. end;
  1027. procedure TMcJsonItem.Clear;
  1028. var
  1029. i: Integer;
  1030. begin
  1031. if (Self = nil) then Error(SItemNil, 'clear');
  1032. // free memory of all children (will be recursive)
  1033. for i := 0 to (fChild.Count - 1) do
  1034. TMcJsonItem(fChild[i]).Free;
  1035. // clear list
  1036. fChild.Clear;
  1037. end;
  1038. function TMcJsonItem.IndexOf(const aKey: string): Integer;
  1039. var
  1040. i, idx: Integer;
  1041. begin
  1042. idx := -1;
  1043. Result := idx;
  1044. // check
  1045. if (Self = nil) then Error(SItemNil, 'index of');
  1046. // looking for an element
  1047. for i := 0 to (fChild.Count - 1) do
  1048. begin
  1049. if (TMcJsonItem(fChild[i]).fKey = aKey) then
  1050. begin
  1051. idx := i;
  1052. Break;
  1053. end;
  1054. end;
  1055. // return the Result
  1056. if (idx >= 0 ) and
  1057. (idx < fChild.Count) then
  1058. Result := idx;
  1059. end;
  1060. function TMcJsonItem.Path(const aPath: string): TMcJsonItem;
  1061. function GetKeyByPath(const aPath: string; out aPos, aLen: Integer): string;
  1062. var
  1063. c: Integer;
  1064. begin
  1065. Result := '';
  1066. // check start with sep
  1067. if (aPath[aPos] in PATHSEPS) then
  1068. Inc(aPos);
  1069. c := aPos;
  1070. while (c <= aLen) and not (aPath[c] in PATHSEPS) do
  1071. begin
  1072. Inc(c);
  1073. end;
  1074. // copy between seps
  1075. if (c-aPos >= 0) then
  1076. Result := System.Copy(aPath, aPos, c-aPos);
  1077. // move on
  1078. aPos := c;
  1079. end;
  1080. var
  1081. aItem: TMcJsonItem;
  1082. c, len: Integer;
  1083. sKey: string;
  1084. begin
  1085. if (Self = nil) then Error(SItemNil, 'get by path ' + Qot(aPath));
  1086. aItem := Self;
  1087. // parse path of keys using seps
  1088. c := 1;
  1089. len := Length(aPath);
  1090. while (c < len) do
  1091. begin
  1092. // get by key
  1093. sKey := GetKeyByPath(aPath, c, len);
  1094. if (sKey <> '') then
  1095. aItem := aItem.fGetItemByKey(sKey);
  1096. end;
  1097. // result aItem to permit chain
  1098. Result := aItem;
  1099. end;
  1100. function TMcJsonItem.Add(const aKey: string): TMcJsonItem;
  1101. var
  1102. aItem: TMcJsonItem;
  1103. begin
  1104. if (Self = nil) then Error(SItemNil, 'add using key ' + Qot(aKey));
  1105. // check unset item
  1106. if (fType = jitUnset) then
  1107. fSetType(jitObject);
  1108. // create a new item with aKey and add it.
  1109. aItem := TMcJsonItem.Create;
  1110. aItem.fKey := aKey;
  1111. fChild.Add(aItem);
  1112. // result aItem to permit chain
  1113. Result := aItem;
  1114. end;
  1115. function TMcJsonItem.Add(const aKey: string; aItemType: TJItemType): TMcJsonItem;
  1116. var
  1117. aItem: TMcJsonItem;
  1118. begin
  1119. aItem := Self.Add(aKey);
  1120. aItem.ItemType := aItemType;
  1121. // result aItem to permit chain
  1122. Result := aItem;
  1123. end;
  1124. function TMcJsonItem.Add(aItemType: TJItemType): TMcJsonItem;
  1125. var
  1126. aItem: TMcJsonItem;
  1127. begin
  1128. aItem := Self.Add();
  1129. aItem.ItemType := aItemType;
  1130. // result aItem to permit chain
  1131. Result := aItem;
  1132. end;
  1133. function TMcJsonItem.Add(const aItem: TMcJsonItem): TMcJsonItem;
  1134. var
  1135. aNewItem: TMcJsonItem;
  1136. begin
  1137. if (Self = nil) then Error(SItemNil, 'add using item');
  1138. // check unset item
  1139. if (fType = jitUnset) then
  1140. fSetType(jitObject);
  1141. // check if self is an array
  1142. if (fType <> jitArray) then
  1143. Error(SItemTypeInvalid, 'array', GetTypeStr);
  1144. // create a new item copy of aItem and add it.
  1145. aNewItem := TMcJsonItem.Create(aItem);
  1146. // add item.
  1147. fChild.Add(aNewItem);
  1148. // result aNewItem to permit chain
  1149. Result := aNewItem;
  1150. end;
  1151. function TMcJsonItem.Copy(const aItem: TMcJsonItem): TMcJsonItem;
  1152. begin
  1153. if (Self = nil) then Error(SItemNil, 'copy');
  1154. // clear self and copy JSON from aItem
  1155. Self.Clear;
  1156. Self.AsJSON := aItem.AsJSON;
  1157. // result self to permit chain
  1158. Result := Self;
  1159. end;
  1160. function TMcJsonItem.Clone: TMcJsonItem;
  1161. var
  1162. aItem: TMcJsonItem;
  1163. begin
  1164. if (Self = nil) then Error(SItemNil, 'clone');
  1165. // create a new item using self
  1166. aItem := TMcJsonItem.Create(Self);
  1167. // result aItem to permit chain
  1168. Result := aItem;
  1169. end;
  1170. function TMcJsonItem.Insert(const aKey: string; aIdx: Integer): TMcJsonItem;
  1171. var
  1172. aItem: TMcJsonItem;
  1173. begin
  1174. if (Self = nil ) then Error(SItemNil, 'insert using key ' + Qot(aKey));
  1175. if (not isIndexValid(aIdx)) then Error(SIndexInvalid, 'insert index ' + IntToStr(aIdx));
  1176. // check unset item
  1177. if (fType = jitUnset) then
  1178. fSetType(jitObject);
  1179. // create a new item with aKey and insert it.
  1180. aItem := TMcJsonItem.Create;
  1181. aItem.fKey := aKey;
  1182. fChild.Insert(aIdx, aItem);
  1183. // result aItem to permit chain
  1184. Result := aItem;
  1185. end;
  1186. function TMcJsonItem.Insert(const aItem: TMcJsonItem; aIdx: Integer): TMcJsonItem;
  1187. var
  1188. aNewItem: TMcJsonItem;
  1189. begin
  1190. if (Self = nil ) then Error(SItemNil, 'insert using item');
  1191. if (not isIndexValid(aIdx)) then Error(SIndexInvalid, 'insert index ' + IntToStr(aIdx));
  1192. // check unset item
  1193. if (fType = jitUnset) then
  1194. fSetType(jitObject);
  1195. // check if self is an array
  1196. if (fType <> jitArray) then
  1197. Error(SItemTypeInvalid, 'array', GetTypeStr);
  1198. // create a new item copy of aItem and insert it.
  1199. aNewItem := TMcJsonItem.Create(aItem);
  1200. // insert item.
  1201. fChild.Insert(aIdx, aNewItem);
  1202. // result aNewItem to permit chain
  1203. Result := aNewItem;
  1204. end;
  1205. function TMcJsonItem.Delete(aIdx: Integer): Boolean;
  1206. var
  1207. Size: Integer;
  1208. aItemDel: TMcJsonItem;
  1209. Ans: Boolean;
  1210. begin
  1211. Ans := False;
  1212. if (Self = nil) then Error(SItemNil, 'delete index ' + IntToStr(aIdx));
  1213. // check idx and size
  1214. Size := fChild.Count;
  1215. if (not isIndexValid(aIdx)) or (Size <= 0) then
  1216. Ans := False
  1217. else
  1218. begin
  1219. // item to delete
  1220. aItemDel := TMcJsonItem(fChild[aIdx]);
  1221. // delete position and free memory.
  1222. if (aItemDel <> nil) then
  1223. begin
  1224. fChild.Delete(aIdx);
  1225. aItemDel.Free;
  1226. Ans := True;
  1227. end;
  1228. end;
  1229. Result := Ans;
  1230. end;
  1231. function TMcJsonItem.Delete(const aKey: string): Boolean;
  1232. var
  1233. Ans: Boolean;
  1234. idx: Integer;
  1235. begin
  1236. Ans := False;
  1237. if (Self = nil) then Error(SItemNil, 'delete key ' + Qot(aKey));
  1238. // find index of item with aKey
  1239. idx := Self.IndexOf(aKey);
  1240. if (idx >= 0) then
  1241. Ans := Self.Delete(idx);
  1242. Result := Ans;
  1243. end;
  1244. function TMcJsonItem.HasKey(const aKey: string): Boolean;
  1245. begin
  1246. if (Self = nil) then Error(SItemNil, 'has key ' + Qot(aKey));
  1247. try
  1248. fGetItemByKey(aKey);
  1249. Result := True;
  1250. except
  1251. Result := False;
  1252. end;
  1253. end;
  1254. function TMcJsonItem.IsEqual(const aItem: TMcJsonItem): Boolean;
  1255. begin
  1256. Result := False;
  1257. if (Self = nil) then Error(SItemNil, 'is equal item');
  1258. if (aItem <> nil) then
  1259. Result := (Self.AsJSON = aItem.AsJSON);
  1260. end;
  1261. function TMcJsonItem.Check(const aStr: string; aSpeedUp: Boolean): Boolean;
  1262. var
  1263. aItem: TMcJsonItem;
  1264. begin
  1265. aItem := TMcJsonItem.Create;
  1266. try
  1267. aItem.fSpeedUp := aSpeedUp;
  1268. aItem.AsJSON := aStr;
  1269. // Result := True;
  1270. Result := (aItem.AsJSON = trimWS(aStr));
  1271. except
  1272. Result := False;
  1273. end;
  1274. aItem.Free;
  1275. end;
  1276. function TMcJsonItem.CountItems: Integer;
  1277. function CountItemsRec(const aItem: TMcJsonItem): Integer;
  1278. var
  1279. i, sum: Integer;
  1280. begin
  1281. sum := aItem.Count;
  1282. for i := 0 to aItem.Count-1 do
  1283. sum := sum + CountItemsRec( TMcJsonItem(aItem.fChild[i]) );
  1284. Result := sum;
  1285. end;
  1286. begin
  1287. Result := CountItemsRec(Self);
  1288. end;
  1289. function TMcJsonItem.At(aIdx: Integer; const aKey: string): TMcJsonItem;
  1290. var
  1291. aItem: TMcJsonItem;
  1292. begin
  1293. // get by index
  1294. aItem := fGetItemByIdx(aIdx);
  1295. // get by key
  1296. if ((aKey <> '') and (aItem <> nil)) then
  1297. aItem := aItem.fGetItemByKey(aKey);
  1298. Result := aItem;
  1299. end;
  1300. function TMcJsonItem.At(const aKey: string; aIdx: Integer): TMcJsonItem;
  1301. var
  1302. aItem: TMcJsonItem;
  1303. begin
  1304. // get by key
  1305. aItem := fGetItemByKey(aKey);
  1306. // get by index
  1307. if ((aIdx >= 0) and (aItem <> nil)) then
  1308. aItem := aItem.fGetItemByIdx(aIdx);
  1309. Result := aItem;
  1310. end;
  1311. function TMcJsonItem.ToString: string;
  1312. begin
  1313. Result := sFormat(False);
  1314. end;
  1315. function TMcJsonItem.ToString(aHuman: Boolean): string;
  1316. begin
  1317. Result := sFormat(aHuman);
  1318. end;
  1319. function TMcJsonItem.Minify(const aCode: string): string;
  1320. begin
  1321. Result := trimWS(aCode);
  1322. end;
  1323. procedure TMcJsonItem.LoadFromStream(Stream: TStream; aUTF8: Boolean);
  1324. var
  1325. sCode, sAux: AnsiString;
  1326. len : Int64;
  1327. begin
  1328. len := Stream.Size - Stream.Position;
  1329. sCode := '';
  1330. SetLength(sCode, len);
  1331. Stream.Read(Pointer(sCode)^, len);
  1332. if (aUTF8 and CheckIsUtf8(sCode, sAux))
  1333. then Self.AsJSON := sAux
  1334. else Self.AsJSON := sCode;
  1335. end;
  1336. procedure TMcJsonItem.SaveToStream(Stream: TStream; aHuman: Boolean);
  1337. var
  1338. sCode: AnsiString;
  1339. len : Int64;
  1340. begin
  1341. sCode := AnsiToUtf8(Self.ToString(aHuman));
  1342. len := Length(sCode);
  1343. Stream.Write(Pointer(sCode)^, len);
  1344. end;
  1345. procedure TMcJsonItem.LoadFromFile(const aFileName: string; aUTF8: Boolean);
  1346. var
  1347. fileStream: TFileStream;
  1348. begin
  1349. fileStream := nil;
  1350. try
  1351. fileStream := TFileStream.Create(aFileName, fmOpenRead or fmShareDenyWrite);
  1352. Clear;
  1353. LoadFromStream(fileStream, aUTF8);
  1354. finally
  1355. fileStream.Free;
  1356. end;
  1357. end;
  1358. procedure TMcJsonItem.SaveToFile(const aFileName: string; aHuman: Boolean);
  1359. var
  1360. fileStream: TFileStream;
  1361. begin
  1362. fileStream := nil;
  1363. try
  1364. fileStream := TFileStream.Create(aFileName, fmCreate or fmShareDenyWrite);
  1365. SaveToStream(fileStream, aHuman);
  1366. finally
  1367. fileStream.Free;
  1368. end;
  1369. end;
  1370. function TMcJsonItem.GetEnumerator: TMcJsonItemEnumerator;
  1371. var
  1372. enum: TMcJsonItemEnumerator;
  1373. begin
  1374. enum := TMcJsonItemEnumerator.Create(Self);
  1375. Result := enum;
  1376. end;
  1377. function TMcJsonItem.GetTypeStr: string;
  1378. begin
  1379. if (Self = nil) then Error(SItemNil, 'get type description');
  1380. Result := GetItemTypeStr(Self.fType);
  1381. end;
  1382. function TMcJsonItem.GetValueStr: string;
  1383. begin
  1384. if (Self = nil) then Error(SItemNil, 'get value type description');
  1385. Result := GetValueTypeStr(Self.fValType);
  1386. end;
  1387. function TMcJsonItem.Qot(const aMsg: string): string;
  1388. begin
  1389. Result := '"' + aMsg + '"';
  1390. end;
  1391. function TMcJsonItem.QotKey(const aKey: string): string;
  1392. begin
  1393. Result := '';
  1394. if (aKey = C_EMPTY_KEY)
  1395. then Result := Qot('')
  1396. else Result := Qot(aKey);
  1397. end;
  1398. procedure TMcJsonItem.Error(const Msg: string; const S1: string;
  1399. const S2: string;
  1400. const S3: string);
  1401. var
  1402. aStr: string;
  1403. begin
  1404. aStr := Format(Msg, [S1, S2, S3]);
  1405. raise EMcJsonException.Create(aStr);
  1406. end;
  1407. { ---------------------------------------------------------------------------- }
  1408. { TMcJsonItemEnumerator }
  1409. { ---------------------------------------------------------------------------- }
  1410. constructor TMcJsonItemEnumerator.Create(aItem: TMcJsonItem);
  1411. begin
  1412. fItem := aItem;
  1413. FIndex := -1;
  1414. end;
  1415. function TMcJsonItemEnumerator.GetCurrent: TMcJsonItem;
  1416. begin
  1417. if (fItem.fChild = nil ) then Result := nil
  1418. else if (fIndex < 0 ) then Result := nil
  1419. else if (fIndex < fItem.fChild.Count) then Result := TMcJsonItem(fItem.fChild[fIndex])
  1420. else Result := nil;
  1421. end;
  1422. function TMcJsonItemEnumerator.MoveNext: Boolean;
  1423. begin
  1424. Inc(fIndex);
  1425. if (fItem.fChild = nil)
  1426. then Result := False
  1427. else Result := (fIndex < fItem.fChild.Count);
  1428. end;
  1429. { ---------------------------------------------------------------------------- }
  1430. { Auxiliary public functions }
  1431. { ---------------------------------------------------------------------------- }
  1432. function GetItemTypeStr(aType: TJItemType): string;
  1433. begin
  1434. Result := 'unknown';
  1435. case aType of
  1436. jitValue : Result := 'value' ;
  1437. jitObject: Result := 'object';
  1438. jitArray : Result := 'array' ;
  1439. jitUnset : Result := 'unset' ;
  1440. end;
  1441. end;
  1442. function GetValueTypeStr(aType: TJValueType): string;
  1443. begin
  1444. Result := 'unknown';
  1445. case aType of
  1446. jvtString : Result := 'string' ;
  1447. jvtNumber : Result := 'number' ;
  1448. jvtBoolean: Result := 'boolean';
  1449. jvtNull : Result := 'null' ;
  1450. end;
  1451. end;
  1452. function UnEscapeUnicode(const aStr: string): string;
  1453. var
  1454. cs, cd, len: Integer;
  1455. ans: string;
  1456. begin
  1457. cs := 1; // char in source
  1458. cd := 1; // char in destiny
  1459. len := Length(aStr);
  1460. SetLength(ans, len);
  1461. while (cs <= len) do
  1462. begin
  1463. // no escape, copy and move on
  1464. if (aStr[cs] <> '\') then
  1465. begin
  1466. ans[cd] := aStr[cs];
  1467. Inc(cs);
  1468. Inc(cd);
  1469. end
  1470. else
  1471. begin
  1472. // u+(4 hexa) escape
  1473. if (cs < len) and (aStr[cs+1] = 'u') then
  1474. begin
  1475. if (len-cs-1 > 4 ) and
  1476. (aStr[cs+2] in HEXA) and (aStr[cs+3] in HEXA) and
  1477. (aStr[cs+4] in HEXA) and (aStr[cs+5] in HEXA) then
  1478. begin
  1479. try
  1480. try
  1481. ans[cd] := Chr( StrToInt('$' + Copy(aStr, cs+2, 4)) );
  1482. Inc(cd);
  1483. except
  1484. ; // invalid hexa, ignore and move on
  1485. end;
  1486. finally
  1487. Inc(cs, 6); // \uXXXX
  1488. end;
  1489. end;
  1490. end
  1491. // ignore other escapes
  1492. else
  1493. Inc(cs, 2);
  1494. end;
  1495. end;
  1496. // trim extra size
  1497. cd := Pos(#0, ans);
  1498. SetLength(ans, cd-1);
  1499. // return the string unescaped
  1500. Result := ans;
  1501. end;
  1502. function CheckIsUtf8(const aStr: AnsiString; out aAux: AnsiString): Boolean;
  1503. var
  1504. len : Integer;
  1505. begin
  1506. len := Length(aStr);
  1507. // convert to Ansi (if Utf8, will lead to length zero)
  1508. try
  1509. aAux := Utf8ToAnsi(aStr);
  1510. except
  1511. ; // ignore
  1512. end;
  1513. Result := (len > 0) and (Length(aAux) <> 0);
  1514. end;
  1515. end.