1
0

rjson.pas 31 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201
  1. {
  2. TRJSON - JSON Simple Read and Write
  3. - v0.9.14
  4. - 2025-05-10 by gale
  5. - https://github.com/higale/RJSON
  6. }
  7. unit rjson;
  8. interface
  9. uses
  10. System.Classes, System.TypInfo, System.SysUtils, System.Json, FMX.Types,
  11. System.IOUtils, System.Generics.Collections;
  12. type
  13. TJObject = TJSONObject;
  14. TJArray = TJSONArray;
  15. TJPair = TJSONPair;
  16. TJValue = TJSONValue;
  17. TJString = TJSONString;
  18. TJNumber = TJSONNumber;
  19. TJBool = TJSONBool;
  20. TJTrue = TJSONTrue;
  21. TJFalse = TJSONFalse;
  22. TJNull = TJSONNull;
  23. TJVType = type of TJValue;
  24. IRJRoot = interface
  25. ['{486F1FA6-2CDD-4124-98C5-CE7C398B7143}']
  26. function GetData: TJValue;
  27. procedure SetData(const AValue: TJValue);
  28. function ForceData(AType: TJVType): TJValue;
  29. property Data: TJValue read GetData write SetData;
  30. end;
  31. TRJSONRoot = class(TInterfacedObject, IRJRoot)
  32. private
  33. FData: TJValue;
  34. function GetData: TJValue;
  35. procedure SetData(const AValue: TJValue);
  36. function ForceData(AType: TJVType): TJValue;
  37. public
  38. constructor Create;
  39. destructor Destroy; override;
  40. end;
  41. TRPath = record
  42. private
  43. FData: string;
  44. public
  45. class operator Implicit(const Value: string): TRPath;
  46. class operator Implicit(Value: Integer): TRPath;
  47. class operator Implicit(const [ref] Value: TRPath): string;
  48. end;
  49. TRJSONEnumerator = class;
  50. TRJSON = record
  51. private
  52. FIRoot: IRJRoot;
  53. FPath: string;
  54. function GetRootRefCount: Integer;
  55. function ForceRootJValue(const APath: string): TJValue;
  56. function LinkPath(const ALeft, ARight: string): string;
  57. function GetJValue: TJValue;
  58. function GetItems(const APath: TRPath): TRJSON;
  59. function GetPairs(AIndex: Integer): TRJSON;
  60. procedure SetValue(const [ref] AValue: TRJSON);
  61. procedure SetItems(const APath: TRPath; const [ref] AValue: TRJSON);
  62. function GetS(const APath: TRPath): string; overload;
  63. procedure SetS(const APath: TRPath; AValue: string); overload;
  64. function GetI(const APath: TRPath): Integer; overload;
  65. procedure SetI(const APath: TRPath; AValue: Integer); overload;
  66. function GetI64(const APath: TRPath): Int64; overload;
  67. procedure SetI64(const APath: TRPath; AValue: Int64); overload;
  68. function GetF(const APath: TRPath): Extended; overload;
  69. procedure SetF(const APath: TRPath; AValue: Extended); overload;
  70. function GetB(const APath: TRPath): Boolean; overload;
  71. procedure SetB(const APath: TRPath; AValue: Boolean); overload;
  72. function GetCount: Integer;
  73. function GetLastPath: string;
  74. function GetIndex: Integer;
  75. function GetKey: string;
  76. function GetRoot: TRJSON;
  77. function GetParent: TRJSON;
  78. public
  79. function GetEnumerator(): TRJSONEnumerator;
  80. class operator Initialize(out Dest: TRJSON);
  81. class operator Finalize(var Dest: TRJSON);
  82. class operator Assign(var Dest: TRJSON; const [ref] Src: TRJSON);
  83. class operator Implicit(const Value: string): TRJSON;
  84. class operator Implicit(const [ref] Value: TRJSON): string;
  85. class operator Implicit(Value: Integer): TRJSON;
  86. class operator Implicit(const [ref] Value: TRJSON): Integer;
  87. class operator Implicit(Value: Int64): TRJSON;
  88. class operator Implicit(const [ref] Value: TRJSON): Int64;
  89. class operator Implicit(Value: Extended): TRJSON;
  90. class operator Implicit(const [ref] Value: TRJSON): Extended;
  91. class operator Implicit(Value: Boolean): TRJSON;
  92. class operator Implicit(const [ref] Value: TRJSON): Boolean;
  93. class operator Implicit(const Value: TJValue): TRJSON;
  94. class operator Implicit(const [ref] Value: TRJSON): TJValue;
  95. function ToStr(const ADefault: string = ''): string;
  96. function ToInt(ADefault: Integer = 0): Integer;
  97. function ToInt64(ADefault: Int64 = 0): Int64;
  98. function ToFloat(ADefault: Extended = 0.0): Extended;
  99. function ToBool(ADefault: Boolean = False): Boolean;
  100. property Items[const APath: TRPath]: TRJSON read GetItems write SetItems; default;
  101. property S[const APath: TRPath]: string read GetS write SetS;
  102. property I[const APath: TRPath]: Integer read GetI write SetI;
  103. property I64[const APath: TRPath]: Int64 read GetI64 write SetI64;
  104. property F[const APath: TRPath]: Extended read GetF write SetF;
  105. property B[const APath: TRPath]: Boolean read GetB write SetB;
  106. property Pairs[AIndex: Integer]: TRJSON read GetPairs;
  107. property Count: Integer read GetCount;
  108. property LastPath: string read GetLastPath;
  109. property Index: Integer read GetIndex;
  110. property Key: string read GetKey;
  111. property RootRefCount: Integer read GetRootRefCount;
  112. property Root: TRJSON read GetRoot;
  113. property Parent: TRJSON read GetParent;
  114. property Path: string read FPath;
  115. property JValue: TJValue read GetJValue;
  116. function CloneJValue: TJValue;
  117. function IsRoot: Boolean; inline;
  118. function RootIsObject: Boolean; inline;
  119. function RootIsArray: Boolean; inline;
  120. function IsObject: Boolean;
  121. function IsArray: Boolean;
  122. function IsString: Boolean;
  123. function IsNumber: Boolean;
  124. function IsInt: Boolean;
  125. function IsInteger: Boolean;
  126. function IsFloat: Boolean;
  127. function IsBool: Boolean;
  128. function IsNull: Boolean;
  129. function IsNil: Boolean;
  130. function IsEmpty: Boolean;
  131. function ItemByValue(const [ref] AValue: TRJSON; AIgnoreCase: Boolean = True): TRJSON;
  132. function FirstItem: TRJSON;
  133. function LastItem: TRJSON;
  134. procedure MoveTo(AIndex: Integer);
  135. procedure Rename(AName: string);
  136. procedure MoveUp;
  137. procedure MoveDown;
  138. procedure MoveToFirst;
  139. procedure MoveToLast;
  140. procedure Add(const AValue: TRJSON);
  141. procedure Delete(AIndex: Integer); overload;
  142. procedure Delete; overload;
  143. procedure Reset;
  144. function ToJSON(AEncodeBelow32: Boolean = True; AEncodeAbove127: Boolean = True): string;
  145. function Format(AIndentation: Integer = 4; AEncodeBelow32: Boolean = False; AEncodeAbove127: Boolean = False): string;
  146. procedure ParseJValue(const AData: string; AUseBool: Boolean = False; ARaiseExc: Boolean = False);
  147. procedure LoadFromFile(const AFileName: string; AUseBool: Boolean = False; ARaiseExc: Boolean = False);
  148. procedure SaveToFile(const AFileName: string; AIndentation: Integer = 4; AEncodeBelow32: Boolean = True; AEncodeAbove127: Boolean = False; AWriteBOM: Boolean = True);
  149. procedure LoadFromObject(const AObject: TObject; ARaiseExc: Boolean = False);
  150. procedure SetObjectProp(AObject: TObject; ARaiseExc: Boolean = False);
  151. end;
  152. { Iterators }
  153. TRJSONEnumerator = class
  154. private
  155. FPData: ^TRJSON;
  156. FIndex: Integer;
  157. function GetCurrent: TRJSON;
  158. public
  159. constructor Create(const [ref] AData: TRJSON);
  160. function MoveNext: Boolean;
  161. property Current: TRJSON read GetCurrent;
  162. end;
  163. implementation
  164. { ============================================================================ }
  165. { TRJSONRoot }
  166. constructor TRJSONRoot.Create;
  167. begin
  168. inherited;
  169. FData := nil;
  170. end;
  171. destructor TRJSONRoot.Destroy;
  172. begin
  173. FData.Free;
  174. inherited;
  175. end;
  176. function TRJSONRoot.GetData: TJValue;
  177. begin
  178. Result := FData;
  179. end;
  180. procedure TRJSONRoot.SetData(const AValue: TJValue);
  181. begin
  182. FData := AValue;
  183. end;
  184. function TRJSONRoot.ForceData(AType: TJVType): TJValue;
  185. begin
  186. if not(FData is AType) then
  187. begin
  188. FData.Free;
  189. FData := AType.Create;
  190. end;
  191. Result := FData;
  192. end;
  193. { TRJSONRoot }
  194. { ============================================================================ }
  195. { TJValueHelper TJObjectHelper TJArrayHelper}
  196. type
  197. TJValueHelper = class helper for TJValue
  198. private
  199. function ToType<T>(ADefault: T): T;
  200. function GetOrCreate<T: TJValue>(AName: string): T;
  201. procedure SetValue(const APath: string; const AValue: TJValue);
  202. procedure TrySetValue(const APath: string; const AValue: TJValue);
  203. end;
  204. TJObjectHelper = class helper for TJObject
  205. private
  206. procedure _SetItem(const AName: string; const AValue: TJValue); overload;
  207. // procedure _Insert(const AIndex: Integer; const AKey: string; const AValue: TJValue); overload;
  208. procedure _Insert(const AIndex: Integer; const AValue: TJPair); overload;
  209. end;
  210. TJArrayHelper = class helper for TJArray
  211. private
  212. procedure _Fill<T: TJValue>(ACount: Integer);
  213. procedure _Insert(const AIndex: Integer; const AValue: TJValue);
  214. procedure _SetItem(AIndex: Integer; const AValue: TJValue); overload;
  215. end;
  216. TJSONPairHelper = class helper for TJSONPair
  217. private
  218. procedure Rename(ANewName: string);
  219. end;
  220. procedure TJSONPairHelper.Rename(ANewName: string);
  221. begin
  222. SetJsonString(TJSONString.Create(ANewName));
  223. end;
  224. procedure TJArrayHelper._Fill<T>(ACount: Integer);
  225. begin
  226. for var j := Count to ACount do
  227. AddElement(T.Create);
  228. end;
  229. procedure TJArrayHelper._Insert(const AIndex: Integer; const AValue: TJValue);
  230. begin
  231. AddElement(AValue);
  232. for var I := AIndex to Count - 2 do
  233. AddElement(Remove(AIndex));
  234. end;
  235. procedure TJArrayHelper._SetItem(AIndex: Integer; const AValue: TJValue);
  236. begin
  237. _Fill<TJNull>(AIndex - 1);
  238. if AIndex <= Count - 1 then
  239. Remove(AIndex).Free;
  240. _Insert(AIndex, AValue);
  241. end;
  242. procedure TJValueHelper.SetValue(const APath: string; const AValue: TJValue);
  243. var
  244. LParser: TJSONPathParser;
  245. preName: string;
  246. jv: TJValue;
  247. begin
  248. if APath.IsEmpty then
  249. raise Exception.Create('TJValueHelper.SetValue: path cannot be empty');
  250. jv := self;
  251. LParser := TJSONPathParser.Create(APath);
  252. LParser.NextToken;
  253. while True do
  254. begin
  255. preName := LParser.TokenName;
  256. LParser.NextToken;
  257. case LParser.Token of
  258. TJSONPathParser.TToken.Name:
  259. jv := jv.GetOrCreate<TJObject>(preName);
  260. TJSONPathParser.TToken.ArrayIndex:
  261. jv := jv.GetOrCreate<TJArray>(preName);
  262. TJSONPathParser.TToken.Eof:
  263. begin
  264. if jv is TJObject then
  265. TJObject(jv)._SetItem(preName, AValue)
  266. else
  267. TJArray(jv)._SetItem(preName.ToInteger, AValue);
  268. break;
  269. end;
  270. else
  271. raise Exception.Create('TJValueHelper.SetValue, LParser.Token Error!');
  272. end;
  273. end;
  274. end;
  275. procedure TJValueHelper.TrySetValue(const APath: string; const AValue: TJValue);
  276. begin
  277. try
  278. SetValue(APath, AValue);
  279. except
  280. on E: Exception do
  281. begin
  282. AValue.Free;
  283. raise Exception.Create(E.Message);
  284. end;
  285. end;
  286. end;
  287. function TJValueHelper.ToType<T>(ADefault: T): T;
  288. begin
  289. if self = nil then
  290. Exit(ADefault);
  291. try
  292. Result := AsType<T>;
  293. except
  294. Result := ADefault;
  295. end;
  296. end;
  297. function TJValueHelper.GetOrCreate<T>(AName: string): T;
  298. begin
  299. if self is TJObject then
  300. begin
  301. Result := T(TJObject(self).GetValue(AName));
  302. if not(Result is T) then
  303. begin
  304. Result := T.Create;
  305. TJObject(self)._SetItem(AName, Result);
  306. end;
  307. end
  308. else if self is TJArray then
  309. begin
  310. TJArray(self)._Fill<TJNull>(AName.ToInteger);
  311. Result := T(TJArray(self).Items[AName.ToInteger]);
  312. if not(Result is T) then
  313. begin
  314. Result := T.Create;
  315. TJArray(self)._SetItem(AName.ToInteger, Result);
  316. end;
  317. end
  318. else
  319. begin
  320. raise Exception.Create('GetOrCreate<T> Error, self must be TJO or TJA');
  321. end;
  322. end;
  323. procedure TJObjectHelper._SetItem(const AName: string; const AValue: TJValue);
  324. var
  325. pairTmp: TJSONPair;
  326. begin
  327. pairTmp := Get(AName);
  328. if pairTmp = nil then
  329. AddPair(AName, AValue)
  330. else
  331. pairTmp.JSONValue := AValue;
  332. end;
  333. {procedure TJObjectHelper._Insert(const AIndex: Integer; const AKey: string; const AValue: TJValue);
  334. begin
  335. with self do
  336. begin
  337. FMembers.Insert(AIndex, TJSONPair.Create(AKey, AValue));
  338. end;
  339. end;}
  340. procedure TJObjectHelper._Insert(const AIndex: Integer; const AValue: TJPair);
  341. begin
  342. with self do
  343. begin
  344. FMembers.Insert(AIndex, AValue);
  345. end;
  346. end;
  347. { TJValueHelper TJObjectHelper TJArrayHelper}
  348. { ============================================================================ }
  349. { TRPath }
  350. class operator TRPath.Implicit(const Value: string): TRPath;
  351. begin
  352. Result.FData := Value;
  353. end;
  354. class operator TRPath.Implicit(Value: Integer): TRPath;
  355. begin
  356. Result.FData := '[' + Value.ToString + ']';
  357. end;
  358. class operator TRPath.Implicit(const [ref] Value: TRPath): string;
  359. begin
  360. Result := Value.FData;
  361. end;
  362. { TRPath }
  363. { ============================================================================ }
  364. { TRJSONEnumerator }
  365. constructor TRJSONEnumerator.Create(const [ref] AData: TRJSON);
  366. begin
  367. inherited Create;
  368. FPData := @AData;
  369. FIndex := -1;
  370. end;
  371. function TRJSONEnumerator.GetCurrent: TRJSON;
  372. var
  373. jvTmp: TJValue;
  374. begin
  375. Result.Reset;
  376. Result.FIRoot := FPData^.FIRoot;
  377. jvTmp := FPData^.GetJValue;
  378. if jvTmp is TJObject then
  379. begin
  380. if FPData^.FPath = '' then
  381. Result.FPath := TJObject(jvTmp).Pairs[FIndex].JsonString.Value
  382. else
  383. Result.FPath := FPData^.FPath + '.' + TJObject(jvTmp).Pairs[FIndex].JsonString.Value;
  384. end
  385. else if jvTmp is TJArray then
  386. begin
  387. Result.FPath := FPData^.FPath + '[' + FIndex.ToString + ']';
  388. end;
  389. end;
  390. function TRJSONEnumerator.MoveNext: Boolean;
  391. begin
  392. Inc(FIndex);
  393. Exit(FIndex < FPData^.Count)
  394. end;
  395. { TRJSONEnumerator }
  396. { ============================================================================ }
  397. { TRJSON }
  398. function TRJSON.GetEnumerator(): TRJSONEnumerator;
  399. begin
  400. Result := TRJSONEnumerator.Create(self);
  401. end;
  402. class operator TRJSON.Initialize(out Dest: TRJSON);
  403. begin
  404. Dest.FIRoot := TRJSONRoot.Create;
  405. Dest.FPath := '';
  406. end;
  407. class operator TRJSON.Finalize(var Dest: TRJSON);
  408. begin
  409. Dest.FIRoot := nil;
  410. end;
  411. function TRJSON.GetRootRefCount: Integer;
  412. begin
  413. Result := (FIRoot as TRJSONRoot).RefCount;
  414. end;
  415. function TRJSON.ForceRootJValue(const APath: string): TJValue;
  416. begin
  417. if APath.StartsWith('[') then
  418. Result := FIRoot.ForceData(TJArray)
  419. else
  420. Result := FIRoot.ForceData(TJObject);
  421. end;
  422. function TRJSON.LinkPath(const ALeft, ARight: string): string;
  423. begin
  424. if ALeft.IsEmpty then
  425. Result := ARight
  426. else if ARight.IsEmpty then
  427. Result := ALeft
  428. else if ARight.StartsWith('[') then
  429. Result := ALeft + ARight
  430. else
  431. Result := ALeft + '.' + ARight;
  432. end;
  433. function TRJSON.GetJValue: TJValue;
  434. begin
  435. Result := FIRoot.Data.FindValue(FPath);
  436. end;
  437. function TRJSON.CloneJValue: TJValue;
  438. var
  439. LValue: TJValue;
  440. begin
  441. LValue := GetJValue;
  442. if LValue <> nil then
  443. Exit(TJValue(LValue.Clone));
  444. Result := nil;
  445. end;
  446. class operator TRJSON.Assign(var Dest: TRJSON; const [ref] Src: TRJSON);
  447. begin
  448. if Dest.FPath.IsEmpty then
  449. begin
  450. Dest.FIRoot := Src.FIRoot;
  451. Dest.FPath := Src.FPath;
  452. end
  453. else
  454. begin
  455. Dest.SetValue(Src);
  456. end;
  457. end;
  458. class operator TRJSON.Implicit(const Value: string): TRJSON;
  459. begin
  460. Result.FIRoot.Data := TJString.Create(Value);
  461. end;
  462. class operator TRJSON.Implicit(const [ref] Value: TRJSON): string;
  463. begin
  464. Result := Value.ToStr('');
  465. end;
  466. class operator TRJSON.Implicit(Value: Integer): TRJSON;
  467. begin
  468. Result.FIRoot.Data := TJNumber.Create(Value);
  469. end;
  470. class operator TRJSON.Implicit(const [ref] Value: TRJSON): Integer;
  471. begin
  472. Result := Value.ToInt(0);
  473. end;
  474. class operator TRJSON.Implicit(Value: Int64): TRJSON;
  475. begin
  476. Result.FIRoot.Data := TJNumber.Create(Value);
  477. end;
  478. class operator TRJSON.Implicit(const [ref] Value: TRJSON): Int64;
  479. begin
  480. Result := Value.ToInt64(0);
  481. end;
  482. class operator TRJSON.Implicit(Value: Extended): TRJSON;
  483. begin
  484. Result.FIRoot.Data := TJNumber.Create(Value);
  485. end;
  486. class operator TRJSON.Implicit(const [ref] Value: TRJSON): Extended;
  487. begin
  488. Result := Value.ToFloat(0.0);
  489. end;
  490. class operator TRJSON.Implicit(Value: Boolean): TRJSON;
  491. begin
  492. Result.FIRoot.Data := TJBool.Create(Value);
  493. end;
  494. class operator TRJSON.Implicit(const [ref] Value: TRJSON): Boolean;
  495. begin
  496. Result := Value.ToBool(False);
  497. end;
  498. class operator TRJSON.Implicit(const Value: TJValue): TRJSON;
  499. begin
  500. Result.FIRoot.Data := Value;
  501. end;
  502. class operator TRJSON.Implicit(const [ref] Value: TRJSON): TJValue;
  503. begin
  504. Result := Value.GetJValue;
  505. end;
  506. function TRJSON.ToStr(const ADefault: string): string;
  507. begin
  508. Result := FIRoot.Data.FindValue(FPath).ToType<string>(ADefault);
  509. end;
  510. function TRJSON.ToInt(ADefault: Integer = 0): Integer;
  511. begin
  512. Result := FIRoot.Data.FindValue(FPath).ToType<Integer>(ADefault);
  513. end;
  514. function TRJSON.ToInt64(ADefault: Int64 = 0): Int64;
  515. begin
  516. Result := FIRoot.Data.FindValue(FPath).ToType<Int64>(ADefault);
  517. end;
  518. function TRJSON.ToFloat(ADefault: Extended = 0.0): Extended;
  519. begin
  520. Result := FIRoot.Data.FindValue(FPath).ToType<Extended>(ADefault);
  521. end;
  522. function TRJSON.ToBool(ADefault: Boolean = False): Boolean;
  523. begin
  524. Result := FIRoot.Data.FindValue(FPath).ToType<Boolean>(ADefault);
  525. end;
  526. function TRJSON.GetItems(const APath: TRPath): TRJSON;
  527. begin
  528. Result.FIRoot := FIRoot;
  529. Result.FPath := LinkPath(FPath, APath);
  530. end;
  531. function TRJSON.GetPairs(AIndex: Integer): TRJSON;
  532. var
  533. jvTmp: TJValue;
  534. begin
  535. jvTmp := GetJValue;
  536. if (jvTmp is TJObject) then
  537. Result := GetItems(TJObject(jvTmp).Pairs[AIndex].JsonString.Value);
  538. end;
  539. procedure TRJSON.SetValue(const [ref] AValue: TRJSON);
  540. var
  541. LValue: TJValue;
  542. begin
  543. LValue := AValue.CloneJValue;
  544. if LValue = nil then
  545. LValue := TJNull.Create;
  546. try
  547. ForceRootJValue(FPath).SetValue(FPath, LValue);
  548. except
  549. on E: Exception do
  550. begin
  551. LValue.Free;
  552. raise Exception.Create(E.Message);
  553. end;
  554. end;
  555. end;
  556. procedure TRJSON.SetItems(const APath: TRPath; const [ref] AValue: TRJSON);
  557. var
  558. tmp: TRJSON;
  559. begin
  560. tmp.FIRoot := FIRoot;
  561. tmp.FPath := LinkPath(FPath, APath);
  562. tmp.SetValue(AValue)
  563. end;
  564. function TRJSON.GetS(const APath: TRPath): string;
  565. var
  566. LPath: string;
  567. begin
  568. LPath := LinkPath(FPath, APath);
  569. Result := ForceRootJValue(LPath).FindValue(LPath).ToType<string>('');
  570. end;
  571. procedure TRJSON.SetS(const APath: TRPath; AValue: string);
  572. var
  573. LPath: string;
  574. begin
  575. LPath := LinkPath(FPath, APath);
  576. ForceRootJValue(LPath).TrySetValue(LPath, TJString.Create(AValue));
  577. end;
  578. function TRJSON.GetI(const APath: TRPath): Integer;
  579. var
  580. LPath: string;
  581. begin
  582. LPath := LinkPath(FPath, APath);
  583. Result := ForceRootJValue(LPath).FindValue(LPath).ToType<Integer>(0);
  584. end;
  585. procedure TRJSON.SetI(const APath: TRPath; AValue: Integer);
  586. var
  587. LPath: string;
  588. begin
  589. LPath := LinkPath(FPath, APath);
  590. ForceRootJValue(LPath).TrySetValue(LPath, TJNumber.Create(AValue));
  591. end;
  592. function TRJSON.GetI64(const APath: TRPath): Int64;
  593. var
  594. LPath: string;
  595. begin
  596. LPath := LinkPath(FPath, APath);
  597. Result := ForceRootJValue(LPath).FindValue(LPath).ToType<Int64>(0);
  598. end;
  599. procedure TRJSON.SetI64(const APath: TRPath; AValue: Int64);
  600. var
  601. LPath: string;
  602. begin
  603. LPath := LinkPath(FPath, APath);
  604. ForceRootJValue(LPath).TrySetValue(LPath, TJNumber.Create(AValue));
  605. end;
  606. function TRJSON.GetF(const APath: TRPath): Extended;
  607. var
  608. LPath: string;
  609. begin
  610. LPath := LinkPath(FPath, APath);
  611. Result := ForceRootJValue(LPath).FindValue(LPath).ToType<Extended>(0.0);
  612. end;
  613. procedure TRJSON.SetF(const APath: TRPath; AValue: Extended);
  614. var
  615. LPath: string;
  616. begin
  617. LPath := LinkPath(FPath, APath);
  618. ForceRootJValue(LPath).TrySetValue(LPath, TJNumber.Create(AValue));
  619. end;
  620. function TRJSON.GetB(const APath: TRPath): Boolean;
  621. var
  622. LPath: string;
  623. begin
  624. LPath := LinkPath(FPath, APath);
  625. Result := ForceRootJValue(LPath).FindValue(LPath).ToType<Boolean>(False);
  626. end;
  627. procedure TRJSON.SetB(const APath: TRPath; AValue: Boolean);
  628. var
  629. LPath: string;
  630. begin
  631. LPath := LinkPath(FPath, APath);
  632. ForceRootJValue(LPath).TrySetValue(LPath, TJBool.Create(AValue));
  633. end;
  634. function TRJSON.GetCount: Integer;
  635. var
  636. jvTemp: TJValue;
  637. begin
  638. jvTemp := GetJValue;
  639. if jvTemp is TJArray then
  640. Result := TJArray(jvTemp).Count
  641. else if jvTemp is TJObject then
  642. Result := TJObject(jvTemp).Count
  643. else
  644. Result := 0;
  645. end;
  646. function TRJSON.GetLastPath: string;
  647. begin
  648. if FPath.IsEmpty then
  649. Exit('');
  650. Result := Key;
  651. if Result.IsEmpty then
  652. begin
  653. Result := '[' + Index.ToString + ']';
  654. if Result = '[-1]' then
  655. Result := '';
  656. end;
  657. end;
  658. function TRJSON.GetIndex: Integer;
  659. var
  660. strTmp: string;
  661. begin
  662. Result := -1;
  663. strTmp := FPath.Substring(FPath.LastIndexOf('[') + 1);
  664. if strTmp.EndsWith(']') then
  665. Result := StrToIntDef(strTmp.TrimRight([']']), -1);
  666. end;
  667. function TRJSON.GetKey: string;
  668. begin
  669. Result := FPath.Substring(FPath.LastIndexOf('.') + 1);
  670. if Result.EndsWith(']') then
  671. Result := '';
  672. end;
  673. function TRJSON.GetRoot: TRJSON;
  674. begin
  675. Result.FIRoot := FIRoot;
  676. end;
  677. function TRJSON.GetParent: TRJSON;
  678. var
  679. iPos: Integer;
  680. begin
  681. if FPath.IsEmpty then
  682. Exit;
  683. iPos := FPath.LastIndexOfAny(['[', '.']);
  684. if iPos < 0 then
  685. Exit(Root);
  686. Result.FIRoot := FIRoot;
  687. Result.FPath := FPath.Substring(0, iPos);
  688. end;
  689. function TRJSON.IsRoot: Boolean;
  690. begin
  691. Result := FPath.IsEmpty;
  692. end;
  693. function TRJSON.RootIsObject: Boolean;
  694. begin
  695. Result := FIRoot.Data is TJObject;
  696. end;
  697. function TRJSON.RootIsArray: Boolean;
  698. begin
  699. Result := FIRoot.Data is TJArray;
  700. end;
  701. function TRJSON.IsObject: Boolean;
  702. begin
  703. Result := GetJValue is TJObject;
  704. end;
  705. function TRJSON.IsArray: Boolean;
  706. begin
  707. Result := GetJValue is TJArray;
  708. end;
  709. function TRJSON.IsString: Boolean;
  710. begin
  711. if JValue <> nil then
  712. Exit(JValue.ClassName = 'TJSONString');
  713. Result := False;
  714. end;
  715. function TRJSON.IsNumber: Boolean;
  716. begin
  717. Result := GetJValue is TJNumber;
  718. end;
  719. function TRJSON.IsInt: Boolean;
  720. begin
  721. if IsNumber then
  722. Exit(ToStr.IndexOf('.') < 0);
  723. Result := False;
  724. end;
  725. function TRJSON.IsInteger: Boolean;
  726. var
  727. LI64: Int64;
  728. begin
  729. if IsInt then
  730. begin
  731. LI64 := ToInt64;
  732. Exit((LI64 >= Integer.MinValue) and (LI64 <= Integer.MaxValue));
  733. end;
  734. Result := False;
  735. end;
  736. function TRJSON.IsFloat: Boolean;
  737. begin
  738. if IsNumber then
  739. Exit(ToStr.IndexOf('.') >= 0);
  740. Result := False;
  741. end;
  742. function TRJSON.IsBool: Boolean;
  743. begin
  744. Result := GetJValue is TJBool;
  745. end;
  746. function TRJSON.IsNull: Boolean;
  747. begin
  748. Result := GetJValue is TJNull;
  749. end;
  750. function TRJSON.IsNil: Boolean;
  751. begin
  752. Result := GetJValue = nil;
  753. end;
  754. function TRJSON.IsEmpty: Boolean;
  755. begin
  756. Result := FPath.IsEmpty and (FIRoot.Data = nil);
  757. end;
  758. function TRJSON.ItemByValue(const [ref] AValue: TRJSON; AIgnoreCase: Boolean): TRJSON;
  759. begin
  760. for var item in self do
  761. begin
  762. if AValue.JValue.ClassType = item.JValue.ClassType then
  763. if string.Compare(AValue.ToStr, item.ToStr, AIgnoreCase) = 0 then
  764. Exit(item);
  765. end;
  766. end;
  767. function TRJSON.FirstItem: TRJSON;
  768. begin
  769. if IsArray then
  770. Result := Items[0]
  771. else if IsObject then
  772. Result := Pairs[0]
  773. end;
  774. function TRJSON.LastItem: TRJSON;
  775. begin
  776. if IsArray then
  777. Result := Items[Count - 1]
  778. else if IsObject then
  779. Result := Pairs[Count - 1]
  780. end;
  781. procedure TRJSON.MoveTo(AIndex: Integer);
  782. var
  783. LParent: TJValue;
  784. LParentTmp: TRJSON;
  785. LValue: TRJSON;
  786. begin
  787. LParent := Parent.JValue;
  788. if (AIndex >= Parent.Count) or (AIndex < 0) then
  789. raise Exception.Create('Index out of bounds');
  790. if LParent is TJArray then
  791. begin
  792. TJArray(LParent)._Insert(AIndex, TJArray(LParent).Remove(Index));
  793. end
  794. else if LParent is TJObject then
  795. begin
  796. TJObject(LParent)._Insert(AIndex, TJObject(LParent).RemovePair(Key));
  797. end;
  798. end;
  799. procedure TRJSON.Rename(AName: string);
  800. begin
  801. if Parent.IsObject then
  802. TJObject(Parent.JValue).Get(Key).Rename(AName);
  803. if Parent.IsRoot then
  804. FPath := AName
  805. else
  806. FPath := FPath.Substring(0, FPath.LastIndexOf('.') + 1) + AName;
  807. end;
  808. procedure TRJSON.MoveUp;
  809. begin
  810. if Index > 0 then
  811. MoveTo(Index - 1);
  812. end;
  813. procedure TRJSON.MoveDown;
  814. begin
  815. if Index < Parent.Count - 1 then
  816. MoveTo(Index + 1);
  817. end;
  818. procedure TRJSON.MoveToFirst;
  819. begin
  820. MoveTo(0);
  821. end;
  822. procedure TRJSON.MoveToLast;
  823. begin
  824. MoveTo(Parent.Count - 1);
  825. end;
  826. procedure TRJSON.Add(const AValue: TRJSON);
  827. begin
  828. if IsArray then
  829. begin
  830. Items[Count] := AValue.CloneJValue;
  831. end
  832. else
  833. begin
  834. Items[0] := AValue.CloneJValue;
  835. end;
  836. end;
  837. procedure TRJSON.Delete(AIndex: Integer);
  838. begin
  839. if IsArray then
  840. begin
  841. TJArray(GetJValue).Remove(AIndex).Free;
  842. end;
  843. end;
  844. procedure TRJSON.Delete;
  845. var
  846. LParentValue: TJValue;
  847. begin
  848. if IsRoot then
  849. Reset;
  850. LParentValue := Parent.JValue;
  851. if LParentValue is TJObject then
  852. begin
  853. TJObject(LParentValue).RemovePair(Key).Free;
  854. end
  855. else if LParentValue is TJArray then
  856. begin
  857. TJArray(LParentValue).Remove(Index).Free;
  858. end;
  859. end;
  860. procedure TRJSON.Reset;
  861. begin
  862. FIRoot := TRJSONRoot.Create;
  863. FPath := '';
  864. end;
  865. function TRJSON.ToJSON(AEncodeBelow32: Boolean = True; AEncodeAbove127: Boolean = True): string;
  866. var
  867. LValue: TJValue;
  868. Options: TJSONAncestor.TJSONOutputOptions;
  869. begin
  870. Result := '';
  871. LValue := GetJValue;
  872. if LValue <> nil then
  873. begin
  874. Options := [];
  875. if AEncodeBelow32 then
  876. Include(Options, TJSONAncestor.TJSONOutputOption.EncodeBelow32);
  877. if AEncodeAbove127 then
  878. Include(Options, TJSONAncestor.TJSONOutputOption.EncodeAbove127);
  879. Result := LValue.ToJSON(Options);
  880. end;
  881. end;
  882. function JSONToUniCode(const AStr: string; AEncodeBelow32: Boolean = True; AEncodeAbove127: Boolean = True): string;
  883. var
  884. ch: char;
  885. I: Integer;
  886. UnicodeValue: Integer;
  887. Buff: array [0 .. 5] of char;
  888. begin
  889. for I := 1 to AStr.Length do
  890. begin
  891. ch := AStr[I];
  892. case ch of
  893. #0 .. #7, #$b, #$e .. #31, #$0080 .. High(char):
  894. begin
  895. UnicodeValue := Ord(ch);
  896. if AEncodeBelow32 and (UnicodeValue < 32) or AEncodeAbove127 and (UnicodeValue > 127) then
  897. begin
  898. Buff[0] := '\';
  899. Buff[1] := 'u';
  900. Buff[2] := char(DecimalToHex((UnicodeValue and 61440) shr 12));
  901. Buff[3] := char(DecimalToHex((UnicodeValue and 3840) shr 8));
  902. Buff[4] := char(DecimalToHex((UnicodeValue and 240) shr 4));
  903. Buff[5] := char(DecimalToHex((UnicodeValue and 15)));
  904. Result := Result + Buff;
  905. end
  906. else
  907. begin
  908. Result := Result + ch;
  909. end;
  910. end
  911. else
  912. begin
  913. Result := Result + ch;
  914. end;
  915. end;
  916. end;
  917. end;
  918. function TRJSON.Format(AIndentation: Integer; AEncodeBelow32: Boolean; AEncodeAbove127: Boolean): string;
  919. var
  920. LValue: TJValue;
  921. begin
  922. if AIndentation >= 0 then
  923. begin
  924. Result := '';
  925. LValue := GetJValue;
  926. if LValue <> nil then
  927. begin
  928. Result := LValue.Format(AIndentation);
  929. if AEncodeBelow32 or AEncodeAbove127 then
  930. begin
  931. Result := JSONToUniCode(Result, AEncodeBelow32, AEncodeAbove127);
  932. end;
  933. end;
  934. end
  935. else
  936. begin
  937. Result := ToJSON(AEncodeBelow32, AEncodeAbove127);
  938. end;
  939. end;
  940. procedure TRJSON.ParseJValue(const AData: string; AUseBool: Boolean; ARaiseExc: Boolean);
  941. begin
  942. self := TJValue.ParseJSONValue(AData, AUseBool, ARaiseExc);
  943. end;
  944. procedure TRJSON.LoadFromFile(const AFileName: string; AUseBool: Boolean; ARaiseExc: Boolean);
  945. begin
  946. try
  947. ParseJValue(TFile.ReadAllText(AFileName, TEncoding.UTF8), AUseBool, ARaiseExc);
  948. except
  949. on E: Exception do
  950. begin
  951. if ARaiseExc then
  952. raise Exception.Create(E.Message);
  953. end;
  954. end;
  955. end;
  956. procedure TRJSON.SaveToFile(const AFileName: string; AIndentation: Integer; AEncodeBelow32: Boolean; AEncodeAbove127: Boolean; AWriteBOM: Boolean);
  957. var
  958. strs: TStrings;
  959. begin
  960. strs := TStringList.Create;
  961. try
  962. strs.WriteBOM := AWriteBOM;
  963. strs.Text := Format(AIndentation, AEncodeBelow32, AEncodeAbove127);
  964. strs.SaveToFile(AFileName, TEncoding.UTF8);
  965. finally
  966. strs.Free;
  967. end;
  968. end;
  969. procedure TRJSON.LoadFromObject(const AObject: TObject; ARaiseExc: Boolean);
  970. var
  971. PropName: string;
  972. PropType: string;
  973. PropEnumName: string;
  974. propList: PPropList;
  975. PropValue: Variant;
  976. rjTmp: TRJSON;
  977. begin
  978. GetPropList(AObject.ClassInfo, propList);
  979. try
  980. for var I := 0 to GetTypeData(AObject.ClassInfo).propCount - 1 do
  981. begin
  982. try
  983. PropName := string(propList[I]^.Name);
  984. PropType := string(propList[I]^.PropType^.Name);
  985. PropEnumName := GetEnumName(TypeInfo(TTypeKind), Int64(propList[I]^.PropType^.Kind));
  986. PropValue := GetPropValue(AObject, PropName, True);
  987. // if PropType = 'TComponentName' then
  988. // Continue;
  989. if PropName = 'ActiveControl' then
  990. Continue;
  991. if propList[I]^.PropType^.Kind <> tkMethod then
  992. begin
  993. // rjTmp[PropName + '_dbg_inf'] := PropType + ' ' + PropEnumName;
  994. if (propList[I]^.PropType^.Kind <> tkClass) then
  995. begin
  996. if PropType = 'Int64' then
  997. rjTmp[PropName] := Int64(PropValue)
  998. else if PropType = 'Integer' then
  999. rjTmp[PropName] := Integer(PropValue)
  1000. else if PropType = 'Boolean' then
  1001. rjTmp[PropName] := Boolean(PropValue)
  1002. else if PropType = 'TAlphaColor' then
  1003. rjTmp[PropName] := '#' + {$IFDEF CPUX64}Int64{$ELSE}Integer{$ENDIF}(PropValue).ToHexString(8)
  1004. else
  1005. begin
  1006. case propList[I]^.PropType^.Kind of
  1007. tkInteger:
  1008. rjTmp[PropName] := {$IFDEF CPUX64}Int64{$ELSE}Integer{$ENDIF}(PropValue);
  1009. tkInt64:
  1010. rjTmp[PropName] := Int64(PropValue);
  1011. tkFloat:
  1012. rjTmp[PropName] := Extended(PropValue);
  1013. else // tkEnumeration, tkSet, tkUString
  1014. rjTmp[PropName] := string(PropValue);
  1015. end;
  1016. end;
  1017. end
  1018. else if PropValue <> 0 then
  1019. begin
  1020. rjTmp[PropName].LoadFromObject(TObject(StrToInt64(PropValue)));
  1021. end;
  1022. end;
  1023. except
  1024. on E: Exception do
  1025. if ARaiseExc then
  1026. raise Exception.Create(E.Message);
  1027. end;
  1028. end;
  1029. self := rjTmp;
  1030. finally
  1031. FreeMem(propList);
  1032. end;
  1033. end;
  1034. procedure TRJSON.SetObjectProp(AObject: TObject; ARaiseExc: Boolean);
  1035. var
  1036. PropName: string;
  1037. PropInfo: PPropInfo;
  1038. begin
  1039. for var item in self do
  1040. begin
  1041. if item.Key.EndsWith('_dbg_inf') then
  1042. Continue;
  1043. try
  1044. PropInfo := GetPropInfo(PTypeInfo(AObject.ClassInfo), item.Key);
  1045. if PropInfo = nil then
  1046. Continue;
  1047. PropName := string(PropInfo^.PropType^.Name);
  1048. if item.IsObject then
  1049. begin
  1050. if PropInfo^.PropType^.Kind = tkClass then
  1051. item.SetObjectProp(TObject({$IFDEF CPUX64}Int64{$ELSE}Integer{$ENDIF}(GetPropValue(AObject, item.Key))));
  1052. end
  1053. else
  1054. begin
  1055. if PropName = 'TAlphaColor' then
  1056. SetPropValue(AObject, item.Key, {$IFDEF CPUX64}StrToInt64{$ELSE}StrToUInt{$ENDIF}('$' + item.ToStr.Substring(1, 8)))
  1057. else
  1058. SetPropValue(AObject, item.Key, item.ToStr);
  1059. end;
  1060. except
  1061. on E: Exception do
  1062. if ARaiseExc then
  1063. raise Exception.Create(E.Message);
  1064. end;
  1065. end;
  1066. end;
  1067. { TRJSON }
  1068. { ============================================================================ }
  1069. end.