1
0

rjson.pas 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891
  1. {
  2. TRJSON - JSON Simple Read and Write
  3. - v0.9.9
  4. - 2024-09-17 by gale
  5. - https://github.com/higale/RJSON
  6. }
  7. unit rjson;
  8. interface
  9. uses
  10. System.IOUtils, System.Classes, System.SysUtils, System.JSON, System.Generics.Collections;
  11. type
  12. TJObject = TJSONObject;
  13. TJArray = TJSONArray;
  14. TJValue = TJSONValue;
  15. TJString = TJSONString;
  16. TJNumber = TJSONNumber;
  17. TJBool = TJSONBool;
  18. TJTrue = TJSONTrue;
  19. TJFalse = TJSONFalse;
  20. TJNull = TJSONNull;
  21. TJVType = type of TJValue;
  22. IRJRoot = interface
  23. ['{486F1FA6-2CDD-4124-98C5-CE7C398B7143}']
  24. function GetData: TJValue;
  25. procedure SetData(const AValue: TJValue);
  26. function ForceData(AType: TJVType): TJValue;
  27. property Data: TJValue read GetData write SetData;
  28. end;
  29. TRJSONRoot = class(TInterfacedObject, IRJRoot)
  30. private
  31. FData: TJValue;
  32. function GetData: TJValue;
  33. procedure SetData(const AValue: TJValue);
  34. function ForceData(AType: TJVType): TJValue;
  35. public
  36. constructor Create;
  37. destructor Destroy; override;
  38. end;
  39. TRPath = record
  40. private
  41. FData: string;
  42. public
  43. class operator Implicit(const Value: string): TRPath;
  44. class operator Implicit(Value: Integer): TRPath;
  45. class operator Implicit(const [ref] Value: TRPath): string;
  46. end;
  47. TRJSONEnumerator = class;
  48. TRJSON = record
  49. private
  50. FIRoot: IRJRoot;
  51. FPath: string;
  52. function GetRootRefCount: Integer;
  53. function ForceRootJValue(const APath: string): TJValue;
  54. function LinkPath(const ALeft, ARight: string): string;
  55. function GetJValue: TJValue;
  56. function GetItems(const APath: TRPath): TRJSON;
  57. function GetPairs(AIndex: Integer): TRJSON;
  58. procedure SetValue(const [ref] AValue: TRJSON);
  59. procedure SetItems(const APath: TRPath; const [ref] AValue: TRJSON);
  60. function GetS(const APath: TRPath): string; overload;
  61. procedure SetS(const APath: TRPath; AValue: string); overload;
  62. function GetI(const APath: TRPath): Integer; overload;
  63. procedure SetI(const APath: TRPath; AValue: Integer); overload;
  64. function GetI64(const APath: TRPath): Int64; overload;
  65. procedure SetI64(const APath: TRPath; AValue: Int64); overload;
  66. function GetF(const APath: TRPath): Extended; overload;
  67. procedure SetF(const APath: TRPath; AValue: Extended); overload;
  68. function GetB(const APath: TRPath): Boolean; overload;
  69. procedure SetB(const APath: TRPath; AValue: Boolean); overload;
  70. function GetCount: Integer;
  71. function GetLastPath: string;
  72. function GetIndex: Integer;
  73. function GetKey: string;
  74. function GetRoot: TRJSON;
  75. public
  76. function GetEnumerator(): TRJSONEnumerator;
  77. class operator Initialize(out Dest: TRJSON);
  78. class operator Finalize(var Dest: TRJSON);
  79. class operator Assign(var Dest: TRJSON; const [ref] Src: TRJSON);
  80. class operator Implicit(const Value: string): TRJSON;
  81. class operator Implicit(const [ref] Value: TRJSON): string;
  82. class operator Implicit(Value: Integer): TRJSON;
  83. class operator Implicit(const [ref] Value: TRJSON): Integer;
  84. class operator Implicit(Value: Int64): TRJSON;
  85. class operator Implicit(const [ref] Value: TRJSON): Int64;
  86. class operator Implicit(Value: Extended): TRJSON;
  87. class operator Implicit(const [ref] Value: TRJSON): Extended;
  88. class operator Implicit(Value: Boolean): TRJSON;
  89. class operator Implicit(const [ref] Value: TRJSON): Boolean;
  90. class operator Implicit(const Value: TJValue): TRJSON;
  91. class operator Implicit(const [ref] Value: TRJSON): TJValue;
  92. function ToStr(const ADefault: string = ''): string;
  93. function ToInt(ADefault: Integer = 0): Integer;
  94. function ToInt64(ADefault: Int64 = 0): Int64;
  95. function ToFloat(ADefault: Extended = 0.0): Extended;
  96. function ToBool(ADefault: Boolean = False): Boolean;
  97. property Items[const APath: TRPath]: TRJSON read GetItems write SetItems; default;
  98. property S[const APath: TRPath]: string read GetS write SetS;
  99. property I[const APath: TRPath]: Integer read GetI write SetI;
  100. property I64[const APath: TRPath]: Int64 read GetI64 write SetI64;
  101. property F[const APath: TRPath]: Extended read GetF write SetF;
  102. property B[const APath: TRPath]: Boolean read GetB write SetB;
  103. property Pairs[AIndex: Integer]: TRJSON read GetPairs;
  104. property Count: Integer read GetCount;
  105. property LastPath: string read GetLastPath;
  106. property Index: Integer read GetIndex;
  107. property Key: string read GetKey;
  108. property RootRefCount: Integer read GetRootRefCount;
  109. property Root: TRJSON read GetRoot;
  110. property Path: string read FPath;
  111. property JValue: TJValue read GetJValue;
  112. function CloneJValue: TJValue;
  113. function IsRoot: Boolean; inline;
  114. function RootIsJObject: Boolean; inline;
  115. function RootIsJArray: Boolean; inline;
  116. function IsJObject: Boolean;
  117. function IsJArray: Boolean;
  118. function IsJString: Boolean;
  119. function IsJNumber: Boolean;
  120. function IsJBool: Boolean;
  121. function IsJNull: Boolean;
  122. function IsNil: Boolean;
  123. procedure Reset;
  124. function ToString: string;
  125. function ToJSON(AEncodeBelow32: Boolean = true; AEncodeAbove127: Boolean = true): string;
  126. function Format(AIndentation: Integer = 4; AEncodeBelow32: Boolean = False; AEncodeAbove127: Boolean = False): string;
  127. function ParseJValue(const AData: string; AUseBool: Boolean = False; ARaiseExc: Boolean = False): Boolean;
  128. function LoadFromFile(const AFileName: string; AUseBool: Boolean = False; ARaiseExc: Boolean = False): Boolean;
  129. procedure SaveToFile(const AFileName: string; AIndentation: Integer = -1; AEncodeBelow32: Boolean = true; AEncodeAbove127: Boolean = true; AWriteBOM: Boolean = False);
  130. end;
  131. { Iterators }
  132. TRJSONEnumerator = class
  133. private
  134. FPData: ^TRJSON;
  135. FIndex: Integer;
  136. function GetCurrent: TRJSON;
  137. public
  138. constructor Create(const [ref] AData: TRJSON);
  139. function MoveNext: Boolean;
  140. property Current: TRJSON read GetCurrent;
  141. end;
  142. implementation
  143. { ============================================================================ }
  144. { TRJSONRoot }
  145. constructor TRJSONRoot.Create;
  146. begin
  147. inherited;
  148. FData := nil;
  149. end;
  150. destructor TRJSONRoot.Destroy;
  151. begin
  152. FData.Free;
  153. inherited;
  154. end;
  155. function TRJSONRoot.GetData: TJValue;
  156. begin
  157. Result := FData;
  158. end;
  159. procedure TRJSONRoot.SetData(const AValue: TJValue);
  160. begin
  161. FData := AValue;
  162. end;
  163. function TRJSONRoot.ForceData(AType: TJVType): TJValue;
  164. begin
  165. if not(FData is AType) then
  166. begin
  167. FData.Free;
  168. FData := AType.Create;
  169. end;
  170. Result := FData;
  171. end;
  172. { TRJSONRoot }
  173. { ============================================================================ }
  174. { TJValueHelper }
  175. type
  176. TJValueHelper = class helper for TJValue
  177. private
  178. procedure ObjSetItem(const AName: string; const AValue: TJValue);
  179. procedure ArrFill<T: TJValue>(ACount: Integer);
  180. procedure ArrInsert(const AIndex: Integer; const AValue: TJValue);
  181. procedure ArrSetItem(AIndex: Integer; const AValue: TJValue);
  182. function ToType<T>(ADefault: T): T;
  183. function GetOrCreate<T: TJValue>(AName: string): T;
  184. procedure SetValue(const APath: string; const AValue: TJValue);
  185. procedure TrySetValue(const APath: string; const AValue: TJValue);
  186. end;
  187. procedure TJValueHelper.ObjSetItem(const AName: string; const AValue: TJValue);
  188. var
  189. pairTmp: TJSONPair;
  190. begin
  191. pairTmp := TJObject(self).Get(AName);
  192. if pairTmp = nil then
  193. TJObject(self).AddPair(AName, AValue)
  194. else
  195. pairTmp.JSONValue := AValue;
  196. end;
  197. procedure TJValueHelper.ArrFill<T>(ACount: Integer);
  198. begin
  199. for var j := TJArray(self).Count to ACount do
  200. TJArray(self).AddElement(T.Create);
  201. end;
  202. procedure TJValueHelper.ArrInsert(const AIndex: Integer; const AValue: TJValue);
  203. begin
  204. TJArray(self).AddElement(AValue);
  205. for var I := AIndex to TJArray(self).Count - 2 do
  206. TJArray(self).AddElement(TJArray(self).Remove(AIndex));
  207. end;
  208. procedure TJValueHelper.ArrSetItem(AIndex: Integer; const AValue: TJValue);
  209. begin
  210. ArrFill<TJNull>(AIndex - 1);
  211. if AIndex <= TJArray(self).Count - 1 then
  212. TJArray(self).Remove(AIndex).Free;
  213. ArrInsert(AIndex, AValue);
  214. end;
  215. procedure TJValueHelper.SetValue(const APath: string; const AValue: TJValue);
  216. var
  217. LParser: TJSONPathParser;
  218. preName: string;
  219. jv: TJValue;
  220. begin
  221. if APath.IsEmpty then
  222. raise Exception.Create('TJValueHelper.SetValue: path cannot be empty');
  223. jv := self;
  224. LParser := TJSONPathParser.Create(APath);
  225. LParser.NextToken;
  226. while true do
  227. begin
  228. preName := LParser.TokenName;
  229. LParser.NextToken;
  230. case LParser.Token of
  231. TJSONPathParser.TToken.Name:
  232. jv := jv.GetOrCreate<TJObject>(preName);
  233. TJSONPathParser.TToken.ArrayIndex:
  234. jv := jv.GetOrCreate<TJArray>(preName);
  235. TJSONPathParser.TToken.Eof:
  236. begin
  237. if jv is TJObject then
  238. jv.ObjSetItem(preName, AValue)
  239. else
  240. jv.ArrSetItem(preName.ToInteger, AValue);
  241. break;
  242. end;
  243. else
  244. raise Exception.Create('TJValueHelper.SetValue, LParser.Token Error!');
  245. end;
  246. end;
  247. end;
  248. procedure TJValueHelper.TrySetValue(const APath: string; const AValue: TJValue);
  249. begin
  250. try
  251. SetValue(APath, AValue);
  252. except
  253. on E: Exception do
  254. begin
  255. AValue.Free;
  256. raise Exception.Create(E.Message);
  257. end;
  258. end;
  259. end;
  260. function TJValueHelper.ToType<T>(ADefault: T): T;
  261. begin
  262. if self = nil then
  263. Exit(ADefault);
  264. try
  265. Result := AsType<T>;
  266. except
  267. Result := ADefault;
  268. end;
  269. end;
  270. function TJValueHelper.GetOrCreate<T>(AName: string): T;
  271. begin
  272. if self is TJObject then
  273. begin
  274. Result := T(TJObject(self).GetValue(AName));
  275. if not(Result is T) then
  276. begin
  277. Result := T.Create;
  278. ObjSetItem(AName, Result);
  279. end;
  280. end
  281. else if self is TJArray then
  282. begin
  283. ArrFill<TJNull>(AName.ToInteger);
  284. Result := T(TJArray(self).Items[AName.ToInteger]);
  285. if not(Result is T) then
  286. begin
  287. Result := T.Create;
  288. ArrSetItem(AName.ToInteger, Result);
  289. end;
  290. end
  291. else
  292. begin
  293. raise Exception.Create('GetOrCreate<T> Error, self must be TJO or TJA');
  294. end;
  295. end;
  296. { TJValueHelper }
  297. { ============================================================================ }
  298. { TRPath }
  299. class operator TRPath.Implicit(const Value: string): TRPath;
  300. begin
  301. Result.FData := Value;
  302. end;
  303. class operator TRPath.Implicit(Value: Integer): TRPath;
  304. begin
  305. Result.FData := '[' + Value.ToString + ']';
  306. end;
  307. class operator TRPath.Implicit(const [ref] Value: TRPath): string;
  308. begin
  309. Result := Value.FData;
  310. end;
  311. { TRPath }
  312. { ============================================================================ }
  313. { TRJSONEnumerator }
  314. constructor TRJSONEnumerator.Create(const [ref] AData: TRJSON);
  315. begin
  316. inherited Create;
  317. FPData := @AData;
  318. FIndex := -1;
  319. end;
  320. function TRJSONEnumerator.GetCurrent: TRJSON;
  321. var
  322. jvTmp: TJValue;
  323. begin
  324. Result.Reset;
  325. Result.FIRoot := FPData^.FIRoot;
  326. jvTmp := FPData^.GetJValue;
  327. if jvTmp is TJObject then
  328. begin
  329. if FPData^.FPath = '' then
  330. Result.FPath := TJObject(jvTmp).Pairs[FIndex].JsonString.Value
  331. else
  332. Result.FPath := FPData^.FPath + '.' + TJObject(jvTmp).Pairs[FIndex].JsonString.Value;
  333. end
  334. else if jvTmp is TJArray then
  335. begin
  336. Result.FPath := FPData^.FPath + '[' + FIndex.ToString + ']';
  337. end;
  338. end;
  339. function TRJSONEnumerator.MoveNext: Boolean;
  340. begin
  341. Inc(FIndex);
  342. Exit(FIndex < FPData^.Count)
  343. end;
  344. { TRJSONEnumerator }
  345. { ============================================================================ }
  346. { TRJSON }
  347. function TRJSON.GetEnumerator(): TRJSONEnumerator;
  348. begin
  349. Result := TRJSONEnumerator.Create(self);
  350. end;
  351. class operator TRJSON.Initialize(out Dest: TRJSON);
  352. begin
  353. Dest.FIRoot := TRJSONRoot.Create;
  354. Dest.FPath := '';
  355. end;
  356. class operator TRJSON.Finalize(var Dest: TRJSON);
  357. begin
  358. Dest.FIRoot := nil;
  359. end;
  360. function TRJSON.GetRootRefCount: Integer;
  361. begin
  362. Result := (FIRoot as TRJSONRoot).RefCount;
  363. end;
  364. function TRJSON.ForceRootJValue(const APath: string): TJValue;
  365. begin
  366. if APath.StartsWith('[') then
  367. Result := FIRoot.ForceData(TJArray)
  368. else
  369. Result := FIRoot.ForceData(TJObject);
  370. end;
  371. function TRJSON.LinkPath(const ALeft, ARight: string): string;
  372. begin
  373. if ALeft.IsEmpty then
  374. Result := ARight
  375. else if ARight.IsEmpty then
  376. Result := ALeft
  377. else if ARight.StartsWith('[') then
  378. Result := ALeft + ARight
  379. else
  380. Result := ALeft + '.' + ARight;
  381. end;
  382. function TRJSON.GetJValue: TJValue;
  383. begin
  384. Result := FIRoot.Data.FindValue(FPath);
  385. end;
  386. function TRJSON.CloneJValue: TJValue;
  387. begin
  388. Result := GetJValue;
  389. if Result <> nil then
  390. Result := Result.Clone as TJValue
  391. else
  392. Result := TJNull.Create;
  393. end;
  394. class operator TRJSON.Assign(var Dest: TRJSON; const [ref] Src: TRJSON);
  395. begin
  396. if Dest.FPath.IsEmpty then
  397. begin
  398. Dest.FIRoot := Src.FIRoot;
  399. Dest.FPath := Src.FPath;
  400. end
  401. else
  402. begin
  403. Dest.SetValue(Src);
  404. end;
  405. end;
  406. class operator TRJSON.Implicit(const Value: string): TRJSON;
  407. begin
  408. Result.FIRoot.Data := TJString.Create(Value);
  409. end;
  410. class operator TRJSON.Implicit(const [ref] Value: TRJSON): string;
  411. begin
  412. Result := Value.ToStr('');
  413. end;
  414. class operator TRJSON.Implicit(Value: Integer): TRJSON;
  415. begin
  416. Result.FIRoot.Data := TJNumber.Create(Value);
  417. end;
  418. class operator TRJSON.Implicit(const [ref] Value: TRJSON): Integer;
  419. begin
  420. Result := Value.ToInt(0);
  421. end;
  422. class operator TRJSON.Implicit(Value: Int64): TRJSON;
  423. begin
  424. Result.FIRoot.Data := TJNumber.Create(Value);
  425. end;
  426. class operator TRJSON.Implicit(const [ref] Value: TRJSON): Int64;
  427. begin
  428. Result := Value.ToInt64(0);
  429. end;
  430. class operator TRJSON.Implicit(Value: Extended): TRJSON;
  431. begin
  432. Result.FIRoot.Data := TJNumber.Create(Value);
  433. end;
  434. class operator TRJSON.Implicit(const [ref] Value: TRJSON): Extended;
  435. begin
  436. Result := Value.ToFloat(0.0);
  437. end;
  438. class operator TRJSON.Implicit(Value: Boolean): TRJSON;
  439. begin
  440. Result.FIRoot.Data := TJBool.Create(Value);
  441. end;
  442. class operator TRJSON.Implicit(const [ref] Value: TRJSON): Boolean;
  443. begin
  444. Result := Value.ToBool(False);
  445. end;
  446. class operator TRJSON.Implicit(const Value: TJValue): TRJSON;
  447. begin
  448. Result.FIRoot.Data := Value;
  449. end;
  450. class operator TRJSON.Implicit(const [ref] Value: TRJSON): TJValue;
  451. begin
  452. Result := Value.GetJValue;
  453. end;
  454. function TRJSON.ToStr(const ADefault: string): string;
  455. begin
  456. Result := FIRoot.Data.FindValue(FPath).ToType<string>(ADefault);
  457. end;
  458. function TRJSON.ToInt(ADefault: Integer = 0): Integer;
  459. begin
  460. Result := FIRoot.Data.FindValue(FPath).ToType<Integer>(ADefault);
  461. end;
  462. function TRJSON.ToInt64(ADefault: Int64 = 0): Int64;
  463. begin
  464. Result := FIRoot.Data.FindValue(FPath).ToType<Int64>(ADefault);
  465. end;
  466. function TRJSON.ToFloat(ADefault: Extended = 0.0): Extended;
  467. begin
  468. Result := FIRoot.Data.FindValue(FPath).ToType<Extended>(ADefault);
  469. end;
  470. function TRJSON.ToBool(ADefault: Boolean = False): Boolean;
  471. begin
  472. Result := FIRoot.Data.FindValue(FPath).ToType<Boolean>(ADefault);
  473. end;
  474. function TRJSON.GetItems(const APath: TRPath): TRJSON;
  475. begin
  476. Result.FIRoot := FIRoot;
  477. Result.FPath := LinkPath(FPath, APath);
  478. end;
  479. function TRJSON.GetPairs(AIndex: Integer): TRJSON;
  480. var
  481. jvTmp: TJValue;
  482. begin
  483. jvTmp := GetJValue;
  484. if (jvTmp is TJObject) then
  485. Result := GetItems(TJObject(jvTmp).Pairs[AIndex].JsonString.Value);
  486. end;
  487. procedure TRJSON.SetValue(const [ref] AValue: TRJSON);
  488. var
  489. LValue: TJValue;
  490. begin
  491. {$IFDEF DEBUG}
  492. if FPath.IsEmpty then
  493. raise Exception.Create(' TRJSON.SetValue: Path is empty');
  494. {$ENDIF}
  495. LValue := AValue.CloneJValue;
  496. try
  497. ForceRootJValue(FPath).SetValue(FPath, LValue);
  498. except
  499. on E: Exception do
  500. begin
  501. LValue.Free;
  502. raise Exception.Create(E.Message);
  503. end;
  504. end;
  505. end;
  506. procedure TRJSON.SetItems(const APath: TRPath; const [ref] AValue: TRJSON);
  507. var
  508. tmp: TRJSON;
  509. begin
  510. tmp.FIRoot := FIRoot;
  511. tmp.FPath := LinkPath(FPath, APath);
  512. tmp.SetValue(AValue)
  513. end;
  514. function TRJSON.GetS(const APath: TRPath): string;
  515. var
  516. LPath: string;
  517. begin
  518. LPath := LinkPath(FPath, APath);
  519. Result := ForceRootJValue(LPath).FindValue(LPath).ToType<string>('');
  520. end;
  521. procedure TRJSON.SetS(const APath: TRPath; AValue: string);
  522. var
  523. LPath: string;
  524. begin
  525. LPath := LinkPath(FPath, APath);
  526. ForceRootJValue(LPath).TrySetValue(LPath, TJString.Create(AValue));
  527. end;
  528. function TRJSON.GetI(const APath: TRPath): Integer;
  529. var
  530. LPath: string;
  531. begin
  532. LPath := LinkPath(FPath, APath);
  533. Result := ForceRootJValue(LPath).FindValue(LPath).ToType<Integer>(0);
  534. end;
  535. procedure TRJSON.SetI(const APath: TRPath; AValue: Integer);
  536. var
  537. LPath: string;
  538. begin
  539. LPath := LinkPath(FPath, APath);
  540. ForceRootJValue(LPath).TrySetValue(LPath, TJNumber.Create(AValue));
  541. end;
  542. function TRJSON.GetI64(const APath: TRPath): Int64;
  543. var
  544. LPath: string;
  545. begin
  546. LPath := LinkPath(FPath, APath);
  547. Result := ForceRootJValue(LPath).FindValue(LPath).ToType<Int64>(0);
  548. end;
  549. procedure TRJSON.SetI64(const APath: TRPath; AValue: Int64);
  550. var
  551. LPath: string;
  552. begin
  553. LPath := LinkPath(FPath, APath);
  554. ForceRootJValue(LPath).TrySetValue(LPath, TJNumber.Create(AValue));
  555. end;
  556. function TRJSON.GetF(const APath: TRPath): Extended;
  557. var
  558. LPath: string;
  559. begin
  560. LPath := LinkPath(FPath, APath);
  561. Result := ForceRootJValue(LPath).FindValue(LPath).ToType<Extended>(0.0);
  562. end;
  563. procedure TRJSON.SetF(const APath: TRPath; AValue: Extended);
  564. var
  565. LPath: string;
  566. begin
  567. LPath := LinkPath(FPath, APath);
  568. ForceRootJValue(LPath).TrySetValue(LPath, TJNumber.Create(AValue));
  569. end;
  570. function TRJSON.GetB(const APath: TRPath): Boolean;
  571. var
  572. LPath: string;
  573. begin
  574. LPath := LinkPath(FPath, APath);
  575. Result := ForceRootJValue(LPath).FindValue(LPath).ToType<Boolean>(False);
  576. end;
  577. procedure TRJSON.SetB(const APath: TRPath; AValue: Boolean);
  578. var
  579. LPath: string;
  580. begin
  581. LPath := LinkPath(FPath, APath);
  582. ForceRootJValue(LPath).TrySetValue(LPath, TJBool.Create(AValue));
  583. end;
  584. function TRJSON.GetCount: Integer;
  585. var
  586. jvTemp: TJValue;
  587. begin
  588. jvTemp := GetJValue;
  589. if jvTemp is TJArray then
  590. Result := TJArray(jvTemp).Count
  591. else if jvTemp is TJObject then
  592. Result := TJObject(jvTemp).Count
  593. else
  594. Result := 0;
  595. end;
  596. function TRJSON.GetLastPath: string;
  597. begin
  598. Result := Key;
  599. if Result.IsEmpty then
  600. begin
  601. Result := '[' + Index.ToString + ']';
  602. if Result = '[-1]' then
  603. Result := '';
  604. end;
  605. end;
  606. function TRJSON.GetIndex: Integer;
  607. var
  608. strTmp: string;
  609. begin
  610. Result := -1;
  611. strTmp := FPath.Substring(FPath.LastIndexOf('[') + 1);
  612. if strTmp.EndsWith(']') then
  613. Result := StrToIntDef(strTmp.TrimRight([']']), -1);
  614. end;
  615. function TRJSON.GetKey: string;
  616. begin
  617. Result := FPath.Substring(FPath.LastIndexOf('.') + 1);
  618. if Result.EndsWith(']') then
  619. Result := '';
  620. end;
  621. function TRJSON.GetRoot: TRJSON;
  622. begin
  623. Result.FIRoot := FIRoot;
  624. // Result.FPath := '';
  625. end;
  626. function TRJSON.IsRoot: Boolean;
  627. begin
  628. Result := FPath.IsEmpty;
  629. end;
  630. function TRJSON.RootIsJObject: Boolean;
  631. begin
  632. Result := FIRoot.Data is TJObject;
  633. end;
  634. function TRJSON.RootIsJArray: Boolean;
  635. begin
  636. Result := FIRoot.Data is TJArray;
  637. end;
  638. function TRJSON.IsJObject: Boolean;
  639. begin
  640. Result := GetJValue is TJObject;
  641. end;
  642. function TRJSON.IsJArray: Boolean;
  643. begin
  644. Result := GetJValue is TJArray;
  645. end;
  646. function TRJSON.IsJString: Boolean;
  647. begin
  648. Result := GetJValue is TJString;
  649. end;
  650. function TRJSON.IsJNumber: Boolean;
  651. begin
  652. Result := GetJValue is TJNumber;
  653. end;
  654. function TRJSON.IsJBool: Boolean;
  655. begin
  656. Result := GetJValue is TJBool;
  657. end;
  658. function TRJSON.IsJNull: Boolean;
  659. begin
  660. Result := GetJValue is TJNull;
  661. end;
  662. function TRJSON.IsNil: Boolean;
  663. begin
  664. Result := GetJValue = nil;
  665. end;
  666. procedure TRJSON.Reset;
  667. begin
  668. FIRoot := TRJSONRoot.Create;
  669. FPath := '';
  670. end;
  671. function TRJSON.ToJSON(AEncodeBelow32: Boolean = true; AEncodeAbove127: Boolean = true): string;
  672. var
  673. LValue: TJValue;
  674. Options: TJSONAncestor.TJSONOutputOptions;
  675. begin
  676. Result := '';
  677. LValue := GetJValue;
  678. if LValue <> nil then
  679. begin
  680. Options := [];
  681. if AEncodeBelow32 then
  682. Include(Options, TJSONAncestor.TJSONOutputOption.EncodeBelow32);
  683. if AEncodeAbove127 then
  684. Include(Options, TJSONAncestor.TJSONOutputOption.EncodeAbove127);
  685. Result := LValue.ToJSON(Options);
  686. end;
  687. end;
  688. function TRJSON.ToString: string;
  689. begin
  690. //Result := ToJSON(False, False);
  691. Result := GetJValue.ToString;
  692. end;
  693. function JSONToUniCode(const AStr: string; AEncodeBelow32: Boolean = true; AEncodeAbove127: Boolean = true): string;
  694. var
  695. ch: char;
  696. I: Integer;
  697. UnicodeValue: Integer;
  698. Buff: array [0 .. 5] of char;
  699. begin
  700. for I := 1 to AStr.Length do
  701. begin
  702. ch := AStr[I];
  703. case ch of
  704. #0 .. #7, #$b, #$e .. #31, #$0080 .. High(char):
  705. begin
  706. UnicodeValue := Ord(ch);
  707. if AEncodeBelow32 and (UnicodeValue < 32) or AEncodeAbove127 and (UnicodeValue > 127) then
  708. begin
  709. Buff[0] := '\';
  710. Buff[1] := 'u';
  711. Buff[2] := char(DecimalToHex((UnicodeValue and 61440) shr 12));
  712. Buff[3] := char(DecimalToHex((UnicodeValue and 3840) shr 8));
  713. Buff[4] := char(DecimalToHex((UnicodeValue and 240) shr 4));
  714. Buff[5] := char(DecimalToHex((UnicodeValue and 15)));
  715. Result := Result + Buff;
  716. end
  717. else
  718. begin
  719. Result := Result + ch;
  720. end;
  721. end
  722. else
  723. begin
  724. Result := Result + ch;
  725. end;
  726. end;
  727. end;
  728. end;
  729. function TRJSON.Format(AIndentation: Integer; AEncodeBelow32: Boolean; AEncodeAbove127: Boolean): string;
  730. var
  731. LValue: TJValue;
  732. begin
  733. if AIndentation >= 0 then
  734. begin
  735. Result := '';
  736. LValue := GetJValue;
  737. if LValue <> nil then
  738. begin
  739. Result := LValue.Format(AIndentation);
  740. if AEncodeBelow32 or AEncodeAbove127 then
  741. begin
  742. Result := JSONToUniCode(Result, AEncodeBelow32, AEncodeAbove127);
  743. end;
  744. end;
  745. end
  746. else
  747. begin
  748. Result := ToJSON(AEncodeBelow32, AEncodeAbove127);
  749. end;
  750. end;
  751. function TRJSON.ParseJValue(const AData: string; AUseBool: Boolean; ARaiseExc: Boolean): Boolean;
  752. begin
  753. Reset;
  754. FIRoot.Data := TJValue.ParseJSONValue(AData, AUseBool, ARaiseExc);
  755. Result := FIRoot.Data <> nil;
  756. end;
  757. function TRJSON.LoadFromFile(const AFileName: string; AUseBool: Boolean; ARaiseExc: Boolean): Boolean;
  758. begin
  759. Result := False;
  760. Reset;
  761. try
  762. FIRoot.Data := TJValue.ParseJSONValue(TFile.ReadAllText(AFileName, TEncoding.UTF8), AUseBool, ARaiseExc);
  763. Result := FIRoot.Data <> nil;
  764. except
  765. on E: Exception do
  766. begin
  767. if ARaiseExc then
  768. raise Exception.Create(E.Message);
  769. end;
  770. end;
  771. end;
  772. procedure TRJSON.SaveToFile(const AFileName: string; AIndentation: Integer; AEncodeBelow32: Boolean; AEncodeAbove127: Boolean; AWriteBOM: Boolean);
  773. var
  774. strs: TStrings;
  775. begin
  776. strs := TStringList.Create;
  777. try
  778. strs.WriteBOM := AWriteBOM;
  779. strs.Text := Format(AIndentation, AEncodeBelow32, AEncodeAbove127);
  780. strs.SaveToFile(AFileName, TEncoding.UTF8);
  781. finally
  782. strs.Free;
  783. end;
  784. end;
  785. { TRJSON }
  786. { ============================================================================ }
  787. end.