-
Notifications
You must be signed in to change notification settings - Fork 23
/
Copy pathBetter_JSON.pas
2920 lines (2581 loc) · 85.3 KB
/
Better_JSON.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{*******************************************************}
{ }
{ CodeGear Delphi Runtime Library }
{ }
{ Copyright(c) 2016 Embarcadero Technologies, Inc. }
{ All rights reserved }
{ }
{*******************************************************}
unit Better_JSON;
/// <summary>
/// System.JSON implements a TJson class that offers several convenience methods:
/// - converting Objects to Json and vice versa
/// - formating Json </summary>
interface
{$SCOPEDENUMS ON}
uses
System.SysUtils, System.Rtti, System.TypInfo, System.Generics.Collections,
System.Types;
type
TInt15 = 0..15;
TJSONValue = class;
TJSONString = class;
EJSONPathException = class(Exception);
/// <summary> Parses a JSON path with names and indexes.</summary>
/// <remarks>
/// The syntax to write paths is similar to XPath but in a Json way.
/// The following XPath expression:
/// /entities/urls[0]/indices[1]
/// would look like
/// entities.urls[0].indices[1] (dot notation)
/// or
/// entities["urls"][0]["indices"][1] (bracket notation)
///
/// The dot (.) token is used to access the object elements:
/// ex: object.key
///
/// The bracket ([]) token is used to access array or object elements:
/// In array: cities[0]
/// In object: city["name"] or city['name']
/// In object: ["city"]["name"] or ['city']['name']
///
/// The quote (" or ') is used to introduce a literal when the element is being written in bracket notation:
/// ex:["first"]["second"] or ['first']['second']
///
/// To escape the quote in a literal use backslash (\): \"
/// ex: ["quotes(\").should.be.escaped"] or ['quotes(\').should.be.escaped']
///
/// Note: The backslash will only escape quotes within a literal. Bracket notation can be useful when
/// names can not be written in dot notation, like the objects keys with dot characters:
/// ex: object["key.with.dots"] or object['key.with.dots']
///
/// </remarks>
TJSONPathParser = class
public type
TToken = (Undefined, Name, ArrayIndex, Eof, Error);
private
FPath: string;
FPos: Integer;
FTokenArrayIndex: Integer;
FToken: TToken;
FTokenName: string;
function GetIsEof: Boolean; inline;
procedure RaiseError(const AMsg: string); overload;
procedure RaiseErrorFmt(const AMsg: string; const AParams: array of const); overload;
procedure SetToken(const AToken: TToken); overload;
procedure SetToken(const AToken: TToken; const AValue); overload;
procedure ParseName;
procedure ParseQuotedName(AQuote: Char);
procedure ParseArrayIndex;
procedure ParseIndexer;
function EnsureLength(ALength: Integer): Boolean; inline;
procedure EatWhiteSpaces;
public
constructor Create(const APath: string);
function NextToken: TToken;
property IsEof: Boolean read GetIsEof;
property Token: TToken read FToken;
property TokenName: string read FTokenName;
property TokenArrayIndex: Integer read FTokenArrayIndex;
end;
/// <summary> JSON top level class. All specific classes are descendant of it.</summary>
/// <remarks> All specific classes are descendant of it. More on JSON can be found on www.json.org </remarks>
TJSONAncestor = class abstract
private
/// <summary> True if the instance is own by the container</summary>
FOwned: Boolean;
protected
/// <summary> Returns true if the instance represent JSON null value </summary>
/// <returns>true if the instance represents JSON null value</returns>
function IsNull: Boolean; virtual;
/// <summary> Method used by parser to re-constitute the JSON object structure </summary>
/// <param name="descendent">descendant to be added</param>
procedure AddDescendant(const Descendent: TJSONAncestor); virtual; abstract;
procedure SetOwned(const Own: Boolean); virtual;
public
/// <summary> Default constructor, sets owned flag to true </summary>
constructor Create;
/// <summary> Where appropriate, returns the instance representation as String </summary>
/// <returns>string representation, can be null</returns>
function Value: string; virtual;
/// <summary> Returns estimated byte size of current JSON object. The actual size is smaller</summary>
/// <remarks> The actual size is smaller</remarks>
/// <returns>integer - the byte size</returns>
function EstimatedByteSize: Integer; virtual; abstract;
/// <summary> Serializes the JSON object content into bytes. Returns the actual used size.
/// It assumes the byte container has sufficient capacity to store it. </summary>
/// <remarks> Returns the actual used size. It assumes the byte container has sufficient capacity to store it.
/// It is recommended that the container capacity is given by estimatedByteSize </remarks>
/// <param name="data">- byte container</param>
/// <param name="offset">- offset from which the object is serialized</param>
/// <returns>integer - the actual size used</returns>
function ToBytes(const Data: TArray<Byte>; const Offset: Integer): Integer; virtual; abstract;
function ToJSON: string;
/// <summary> Perform deep clone on current value</summary>
/// <returns>an exact copy of current instance</returns>
function Clone: TJSONAncestor; virtual; abstract;
function GetOwned: Boolean; virtual;
/// <summary> Returns true if the instance represent JSON null value </summary>
/// <returns>true if the instance represents JSON null value</returns>
property Null: Boolean read IsNull;
property Owned: Boolean write SetOwned;
end;
/// <summary> Generalizes byte consumption of JSON parser. It accommodates UTF8, default it</summary>
/// <remarks> It accommodates UTF8, default it assumes the content is generated by JSON toBytes method. </remarks>
TJSONByteReader = class
private
FData: TArray<Byte>;
FOffset: Integer;
FRange: Integer;
FIsUTF8: Boolean;
FUtf8data: TArray<Byte>;
FUtf8offset: Integer;
FUtf8length: Integer;
/// <summary> Consumes byte-order mark if any is present in the byte data </summary>
procedure ConsumeBOM;
procedure MoveOffset;
protected
function GetOffset: Integer; virtual;
public
constructor Create(const Data: TArray<Byte>; const Offset: Integer; const Range: Integer); overload;
constructor Create(const Data: TArray<Byte>; const Offset: Integer; const Range: Integer; const IsUTF8: Boolean); overload;
function ConsumeByte: Byte; virtual;
function PeekByte: Byte; virtual;
function Empty: Boolean; virtual;
function HasMore(const Size: Integer): Boolean; virtual;
property Offset: Integer read GetOffset;
end;
/// <summary> Signals a JSON exception, usually generated by parser code </summary>
EJSONException = class(Exception)
private
const FSerialVersionUID = 1964987864664789863;
public
constructor Create(const ErrorMessage: string);
end;
/// <summary> Implements JSON string : value </summary>
TJSONPair = class sealed(TJSONAncestor)
private
FJsonString: TJSONString;
FJsonValue: TJSONValue;
protected
/// <summary> see com.borland.dbx.transport.JSONAncestor#addDescendent(com.borland.dbx.transport.JSONAncestor) </summary>
procedure AddDescendant(const Descendant: TJSONAncestor); override;
/// <summary> Sets the pair's string value </summary>
/// <param name="descendant">string object cannot be null</param>
procedure SetJsonString(const Descendant: TJSONString);
/// <summary> Sets the pair's value member </summary>
/// <param name="val">string object cannot be null</param>
procedure SetJsonValue(const Val: TJSONValue);
/// <summary> Returns the pair's string. </summary>
/// <returns>JSONString - pair's string</returns>
function GetJsonString: TJSONString;
/// <summary> Returns the pair value. </summary>
/// <returns>JSONAncestor - pair's value</returns>
function GetJsonValue: TJSONValue;
public
constructor Create; overload;
/// <summary> Utility constructor providing pair members </summary>
/// <param name="str">- JSONString member, not null</param>
/// <param name="value">- JSONValue member, never null</param>
constructor Create(const Str: TJSONString; const Value: TJSONValue); overload;
/// <summary> Convenience constructor. Parameters will be converted into JSON equivalents</summary>
/// <remarks> Parameters will be converted into JSON equivalents </remarks>
/// <param name="str">- string member</param>
/// <param name="value">- JSON value</param>
constructor Create(const Str: string; const Value: TJSONValue); overload;
/// <summary> Convenience constructor. Parameters are converted into JSON strings pair </summary>
/// <remarks> Parameters are converted into JSON strings pair </remarks>
/// <param name="str">- string member</param>
/// <param name="value">- converted into a JSON string value</param>
constructor Create(const Str: string; const Value: string); overload;
/// <summary> Frees string and value</summary>
destructor Destroy; override;
/// <summary> see com.borland.dbx.transport.JSONAncestor#estimatedByteSize() </summary>
function EstimatedByteSize: Integer; override;
/// <summary> see com.borland.dbx.transport.JSONAncestor#toBytes(byte[], int) </summary>
function ToBytes(const Data: TArray<Byte>; const Offset: Integer): Integer; override;
function ToString: string; override;
function Clone: TJSONAncestor; override;
/// <summary> Returns the pair's string. </summary>
/// <returns>JSONString - pair's string</returns>
property JsonString: TJSONString read GetJsonString write SetJsonString;
/// <summary> Returns the pair value. </summary>
/// <returns>JSONAncestor - pair's value</returns>
property JsonValue: TJSONValue read GetJsonValue write SetJsonValue;
end;
/// <summary> Groups string, number, object, array, true, false, null </summary>
TJSONValue = class abstract(TJSONAncestor)
private
function Cast<T>: T;
function AsTValue(ATypeInfo: PTypeInfo; out AValue: TValue): Boolean; virtual;
protected
function FindValue(const APath: string): TJSONValue; virtual;
public
/// <summary>Converts a JSON value to a specified type </summary>
/// <remarks> Returns False when the JSON object could not be converted </remarks>
function TryGetValue<T>(out AValue: T): Boolean; overload;
/// <summary>Finds a JSON value and converts to a specified type </summary>
/// <remarks> Returns False when a JSON object could not be found or could not be converted </remarks>
function TryGetValue<T>(const APath: string; out AValue: T): Boolean; overload;
/// <summary>Finds a JSON value and converts to a specified type </summary>
/// <remarks> Raises an exception when a JSON object could not be found or the JSON object could not be converted </remarks>
function GetValue<T>(const APath: string = ''): T; overload;
/// <summary>Finds a JSON value if possible. If found, the JSON value is converted to a specified type.
/// If not found or if the JSON value is null, then returns a default value. </summary>
/// <remarks>Raises an exception when a JSON value is found but can't be converted. </remarks>
function GetValue<T>(const APath: string; ADefaultValue: T): T; overload;
end;
TJSONString = class(TJSONValue)
protected
FStrBuffer: TStringBuilder;
/// <seealso cref="TJSONAncestor.addDescendant(TJSONAncestor)"/>
procedure AddDescendant(const Descendant: TJSONAncestor); override;
/// <summary> see com.borland.dbx.transport.JSONAncestor#isNull() </summary>
function IsNull: Boolean; override;
function AsTValue(ATypeInfo: PTypeInfo; out AValue: TValue): Boolean; override;
public
/// <summary> Converts 0..15 to the equivalent hex digit </summary>
/// <param name="digit">0 to 15 number</param>
/// <returns>byte ASCII hex digit code</returns>
class function Hex(const Digit: TInt15): Byte; static;
/// <summary> Constructor for null string. No further changes are supported. </summary>
/// <remarks> No further changes are supported. </remarks>
constructor Create; overload;
/// <summary> Constructor for a given string </summary>
/// <param name="value">String initial value, cannot be null</param>
constructor Create(const Value: string); overload;
destructor Destroy; override;
/// <summary> Adds a character to current content </summary>
/// <param name="ch">char to be appended</param>
procedure AddChar(const Ch: WideChar); virtual;
/// <summary> see com.borland.dbx.transport.JSONAncestor#estimatedByteSize() </summary>
function EstimatedByteSize: Integer; override;
/// <summary> see com.borland.dbx.transport.JSONAncestor#toBytes(byte[], int) </summary>
function ToBytes(const Data: TArray<Byte>; const Idx: Integer): Integer; override;
/// <summary> Returns the quoted string content. </summary>
function ToString: string; override;
/// <summary> Returns the string content </summary>
function Value: string; override;
function Clone: TJSONAncestor; override;
end;
TJSONNumber = class sealed(TJSONString)
protected
/// <summary> Utility constructor with numerical argument represented as string </summary>
/// <param name="value">- string equivalent of a number</param>
constructor Create(const Value: string); overload;
/// <summary> Returns the double representation of the number </summary>
/// <returns>double</returns>
function GetAsDouble: Double;
/// <summary> Returns the integer part of the number </summary>
/// <returns>int</returns>
function GetAsInt: Integer;
/// <summary> Returns the int64 part of the number </summary>
/// <returns>int64</returns>
function GetAsInt64: Int64;
public
constructor Create; overload;
/// <summary> Constructor for a double number </summary>
/// <param name="value">double to be represented as JSONNumber</param>
constructor Create(const Value: Double); overload;
/// <summary> Constructor for integer </summary>
/// <param name="value">integer to be represented as JSONNumber</param>
constructor Create(const Value: Integer); overload;
/// <summary> Constructor for integer </summary>
/// <param name="value">integer to be represented as JSONNumber</param>
constructor Create(const Value: Int64); overload;
/// <seealso cref="TJSONString.estimatedByteSize()"/>
function EstimatedByteSize: Integer; override;
/// <summary> see com.borland.dbx.transport.JSONString#toBytes(byte[], int) </summary>
function ToBytes(const Data: TArray<Byte>; const Idx: Integer): Integer; override;
/// <summary> Returns the non-localized string representation </summary>
function ToString: string; override;
/// <summary> Returns the localized representation </summary>
function Value: string; override;
function Clone: TJSONAncestor; override;
/// <summary> Returns the double representation of the number </summary>
/// <returns>double</returns>
property AsDouble: Double read GetAsDouble;
/// <summary> Returns the integer part of the number </summary>
/// <returns>int</returns>
property AsInt: Integer read GetAsInt;
/// <summary> Returns the number as an int64 </summary>
/// <returns>int64</returns>
property AsInt64: Int64 read GetAsInt64;
end;
/// <summary> Enumerator for JSON pairs </summary>
TJSONPairEnumerator = class
private
FIndex: Integer;
FList: TList<TJSONPair>;
public
constructor Create(const AList: TList<TJSONPair>);
function GetCurrent: TJSONPair; inline;
function MoveNext: Boolean;
property Current: TJSONPair read GetCurrent;
end;
/// <summary> JSON object represents {} or { members } </summary>
TJSONObject = class sealed(TJSONValue)
public type
/// <summary> JSON Parser Option </summary>
TJSONParseOption = (IsUTF8, UseBool);
/// <summary>
/// JSON Parser Options
/// IsUTF8 - data should be treated as UTF8
/// UseBool - Parser should create a TJSONBool object for each instance of "true" or "false" seen in the JSON data
/// </summary>
TJSONParseOptions = set of TJSONParseOption;
strict protected const
HexDecimalConvert: array[Byte] of Byte = (
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {00-0F}
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {10 0F}
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {20-2F}
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0, {30-3F}
0, 10, 11, 12, 13, 14, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, {40-4F}
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {50-5F}
0, 10, 11, 12, 13, 14, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, {60-6F}
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {70-7F}
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {80-8F}
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {90-9F}
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {A0-AF}
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {B0-BF}
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {C0-CF}
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {D0-DF}
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {E0-EF}
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); {F0-FF}
private
FMembers: TList<TJSONPair>;
function Parse(const Br: TJSONByteReader; UseBool: Boolean): Integer; overload;
class procedure ConsumeWhitespaces(const Br: TJSONByteReader); static;
class function MakeParseOptions(IsUTF8, UseBool: Boolean): TJSONObject.TJSONParseOptions; inline;
/// <summary> Consumes a JSON object </summary>
/// <param name="Br"> raw byte data</param>
/// <param name="Parent"> parent JSON entity</param>
/// <param name="UseBool"> create a TJSONBool for "true" or "false" seen
/// in the JSON data</param>
/// <returns>next offset</returns>
class function ParseObject(const Br: TJSONByteReader; const Parent: TJSONAncestor; UseBool: Boolean): Integer; static;
/// <summary> Consumes JSON pair string:value </summary>
/// <param name="Br">raw byte data</param>
/// <param name="Parent">parent JSON entity</param>
/// <param name="UseBool"> create a TJSONBool for "true" or "false" seen
/// in the JSON data</param>
/// <returns>next offset</returns>
class function ParsePair(const Br: TJSONByteReader; const Parent: TJSONObject; UseBool: Boolean): Integer; static;
/// <summary> Consumes JSON array [...] </summary>
/// <param name="Br"> raw byte data</param>
/// <param name="Parent"> parent JSON entity</param>
/// <param name="UseBool"> create a TJSONBool for "true" or "false" seen
/// in the JSON data</param>
/// <returns>next offset</returns>
class function ParseArray(const Br: TJSONByteReader; const Parent: TJSONAncestor; UseBool: Boolean): Integer; static;
/// <summary> Consumes JSON values: string, number, object, array, true, false, null </summary>
/// <param name="Br">raw byte data</param>
/// <param name="Parent">parent JSON entity</param>
/// <param name="UseBool"> create a TJSONBool for "true" or "false" seen
/// in the JSON data</param>
/// <returns>next offset</returns>
class function ParseValue(const Br: TJSONByteReader; const Parent: TJSONAncestor; UseBool: Boolean): Integer; static;
/// <summary> Consumes numbers: int | int frac | int exp | int frac exp </summary>
/// <param name="Br">raw byte data</param>
/// <param name="Parent">parent JSON entity</param>
/// <returns>next offset</returns>
class function ParseNumber(const Br: TJSONByteReader; const Parent: TJSONAncestor): Integer; static;
/// <summary> Consumes a JSON string "..." </summary>
/// <param name="Br">raw byte data</param>
/// <param name="Parent">parent JSON entity</param>
/// <returns>next offset</returns>
class function ParseString(const Br: TJSONByteReader; const Parent: TJSONAncestor): Integer; static;
protected
function FindValue(const APath: string): TJSONValue; override;
/// <summary> Adds a new member </summary>
/// <param name="Descendant">- JSON pair</param>
procedure AddDescendant(const Descendant: TJSONAncestor); override;
/// <summary> Returns the number of members in its content. May be zero </summary>
/// <remarks> May be zero </remarks>
/// <returns>number of members in its content</returns>
function GetCount: Integer;
/// <summary> Returns the i-th pair or null if i is out of range </summary>
/// <param name="I">- pair index</param>
/// <returns>the i-th pair or null if index is out of range</returns>
function GetPair(const I: Integer): TJSONPair; overload;
/// <summary> Returns a JSON pair based on the pair string part.
/// The search is case sensitive and it returns the fist pair with string part matching the argument </summary>
/// <param name="pairName">- string: the pair string part</param>
/// <returns>- JSONPair : first pair encountered, null otherwise</returns>
function GetPairByName(const PairName: string): TJSONPair; overload;
public
/// <summary> Utility function, converts a hex character into hex value [0..15] </summary>
/// <param name="Value">byte - hex character</param>
/// <returns>integer - hex value</returns>
class function HexToDecimal(const Value: Byte): Integer; static; inline;
/// <summary> Parses a byte array and returns the JSON value from it. </summary>
/// <remarks> Assumes buffer has only JSON pertinent data. </remarks>
/// <param name="Data">- byte array, not null</param>
/// <param name="Offset">- offset from which the parsing starts</param>
/// <param name="IsUTF8">- true if the Data should be treated as UTF-8. Optional, defaults to true</param>
/// <param name="Options">- See TJSONParseOptions for correct values</param>
/// <returns>JSONValue - null if the parse fails</returns>
class function ParseJSONValue(const Data: TArray<Byte>; const Offset: Integer; IsUTF8: Boolean = True): TJSONValue; overload; inline; static;
class function ParseJSONValue(const Data: TArray<Byte>; const Offset: Integer; Options: TJSONParseOptions): TJSONValue; overload; inline; static;
/// <summary> Parses a byte array and returns the JSON value from it. </summary>
/// <param name="Data">- byte array, not null</param>
/// <param name="Offset">- offset from which the parsing starts</param>
/// <param name="ALength">- buffer capacity</param>
/// <param name="IsUTF8">- true if the Data should be treated as UTF-8. Optional, defaults to true</param>
/// <param name="Options">- See TJSONParseOptions for correct values</param>
/// <returns>JSONValue - null if the parse fails</returns>
class function ParseJSONValue(const Data: TArray<Byte>; const Offset: Integer; const ALength: Integer; IsUTF8: Boolean = True): TJSONValue; overload; inline; static;
class function ParseJSONValue(const Data: TArray<Byte>; const Offset: Integer; const ALength: Integer; Options: TJSONParseOptions): TJSONValue; overload; static;
/// <summary> Parses a string and returns the JSON value from it. </summary>
/// <param name="Data">- String to parse</param>
/// <param name="UseBool">- Create a TJSONBool for "true" or "false" seen in the JSON data</param>
/// <returns>JSONValue - null if the parse fails</returns>
class function ParseJSONValue(const Data: string; UseBool: Boolean = False): TJSONValue; overload; static;
{$IFNDEF NEXTGEN}
class function ParseJSONValue(const Data: UTF8String; UseBool: Boolean = False): TJSONValue; overload; static;
{$ENDIF !NEXTGEN}
/// <summary> Default constructor, initializes the members container </summary>
constructor Create; overload;
/// <summary> Convenience constructor - builds an object around a given pair </summary>
/// <param name="Pair">first pair in the object definition, must not be null</param>
constructor Create(const Pair: TJSONPair); overload;
/// <summary> Returns an enumerator for pairs </summary>
/// <remarks> Allows JSONPairs to be accessed using a for-in loop. </remarks>
/// <returns>The enumerator</returns>
function GetEnumerator: TJSONPairEnumerator;
/// <summary> Returns a JSON pair value based on the pair string part. The search is case sensitive and it returns
/// the fist pair with string part matching the argument </summary>
/// <param name="Name">- string: the pair string part</param>
/// <returns>- JSONValue : value of the first pair encountered, null otherwise</returns>
function GetValue(const Name: string): TJSONValue; overload;
/// <summary> Releases the stored members </summary>
destructor Destroy; override;
/// <summary> Adds a new pair </summary>
/// <param name="Pair">- a new pair, cannot be null</param>
function AddPair(const Pair: TJSONPair): TJSONObject; overload;
/// <summary> Convenience method for adding a pair (name, value). </summary>
/// <param name="Str">- pair name</param>
/// <param name="Val">- pair value</param>
function AddPair(const Str: TJSONString; const Val: TJSONValue): TJSONObject; overload;
/// <summary> Convenience method for adding a pair to current object. </summary>
/// <param name="Str">- string: pair name</param>
/// <param name="Val">- JSONValue: pair value</param>
function AddPair(const Str: string; const Val: TJSONValue): TJSONObject; overload;
function AddPair(const Str: string; const Val: string): TJSONObject; overload;
function RemovePair(const PairName: string): TJSONPair;
/// <summary> Returns the number of bytes needed to serialize this object </summary>
function EstimatedByteSize: Integer; override;
/// <summary> see JSONAncestor#toBytes(byte[], int) </summary>
function ToBytes(const Data: TArray<Byte>; const Idx: Integer): Integer; override;
function Clone: TJSONAncestor; override;
/// <summary> Consumes a JSON object byte representation. </summary>
/// <remarks> It is recommended to use static function parseJSONValue, unless you are familiar
/// with parsing technology. It assumes the buffer has only JSON bytes. </remarks>
/// <param name="Data">byte[] with JSON stream</param>
/// <param name="Pos">position within the byte array to start from, negative number if
/// parser fails. If negative, the absolute value is the offset where the failure happens. </param>
/// <param name="UseBool"> create a TJSONBool for "true" or "false" seen
/// in the JSON data</param>
/// <returns>negative number on parse error, byte buffer length on success.</returns>
function Parse(const Data: TArray<Byte>; const Pos: Integer; UseBool: Boolean = False): Integer; overload;
/// <summary> Consumes a JSON object byte representation. </summary>
/// <remarks> It is recommended to use static function parseJSONValue, unless you are familiar
/// with parsing technology. </remarks>
/// <param name="Data">byte[] with JSON stream</param>
/// <param name="Pos">position within the byte array to start from</param>
/// <param name="Count">number of bytes</param>
/// <param name="UseBool"> create a TJSONBool for "true" or "false" seen
/// in the JSON data</param>
/// <returns>negative number on parse error</returns>
function Parse(const Data: TArray<Byte>; const Pos: Integer; const Count: Integer; UseBool: Boolean = False): Integer; overload;
procedure SetPairs(const AList: TList<TJSONPair>);
function ToString: string; override;
property Count: Integer read GetCount;
property Pairs[const Index: Integer]: TJSONPair read GetPair;
property Values[const Name: string]: TJSONValue read GetValue;
{ Deprecated functions }
function Size: Integer; inline; deprecated 'Use Count Property';
function Get(const Index: Integer): TJSONPair; overload; deprecated 'Use Pairs property';
function Get(const Name: string): TJSONPair; overload; // deprecated
{$IFNDEF NEXTGEN}
class function ParseJSONValueUTF8(const Data: TArray<Byte>; const Offset: Integer;
const ACount: Integer): TJSONValue; overload; static; deprecated 'Use ParseJSONValue';
class function ParseJSONValueUTF8(const Data: TArray<Byte>;
const Offset: Integer): TJSONValue; overload; static; deprecated 'Use ParseJSONValue';
{$ENDIF !NEXTGEN}
end;
/// <summary> Implements JSON null value </summary>
TJSONNull = class sealed(TJSONValue)
private
const NULLString: string = 'null';
protected
/// <summary> see com.borland.dbx.transport.JSONAncestor#addDescendent(com.borland.dbx.transport.JSONAncestor) </summary>
procedure AddDescendant(const Descendant: TJSONAncestor); override;
function AsTValue(ATypeInfo: PTypeInfo; out AValue: TValue): Boolean; override;
/// <summary> see com.borland.dbx.transport.JSONAncestor#isNull() </summary>
function IsNull: Boolean; override;
public
/// <summary> see com.borland.dbx.transport.JSONAncestor#estimatedByteSize() </summary>
function EstimatedByteSize: Integer; override;
/// <summary> see com.borland.dbx.transport.JSONAncestor#toBytes(byte[], int) </summary>
function ToBytes(const Data: TArray<Byte>; const Offset: Integer): Integer; override;
function ToString: string; override;
function Value: string; override;
function Clone: TJSONAncestor; override;
end;
/// <summary> Implements JSON Boolean type from which TJSONTrue and TJSONFalse derive </summary>
TJSONBool = class(TJSONValue)
private
FValue: Boolean;
strict protected const
FalseString: string = 'false';
TrueString: string = 'true';
FalseBytes: array[0..4] of Byte = (Ord('f'), Ord('a'), Ord('l'), Ord('s'), Ord('e'));
TrueBytes: array[0..3] of Byte = (Ord('t'), Ord('r'), Ord('u'), Ord('e'));
protected
function AsTValue(ATypeInfo: PTypeInfo; out AValue: TValue): Boolean; override;
/// <summary> see com.borland.dbx.transport.JSONAncestor#addDescendent(com.borland.dbx.transport.JSONAncestor) </summary>
procedure AddDescendant(const Descendant: TJSONAncestor); override;
public
constructor Create(AValue: Boolean);
/// <summary> see com.borland.dbx.transport.JSONAncestor#estimatedByteSize() </summary>
function EstimatedByteSize: Integer; override;
/// <summary> see com.borland.dbx.transport.JSONAncestor#toBytes(byte[], int) </summary>
function ToBytes(const Data: TArray<Byte>; const Offset: Integer): Integer; override;
function ToString: string; override;
function Value: string; override;
function Clone: TJSONAncestor; override;
property AsBoolean: Boolean read FValue;
end;
/// <summary> Implements JSON true value </summary>
TJSONTrue = class sealed(TJSONBool)
public
constructor Create;
function Clone: TJSONAncestor; override;
end;
/// <summary> Implements JSON false value </summary>
TJSONFalse = class sealed(TJSONBool)
public
constructor Create;
function Clone: TJSONAncestor; override;
end;
TJSONArray = class;
/// <summary> Support enumeration of values in a JSONArray. </summary>
TJSONArrayEnumerator = class
private
FIndex: Integer;
FArray: TJSONArray;
public
constructor Create(const AArray: TJSONArray);
function GetCurrent: TJSONValue; inline;
function MoveNext: Boolean;
property Current: TJSONValue read GetCurrent;
end;
/// <summary> Implements JSON array [] | [ elements ] </summary>
TJSONArray = class sealed(TJSONValue)
private
FElements: TList<TJSONValue>;
protected
function FindValue(const APath: string): TJSONValue; override;
/// <summary> see com.borland.dbx.transport.JSONAncestor#addDescendent(com.borland.dbx.transport.JSONAncestor) </summary>
procedure AddDescendant(const Descendant: TJSONAncestor); override;
/// <summary> Removes the first element from the element list. </summary>
/// <remarks> No checks are made, it is the caller responsibility to check if there is at least one element. </remarks>
/// <returns>JSONValue</returns>
function Pop: TJSONValue;
/// <summary> Returns the array component, null if index is out of range </summary>
/// <param name="Index">- element index</param>
/// <returns>JSONValue element, null if index is out of range</returns>
function GetValue(const Index: Integer): TJSONValue; overload;
/// <summary> Returns the array size </summary>
/// <returns>int - array size</returns>
function GetCount: Integer;
public
/// <summary> Default constructor, initializes the container </summary>
constructor Create; overload;
/// <summary> Convenience constructor, wraps an array around a JSON value </summary>
/// <param name="FirstElem">JSON value</param>
constructor Create(const FirstElem: TJSONValue); overload;
/// <summary> Convenience constructor, wraps an array around a JSON value </summary>
/// <param name="FirstElem">JSON value</param>
/// <param name="SecondElem">JSON value</param>
constructor Create(const FirstElem: TJSONValue; const SecondElem: TJSONValue); overload;
constructor Create(const FirstElem: string; const SecondElem: string); overload;
/// <summary> frees the container elements </summary>
destructor Destroy; override;
/// <summary> Returns the array size </summary>
/// <returns>int - array size</returns>
property Count: Integer read GetCount;
/// <summary> Returns the array component, null if index is out of range </summary>
/// <param name="Index">- element index</param>
/// <returns>JSONValue element, null if index is out of range</returns>
property Items[const Index: Integer]: TJSONValue read GetValue;
/// <summary>Removes the pair at the given index, returning the removed pair (or nil)</summary>
function Remove(Index: Integer): TJSONValue;
/// <summary> Adds a non-null value to the current element list </summary>
/// <param name="Element">string object cannot be null</param>
procedure AddElement(const Element: TJSONValue);
function Add(const Element: string): TJSONArray; overload;
function Add(const Element: Integer): TJSONArray; overload;
function Add(const Element: Double): TJSONArray; overload;
function Add(const Element: Boolean): TJSONArray; overload;
function Add(const Element: TJSONObject): TJSONArray; overload;
function Add(const Element: TJSONArray): TJSONArray; overload;
/// <summary> see com.borland.dbx.transport.JSONAncestor#estimatedByteSize() </summary>
function EstimatedByteSize: Integer; override;
procedure SetElements(const AList: TList<TJSONValue>);
// / <seealso cref="TJSONAncestor.ToBytes(TArray<Byte>,Integer)"/>
function ToBytes(const Data: TArray<Byte>; const Pos: Integer): Integer; override;
function ToString: string; override;
function Clone: TJSONAncestor; override;
function GetEnumerator: TJSONArrayEnumerator;
{ Deprecated functions }
function Size: Integer; inline; deprecated 'Use Count Property';
function Get(const Index: Integer): TJSONValue; deprecated 'Use Items property';
end;
function GetJSONFormat: TFormatSettings;
function FloatToJson(const Value: Double): string;
function JsonToFloat(const DotValue: string): Double;
function TryJsonToFloat(const DotValue: string; var Value: Double): Boolean;
implementation
uses
System.Classes, System.DateUtils, System.SysConst, System.StrUtils, System.Character,
System.JSONConsts;
const
HexChars = '0123456789ABCDEF';
var
JSONFormatSettings: TFormatSettings;
function GetJSONFormat: TFormatSettings;
begin
Result := JSONFormatSettings;
end;
function IncrAfter(var Arg: Integer): Integer;
begin
Result := Arg;
Inc(Arg);
end;
function DecrAfter(var Arg: Integer): Integer;
begin
Result := Arg;
Dec(Arg);
end;
function FloatToJson(const Value: Double): string;
begin
Result := FloatToStr(Value, JSONFormatSettings);
end;
function JsonToFloat(const DotValue: string): Double;
begin
Result := StrToFloat(DotValue, JSONFormatSettings);
end;
function TryJsonToFloat(const DotValue: string; var Value: Double): Boolean;
begin
Result := TryStrToFloat(DotValue, Value, JSONFormatSettings);
end;
function StrToTValue(const Str: string; const TypeInfo: PTypeInfo; out AValue: TValue): Boolean;
function CheckRange(const Min, Max: Int64; const Value: Int64; const Str: string): Int64;
begin
Result := Value;
if (Value < Min) or (Value > Max) then
raise EConvertError.CreateFmt(System.SysConst.SInvalidInteger, [Str]);
end;
var
TypeData: TTypeData;
TypeName: string;
begin
Result := True;
case TypeInfo.Kind of
tkInteger:
case GetTypeData(TypeInfo)^.OrdType of
otSByte: AValue := CheckRange(Low(Int8), High(Int8), StrToInt(Str), Str);
otSWord: AValue := CheckRange(Low(Int16), High(Int16), StrToInt(Str), Str);
otSLong: AValue := StrToInt(Str);
otUByte: AValue := CheckRange(Low(UInt8), High(UInt8), StrToInt(Str), Str);
otUWord: AValue := CheckRange(Low(UInt16), High(UInt16), StrToInt(Str), Str);
otULong: AValue := CheckRange(Low(UInt32), High(UInt32), StrToInt64(Str), Str);
end;
tkInt64:
begin
TypeData := GetTypeData(TypeInfo)^;
if TypeData.MinInt64Value > TypeData.MaxInt64Value then
AValue := StrToUInt64(Str)
else
AValue := StrToInt64(Str);
end;
tkEnumeration:
begin
TypeName := TypeInfo.NameFld.ToString;
if SameText(TypeName, 'boolean') or SameText(TypeName, 'bool') then
AValue := StrToBool(Str)
else
Result := False;
end;
tkFloat:
case GetTypeData(TypeInfo)^.FloatType of
ftSingle: AValue := StrToFloat(Str, JSONFormatSettings);
ftDouble:
begin
if TypeInfo = System.TypeInfo(TDate) then
AValue := ISO8601ToDate(Str)
else if TypeInfo = System.TypeInfo(TTime) then
AValue := ISO8601ToDate(Str)
else if TypeInfo = System.TypeInfo(TDateTime) then
AValue := ISO8601ToDate(Str)
else
AValue := StrToFloat(Str, JSONFormatSettings);
end;
ftExtended: AValue := StrToFloat(Str, JSONFormatSettings);
ftComp: AValue := StrToFloat(Str, JSONFormatSettings);
ftCurr: AValue := StrToCurr(Str, JSONFormatSettings);
end;
{$IFNDEF NEXTGEN}
tkChar,
{$ENDIF !NEXTGEN}
tkWChar:
begin
if Str.Length = 1 then
AValue := Str[Low(string)]
else
Result := False;
end;
tkString, tkLString, tkUString, tkWString:
AValue := Str;
else
Result := False;
end;
end;
// Traverse a JSONObject or TJSONArray and find the TJSONValue identified by a path string
function FindJSONValue(const AJSON: TJSONValue; const APath: string): TJsonValue; overload;
var
LCurrentValue: TJSONValue;
LParser: TJSONPathParser;
LError: Boolean;
begin
LParser := TJSONPathParser.Create(APath);
try
LCurrentValue := AJSON;
LError := False;
while (not LParser.IsEof) and (not LError) do
begin
case LParser.NextToken of
TJSONPathParser.TToken.Name:
begin
if LCurrentValue is TJSONObject then
begin
if LCurrentValue = nil then
exit(nil);
LCurrentValue := TJSONObject(LCurrentValue).Values[LParser.TokenName];
if LCurrentValue = nil then
LError := True;
end
else
LError := True;
end;
TJSONPathParser.TToken.ArrayIndex:
begin
if LCurrentValue is TJSONArray then
if LParser.TokenArrayIndex < TJSONArray(LCurrentValue).Count then
LCurrentValue := TJSONArray(LCurrentValue).Items[LParser.TokenArrayIndex]
else
LError := True
else
LError := True
end;
TJSONPathParser.TToken.Error:
LError := True;
else
Assert(LParser.Token = TJSONPathParser.TToken.Eof); // case statement is not complete
end;
end;
if LParser.IsEof and not LError then
Result := LCurrentValue
else
Result := nil;
finally
LParser.Free;
end;
end;
{ TJSONAncestor }
constructor TJSONAncestor.Create;
begin
inherited Create;
FOwned := True;
end;
function TJSONAncestor.IsNull: Boolean;
begin
Result := False;
end;
function TJSONAncestor.Value: string;
begin
Result := '';
end;
procedure TJSONAncestor.SetOwned(const Own: Boolean);
begin
FOwned := Own;
end;
function TJSONAncestor.ToJSON: string;
var
LBytes: TBytes;
begin
SetLength(LBytes, ToString.Length * 6);
SetLength(LBytes, ToBytes(LBytes, 0));
Result := TEncoding.UTF8.GetString(LBytes);
end;
function TJSONAncestor.GetOwned: Boolean;
begin
Result := FOwned;
end;
{ TJSONByteReader }
constructor TJSONByteReader.Create(const Data: TArray<Byte>; const Offset: Integer; const Range: Integer);
begin
inherited Create;
FData := Data;
FOffset := Offset;
FRange := Range;
ConsumeBOM;
end;
constructor TJSONByteReader.Create(const Data: TArray<Byte>; const Offset: Integer; const Range: Integer; const IsUTF8: Boolean);
begin
inherited Create;
FData := Data;
FOffset := Offset;
FRange := Range;