-
Notifications
You must be signed in to change notification settings - Fork 23
/
Copy pathNeslib.Json.pas
2840 lines (2361 loc) · 77.2 KB
/
Neslib.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
unit Neslib.Json;
(*< A fast and memory-efficient JSON object model, with support for efficiently
parsing and writing in JSON-compliant format.
@bold(Loading and Saving JSON)
The main entry point to this library is the IJsonDocument interface. It is
used for parsing, loading and saving JSON documents and provides access to the
JSON object model. You can parse a JSON string as follows:
<source>
var
Doc: IJsonDocument;
begin
Doc := TJsonDocument.Parse('{ "Answer" : 42 }');
end;
</source>
Note that, unlike the official JSON specification, this library does NOT
require quotes around dictionary keys (as long as the key does not contain
spaces or other non-identifier characters). So the following is valid as well:
<source>
Doc := TJsonDocument.Parse('{ Answer : 42 }');
</source>
You can also use the Load method to load from a file or stream.
On the output side, you use Save to save to a file or stream, or ToJson to
output to a JSON string.
You can also create new JSON documents from scratch using the CreateArray or
CreateDictionary methods:
<source>
var
Doc: IJsonDocument;
begin
Doc := TJsonDocument.CreateArray;
Doc.Root.Add(42);
end;
</source>
As you can see in this example, you access the JSON document object model
through the Root property.
@bold(JSON object model)
At the heart of the JSON object model is the TJsonValue type. This is a record
that can hold any type of JSON value.
It provides various implicit conversion operators to convert a TJsonValue to
another (Delphi) type. In addition, there are various To* methods that try
to convert a TJsonValue but return a provided default value if conversion
fails.
You (can) never create TJsonValue's yourself; The only way to create a
TJsonValue is by adding a value to JSON array or dictionary:
<source>
var
Doc: IJsonDocument;
begin
Doc := TJsonDocument.CreateArray;
Doc.Root.Add(42);
end;
</source>
This example adds a TJsonValue (with value 42) to a JSON array. To create a
new array of dictionary, you use the AddArray or AddDictionary methods
instead:
<source>
var
Doc: IJsonDocument;
Dict: TJsonValue;
begin
Doc := TJsonDocument.CreateArray;
Dict := Doc.Root.AddDictionary;
Dict.AddOrSetValue('answer', 42);
end;
</source>
This creates a new dictionary and adds it to the root array. Then, the value
42 is added to this dictionary under the name 'answer'.
To check the type of a value, use the TJsonValue.ValueType property or one
of the TJsonValue.Is* methods.
When trying to use methods like Add (or AddOrSetValue) on values that are not
arrays (or dictionaries), an exception will be raised.
However, accessing the items in an array (using the Items property) or the
values in a dictionary (using the Values property) will never result in an
exception, even if the array index is out of bounds. This allows for chaining
multiple array/dictionary accesses together without having to check the
validity of each intermediate step. For example:
<source>
I := Doc.Root.Items[3].Values['foo'].Values['bar'].Items[4].ToInteger(0);
</source>
This will always succeed, but return 0 if any of the intermediate values are
unavailable.
@bold(Manually Reading and Writing JSON)
The IJsonDocument interface makes it easy to read and write JSON into a
document object model.
However, you can also choose to read or write JSON manually if you prefer (for
example to avoid having to load an object model into memory). You can do this
with the IJsonReader and IJsonWriter interfaces in the Neslib.Json.IO unit.
These interfaces are completely independent from any DOM implementation and
don't even require this unit. Using these interfaces is a bit more complicated
and requires some more work though. See the Neslib.Json.IO unit for more
information.
@bold(Querying JSON documents with JSONPath)
There is also an XPath-like JSONPath implementation you can use for querying
JSON documents. This feature is documented in the Neslib.Json.Path unit.
@bold(Memory Management)
All memory management is automatic. An IJsonDocument interface owns all
TJsonValue's and destroys them when the document is destroyed (goes out of
scope).
The only thing you need to be aware of is that you shouldn't use any
TJsonValue records anymore after the document is destroyed. Doing so will lead
to undefined behavior and possibly crashes.
@bold(Customization)
You can customize some behavior using these conditional defines:
* JSON_UTF8: to use UTF8String instead of String everywhere. All strings will
be treated as 8-bit UTF-8 strings instead of 16-bit Unicode strings. This
reduces memory consumption and speeds up parsing a bit. However, this means
you will have to use this JSON library with UTF8Strings as well, otherwise
Delphi will implicitly convert between Unicode strings and UTF8Strings, which
can hurt performance.
* JSON_STRING_INTERNING: to enable string interning for dictionary keys.
This reduces memory consumption in case the same key is used a lot of times
(which is common when JSON is exported from a database), but is a bit
slower.
This unit declares the JsonString type as either String or UTF8String,
depending on the JSON_UTF8 define. However, this doesn't mean that YOU have
to use JsonString as well. If you don't care about the JSON_UTF8 define, then
you can just use regular strings with this library. *)
{$INCLUDE 'Neslib.inc'}
interface
uses
System.Classes,
System.SysUtils,
Neslib.Json.Types,
Neslib.Json.IO;
type
{ Data types supported by JSON }
TJsonValueType = (
{ Null value }
Null,
{ A Boolean value (False or True) }
Boolean,
{ An ordinal value, such as a 32-bit or 64-bit integer }
Ordinal,
{ A floating-point value, such as a Single or Double }
Float,
{ A string value }
&String,
{ An array of TJsonValue's }
&Array,
{ A dictionary with string keys and values of type TJsonValue }
Dictionary);
type
PJsonElement = ^TJsonElement;
PJsonValue = ^TJsonValue;
{ The base type for the JSON object model. Every possible type of JSON value
can be represented with a TJsonValue record.
This record is very light-weight (it only occupies 32 bits on a 32-bit
system, or 64 bits on a 64-bit system). It only allocates more memory if
it doesn't fit in this record.
Memory management is automatic. All values are owned by a IJsonDocument,
which takes care of destroying these values when the document is
destroyed. }
TJsonValue = record
{$REGION 'Internal Declarations'}
private const
TYPE_BITS = 2;
TYPE_MASK = (1 shl TYPE_BITS) - 1;
VALUE_BITS = (SizeOf(UIntPtr) * 8) - TYPE_BITS;
VALUE_MASK = UIntPtr.MaxValue - TYPE_MASK;
{$IFDEF CPU64BITS}
EXTEND_BITS = UInt64(TYPE_MASK) shl (64 - TYPE_BITS);
MAX_INT = (Int64(1) shl (VALUE_BITS - 1)) - 1;
MIN_INT = -(Int64(1) shl (VALUE_BITS - 1));
{$ELSE}
EXTEND_BITS = TYPE_MASK shl (32 - TYPE_BITS);
MAX_INT = (1 shl (VALUE_BITS - 1)) - 1;
MIN_INT = -(1 shl (VALUE_BITS - 1));
{$ENDIF}
private const
TYPE_FIXED = $0; // Null or Boolean
TYPE_INT = $1; // Embedded native integer
TYPE_STR = $2; // String on heap
TYPE_HEAP = $3; // Other value on heap
private const
SUBTYPE_ARRAY = 0; // Array on heap
SUBTYPE_DICT = 1; // Dictionary on heap
SUBTYPE_INT = 2; // Native integer on heap
SUBTYPE_FLOAT = 3; // Double on heap
private type
THeapInt = record
SubType: UInt32;
Value: Int64;
end;
PHeapInt = ^THeapInt;
private type
THeapFloat = record
SubType: UInt32;
Value: Double;
end;
PHeapFloat = ^THeapFloat;
private type
TJsonArray = record
private
FSubtype: UInt32;
FItems: PJsonValue;
FCount: Integer;
FCapacity: Integer;
private
procedure Grow;
public
procedure Init; inline;
procedure Free; inline;
procedure Delete(const AIndex: Integer);
procedure Clear;
function Equals(const AOther: TJsonArray): Boolean;
procedure Add(const AValue: Boolean); overload;
procedure Add(const AValue: Int32); overload;
procedure Add(const AValue: UInt32); overload;
procedure Add(const AValue: Int64); overload;
procedure Add(const AValue: UInt64); overload;
procedure Add(const AValue: Single); overload;
procedure Add(const AValue: Double); overload;
procedure Add(const AValue: JsonString); overload;
procedure AddNull; inline;
function AddArray: TJsonValue; inline;
function AddDictionary: TJsonValue; inline;
function GetItem(const AIndex: Integer): TJsonValue;
public
procedure ReadFrom(const AReader: IJsonReader);
procedure WriteTo(const AWriter: IJsonWriter);
end;
PJsonArray = ^TJsonArray;
private type
TElement = record
private
FName: JsonString;
FValue: UIntPtr; // TJsonValue
public
class operator Equal(const A, B: TElement): Boolean; static;
class operator NotEqual(const A, B: TElement): Boolean; inline; static;
procedure Free; inline;
end;
PElement = ^TElement;
private type
TMapEntry = record
HashCode: Integer;
Name: JsonString;
Index: Integer;
end;
PMapEntry = ^TMapEntry;
private type
TIndexMap = record
private const
EMPTY_HASH = -1;
private
FEntries: PMapEntry;
FCount: Integer;
FCapacity: Integer;
FGrowThreshold: Integer;
private
procedure Resize(ANewSize: Integer);
public
procedure Free;
procedure Clear;
function Get(const AName: JsonString): Integer;
procedure Add(const AName: JsonString; const AIndex: Integer);
end;
PIndexMap = ^TIndexMap;
private type
TJsonDictionary = record
private const
{ We use an FIndices dictionary to map names to indices.
However, for small dictionaries it is faster and more memory efficient
to just perform a linear search.
So we only use the dictionary if the number of items reaches this value. }
INDICES_COUNT_THRESHOLD = 12;
private
FSubtype: UInt32;
FElements: PElement;
FIndices: PIndexMap;
FCount: Integer;
FCapacity: Integer;
private
function AddOrReplaceElement(const AName: JsonString): PElement;
procedure RebuildIndices;
public
procedure Init; inline;
procedure Free; inline;
procedure Delete(const AIndex: Integer);
procedure Clear;
function Equals(const AOther: TJsonDictionary): Boolean;
procedure AddOrSetValue(const AName: JsonString; const AValue: Boolean); overload;
procedure AddOrSetValue(const AName: JsonString; const AValue: Int32); overload;
procedure AddOrSetValue(const AName: JsonString; const AValue: UInt32); overload;
procedure AddOrSetValue(const AName: JsonString; const AValue: Int64); overload;
procedure AddOrSetValue(const AName: JsonString; const AValue: UInt64); overload;
procedure AddOrSetValue(const AName: JsonString; const AValue: Single); overload;
procedure AddOrSetValue(const AName: JsonString; const AValue: Double); overload;
procedure AddOrSetValue(const AName: JsonString; const AValue: JsonString); overload;
procedure AddOrSetNull(const AName: JsonString);
function AddOrSetArray(const AName: JsonString): TJsonValue;
function AddOrSetDictionary(const AName: JsonString): TJsonValue;
function IndexOfName(const AName: JsonString): Integer;
function Contains(const AName: JsonString): Boolean; inline;
procedure Remove(const AName: JsonString);
function TryGetValue(const AName: JsonString; out AValue: TJsonValue): Boolean;
function GetValue(const AName: JsonString): TJsonValue;
function GetElement(const AIndex: Integer): PJsonElement;
public
procedure ReadFrom(const AReader: IJsonReader);
procedure WriteTo(const AWriter: IJsonWriter);
end;
PJsonDictionary = ^TJsonDictionary;
private
{ Layout of FBits:
* Bits 0-1: data type. One of type TYPE_* values.
* Bits 2-31 (or 2-63 on 64-bit systems): value.
The value depends on the TYPE_*:
* TYPE_FIXED: 0=Null, 1=False, 2=True
* TYPE_INT: Native integer. Sign bit must be extended.
* TYPE_STR: Pointer to a UnicodeString on the heap, or 0 for empty string.
* TYPE_HEAP: Pointer to another value on the heap.
Note that any Pointer value is calculated by setting the lowest 2 bits to
0. This is legal since Delphi always allocates dynamic memory at 4-byte
aligned addresses. (Actually, dynamic memory is always aligned on 8-byte
boundaries, but constant strings can be aligned on 4-byte boundaries).
For TYPE_HEAP, the first 4 bytes of the data that is pointed to contains a
subtype value that indicates the type of data:
* SUBTYPE_INT: Pointer to dynamically allocated native integer on the
heap. Only used when value doesn't fit into 30 or 62 bits (depending on
system).
* SUBTYPE_FLOAT: Pointer to dynamically allocated Double on the heap.
* SUBTYPE_ARRAY: Pointer to private TJsonArray record on the heap.
* SUBTYPE_DICT: Pointer to private TJsonDictionary record on the heap. }
FBits: UIntPtr;
private
function GetValueType: TJsonValueType; inline;
function GetIsNull: Boolean; inline;
function GetIsBoolean: Boolean; inline;
function GetIsOrdinal: Boolean;
function GetIsFloat: Boolean; inline;
function GetIsNumeric: Boolean;
function GetIsString: Boolean; inline;
function GetIsArray: Boolean; inline;
function GetIsDictionary: Boolean; inline;
function GetItem(const AIndex: Integer): TJsonValue; inline;
function GetValue(const AName: JsonString): TJsonValue; inline;
function GetElement(const AIndex: Integer): PJsonElement; inline;
function GetCount: Integer; inline;
private
class function Create: TJsonValue; overload; inline; static;
class function Create(const AValue: Boolean): TJsonValue; overload; inline; static;
class function Create(const AValue: Int32): TJsonValue; overload; {$IFDEF CPU64BITS}inline;{$ENDIF} static;
class function Create(const AValue: UInt32): TJsonValue; overload; {$IFDEF CPU64BITS}inline;{$ENDIF} static;
class function Create(const AValue: Int64): TJsonValue; overload; {$IFDEF CPU32BITS}inline;{$ENDIF} static;
class function Create(const AValue: UInt64): TJsonValue; overload; {$IFDEF CPU32BITS}inline;{$ENDIF} static;
class function Create(const AValue: Double): TJsonValue; overload; inline; static;
class function Create(const AValue: JsonString): TJsonValue; overload; inline; static;
class function CreateArray: TJsonValue; inline; static;
class function CreateDictionary: TJsonValue; inline; static;
class function ReadFrom(const AReader: IJsonReader;
const AState: TJsonReaderState): TJsonValue; static;
procedure Free;
procedure WriteTo(const AWriter: IJsonWriter);
{$ENDREGION 'Internal Declarations'}
public
{ Implicit operators that convert a TJsonValue to another type.
These operators never raise an exception, but return a zero-value (such as
0, False or an empty string) if the TJsonValue cannot be converted. }
class operator Implicit(const AValue: TJsonValue): Boolean; inline; static;
class operator Implicit(const AValue: TJsonValue): Int8; inline; static;
class operator Implicit(const AValue: TJsonValue): UInt8; inline; static;
class operator Implicit(const AValue: TJsonValue): Int16; inline; static;
class operator Implicit(const AValue: TJsonValue): UInt16; inline; static;
class operator Implicit(const AValue: TJsonValue): Int32; inline; static;
class operator Implicit(const AValue: TJsonValue): UInt32; inline; static;
class operator Implicit(const AValue: TJsonValue): Int64; inline; static;
class operator Implicit(const AValue: TJsonValue): UInt64; inline; static;
class operator Implicit(const AValue: TJsonValue): Single; inline; static;
class operator Implicit(const AValue: TJsonValue): Double; inline; static;
class operator Implicit(const AValue: TJsonValue): JsonString; inline; static;
{ Tests two TJsonValue's for (in)equality, based on their data type. }
class operator Equal(const ALeft, ARight: TJsonValue): Boolean; static;
class operator NotEqual(const ALeft, ARight: TJsonValue): Boolean; inline; static;
{ Converts the TJsonValue to another type if possible, or returns a default
value if conversion is not possible.
Parameters:
ADefault: (optional) default value to return in case the TJsonValue
cannot be converted.
Returns:
The converted value, or ADefault if the value cannot be converted.
These methods never raise an exception. }
function ToBoolean(const ADefault: Boolean = False): Boolean;
function ToInteger(const ADefault: Integer = 0): Integer; inline; // Alias for ToInt32
function ToInt32(const ADefault: Int32 = 0): Int32;
function ToInt64(const ADefault: Int64 = 0): Int64;
function ToDouble(const ADefault: Double = 0): Double;
function ToString(const ADefault: JsonString = ''): JsonString;
{ Converts the TJsonValue to a string in JSON format.
Parameters:
AIndent: (optional) flag indicating whether you want indented (or
pretty-printed) output. If True (the default), nested values will be
indented and line breaks will be inserted. If False, then no line
breaks and indentation will be used.
Returns:
The value in JSON format. }
function ToJson(const AIndent: Boolean = True): JsonString; inline;
{ The type of this value. }
property ValueType: TJsonValueType read GetValueType;
{ Whether this is a Null value (eg. ValueType = Null). }
property IsNull: Boolean read GetIsNull;
{ Whether this is a Boolean value (eg. ValueType = Boolean). }
property IsBoolean: Boolean read GetIsBoolean;
{ Whether this is an ordinal value (eg. ValueType = Ordinal). }
property IsOrdinal: Boolean read GetIsOrdinal;
{ Whether this is a floating-point value (eg. ValueType = Float). }
property IsFloat: Boolean read GetIsFloat;
{ Whether this is a numberic value (ordinal or floating-point). }
property IsNumeric: Boolean read GetIsNumeric;
{ Whether this is a String value (eg. ValueType = String). }
property IsString: Boolean read GetIsString;
{ Whether this is an Array value (eg. ValueType = Array). }
property IsArray: Boolean read GetIsArray;
{ Whether this is a Dictionary value (eg. ValueType = Dictionary). }
property IsDictionary: Boolean read GetIsDictionary;
public
(*************************************************************************)
(* The methods in this section only apply to arrays and dictionaries *)
(* (that is, if IsArray or IsDictionary returns True). Unless stated *)
(* otherwise, they raise an EInvalidOperation exception if this is not *)
(* an array or dictionary. *)
(*************************************************************************)
{ Clears the array or dictionary.
Raises:
EInvalidOperation if this is not an array or dictionary. }
procedure Clear; inline;
{ Deletes an item from the array or dictionary.
Parameters:
AIndex: index of the item to delete.
Raises:
EInvalidOperation if this is not an array or dictionary.
EArgumentOutOfRangeException if AIndex is out of bounds. }
procedure Delete(const AIndex: Integer); inline;
{ Returns the number of items in the array or dictionary.
This property NEVER raises an exception. Instead, it returns 0 if this is
not an array or dictionary. }
property Count: Integer read GetCount;
public
(*************************************************************************)
(* The methods in this section only apply to arrays (that is, if IsArray *)
(* returns True). Unless stated otherwise, they raise an *)
(* EInvalidOperation exception if this is not an array. *)
(*************************************************************************)
{ Adds a value to the end of the array.
Parameters:
AValue: the value to add.
Raises:
EInvalidOperation if this is not an array. }
procedure Add(const AValue: Boolean); overload; inline;
procedure Add(const AValue: Int32); overload; inline;
procedure Add(const AValue: UInt32); overload; inline;
procedure Add(const AValue: Int64); overload; inline;
procedure Add(const AValue: UInt64); overload; inline;
procedure Add(const AValue: Single); overload; inline;
procedure Add(const AValue: Double); overload; inline;
procedure Add(const AValue: JsonString); overload; inline;
{ Adds a Null-value to the end of the array.
Raises:
EInvalidOperation if this is not an array. }
procedure AddNull; inline;
{ Creates an array and adds it to the end of this array.
Returns:
The newly created array.
Raises:
EInvalidOperation if this is not an array. }
function AddArray: TJsonValue; inline;
{ Creates a dictionary and adds it to the end of this array.
Returns:
The newly created dictionary.
Raises:
EInvalidOperation if this is not an array. }
function AddDictionary: TJsonValue; inline;
{ The items in this array.
Unlike the other array-methods, this property NEVER raises an exception.
Instead, it returns a Null value if this is not an array or AIndex is out
of range.
This allows for chaining without having to check every intermediate step,
as in Foo.Items[1].Items[3].Items[2].ToInteger. }
property Items[const AIndex: Integer]: TJsonValue read GetItem;
{ Alias for the Items property. Enables the default array property using an
integer index. That is:
MyValue[0];
is equivalent to
MyValue.Items[0];
There is also an indexer that uses a string index, which is an alias for
the Values property. }
property _Indexer[const AIndex: Integer]: TJsonValue read GetItem; default;
public
(*************************************************************************)
(* The methods in this section only apply to dictionaries (that is, if *)
(* IsDictionary returns True). Unless stated otherwise, they raise an *)
(* EInvalidOperation exception if this is not a dictionary *)
(*************************************************************************)
{ Adds or replaces a value in the dictionary.
Parameters:
AName: the name (key) of the value to add.
AValue: the value to add.
Raises:
EInvalidOperation if this is not a dictionary.
If a value with the given name already exists in the dictionary, then it
is freed and replaced. }
procedure AddOrSetValue(const AName: JsonString; const AValue: Boolean); overload; inline;
procedure AddOrSetValue(const AName: JsonString; const AValue: Int32); overload; inline;
procedure AddOrSetValue(const AName: JsonString; const AValue: UInt32); overload; inline;
procedure AddOrSetValue(const AName: JsonString; const AValue: Int64); overload; inline;
procedure AddOrSetValue(const AName: JsonString; const AValue: UInt64); overload; inline;
procedure AddOrSetValue(const AName: JsonString; const AValue: Single); overload; inline;
procedure AddOrSetValue(const AName: JsonString; const AValue: Double); overload; inline;
procedure AddOrSetValue(const AName: JsonString; const AValue: JsonString); overload; inline;
{ Adds or replaces a Null-value in the dictionary.
Parameters:
AName: the name (key) of the value to add.
Raises:
EInvalidOperation if this is not a dictionary.
If a value with the given name already exists in the dictionary, then it
is freed and replaced. }
procedure AddOrSetNull(const AName: JsonString); inline;
{ Creates an array and adds or replaces it in this dictionary.
Parameters:
AName: the name (key) of the value to add.
Returns:
The newly created array.
Raises:
EInvalidOperation if this is not a dictionary.
If a value with the given name already exists in the dictionary, then it
is freed and replaced. }
function AddOrSetArray(const AName: JsonString): TJsonValue; inline;
{ Creates a dictionary and adds or replaces it in this dictionary.
Parameters:
AName: the name (key) of the value to add.
Returns:
The newly created dictionary.
Raises:
EInvalidOperation if this is not a dictionary.
If a value with the given name already exists in the dictionary, then it
is freed and replaced. }
function AddOrSetDictionary(const AName: JsonString): TJsonValue; inline;
{ Looks up a name in the dictionary.
Parameters:
AName: the name to lookup.
Returns:
The index of the value with this name, or -1 if the dictionary does not
contain a value with this name.
Raises:
EInvalidOperation if this is not a dictionary. }
function IndexOfName(const AName: JsonString): Integer; inline;
{ Checks if a name exists in the dictionary.
Parameters:
AName: the name to check.
Returns:
True if the dictionary contains a value with the given name, or False
otherwise.
Raises:
EInvalidOperation if this is not a dictionary. }
function Contains(const AName: JsonString): Boolean; inline;
{ Removes a value from the dictionary.
Parameters:
AName: the name of the value to remove.
Raises:
EInvalidOperation if this is not a dictionary.
Does nothing if the dictionary does not contain a value with the given
name. }
procedure Remove(const AName: JsonString); inline;
{ Tries to retrieve a value from the dictionary.
Parameters:
AName: the name of the value to retrieve.
AValue: is set to the retrieved value, or to a Null value if the
dictionary does not contain AName.
Returns:
True if the dictionary contains a value with the given name, or False
otherwise.
Raises:
EInvalidOperation if this is not a dictionary. }
function TryGetValue(const AName: JsonString; out AValue: TJsonValue): Boolean; inline;
{ The values in the dictionary, indexed by name.
Unlike the other dictionary-methods, this property NEVER raises an
exception. Instead, it returns a Null value if this is not a dictionary or
if the dictionary does not contain a value with the given name.
This allows for chaining without having to check every intermediate step,
as in Foo.Value['bar'].Values['baz'].ToInteger. }
property Values[const AName: JsonString]: TJsonValue read GetValue;
{ Alias for the Values property. Enables the default property using a
string index. That is:
MyValue['foo'];
is equivalent to
MyValue.Values['foo'];
There is also an indexer that uses an integer index, which is an alias for
the Items property. }
property _Indexer[const AName: JsonString]: TJsonValue read GetValue; default;
{ The elements (name/value pairs) in the dictionary by index.
Unlike the other dictionary-methods, this property NEVER raises an
exception. Instead, it returns nil if this is not a dictionary or if
AIndex is out of range.
NOTE: Do not cache the returned value; it is only valid until the
dictionary is deleted or modified. }
property Elements[const AIndex: Integer]: PJsonElement read GetElement;
end;
{ An element in a JSON dictionary. }
TJsonElement = record
{$REGION 'Internal Declarations'}
private
FName: JsonString;
FValue: TJsonValue;
{$ENDREGION 'Internal Declarations'}
public
{ The name of the element. }
property Name: JsonString read FName;
{ The value of the element. }
property Value: TJsonValue read FValue;
end;
type
{ Represents a JSON document.
This interface is implemented in the TJsonDocument class. }
IJsonDocument = interface
['{5F8E284C-9D7F-406C-8430-4BF64E6C4DB3}']
{$REGION 'Internal Declarations'}
function GetRoot: TJsonValue;
{$ENDREGION 'Internal Declarations'}
{ Saves the document to a file.
Parameters:
AFilename: the name of the file to save to.
AIndent: (optional) flag indicating whether you want indented (or
pretty-printed) output. If True, nested values will be indented and
line breaks will be inserted. If False (the default), then no line
breaks and indentation will be used. }
procedure Save(const AFilename: String; const AIndent: Boolean = False); overload;
{ Saves the document to a stream.
Parameters:
AStream: the stream to save to.
AIndent: (optional) flag indicating whether you want indented (or
pretty-printed) output. If True, nested values will be indented and
line breaks will be inserted. If False (the default), then no line
breaks and indentation will be used. }
procedure Save(const AStream: TStream; const AIndent: Boolean = False); overload;
{ Converts the document to a string in JSON format.
Parameters:
AIndent: (optional) flag indicating whether you want indented (or
pretty-printed) output. If True (the default), nested values will be
indented and line breaks will be inserted. If False, then no line
breaks and indentation will be used.
Returns:
The document in JSON format. }
function ToJson(const AIndent: Boolean = True): JsonString;
{ The root value of the document.
You access the JSON object model through this property. }
property Root: TJsonValue read GetRoot;
end;
type
{ A JSON document. Implements the IJsonDocument interface. }
TJsonDocument = class(TInterfacedObject, IJsonDocument)
{$REGION 'Internal Declarations'}
private
FRoot: TJsonValue;
private
constructor Create(const ARoot: TJsonValue); overload;
protected
{ IJsonDocument }
function GetRoot: TJsonValue;
procedure Save(const AFilename: String; const AIndent: Boolean = False); overload;
procedure Save(const AStream: TStream; const AIndent: Boolean = False); overload;
function ToJson(const AIndent: Boolean = True): JsonString;
public
constructor Create; overload; deprecated 'Use CreateArray, CreateDictionary, Parse or Load';
{$ENDREGION 'Internal Declarations'}
public
destructor Destroy; override;
{ Creates a new document with an empty array as root.
Returns:
The new document.
Use the Root property to start adding values to the array. }
class function CreateArray: IJsonDocument; static;
{ Creates a new document with an empty dictionary as root.
Returns:
The new document.
Use the Root property to start adding values to the dictionary. }
class function CreateDictionary: IJsonDocument; static;
{ Parses a JSON string into a document.
Parameters:
AJson: the JSON formatted string to parse.
Returns:
The document or nil in case AJson is empty.
Raises:
EJsonParserError if AJson is invalid or does not start with an array
or dictionary. }
class function Parse(const AJson: JsonString): IJsonDocument; static;
{ Loads a JSON document from a file.
Parameters:
AFilename: the name of the file to load.
Returns:
The document or nil in case the file is empty.
Raises:
EJsonParserError if the JSON is invalid or does not start with an array
or dictionary. }
class function Load(const AFilename: String): IJsonDocument; overload; static;
{ Loads a JSON document from a stream.
Parameters:
AFilename: the stream to load.
Returns:
The document or nil in case the stream is empty.
Raises:
EJsonParserError if the JSON is invalid or does not start with an array
or dictionary. }
class function Load(const AStream: TStream): IJsonDocument; overload; static;
{ Loads a JSON document from a JSON reader.
Parameters:
AReader: the reader to use.
Returns:
The document or nil in case AReader is nil or the contents is empty.
Raises:
EJsonParserError if the JSON is invalid or does not start with an array
or dictionary. }
class function Load(const AReader: IJsonReader): IJsonDocument; overload; static;
end;
type
TJsonValueHelper = record helper for TJsonValue
public const
{ A JSON Null value }
Null: TJsonValue = (FBits: 0);
end;
resourcestring
RS_JSON_INVALID_ROOT = 'JSON document must start with an array or dictionary.';
{$REGION 'Internal Declarations'}
const
_JSON_NULL_ELEMENT: TJsonElement = (FName: ''; FValue: (FBits: 0));
{$ENDREGION 'Internal Declarations'}
implementation
{$IF (TJsonValue.TYPE_FIXED <> 0)}
{$MESSAGE Error 'Internal Error: TJsonValue.TYPE_FIXED must have value 0'}
{$ENDIF}
{$IF (SizeOf(TJsonValue) <> SizeOf(Pointer))}
{$MESSAGE Error 'Internal Error: TJsonValue has invalid layout'}
{$ENDIF}
{$IF IsManagedType(TJsonValue)}
{$MESSAGE Error 'Internal Error: TJsonValue has managed fields'}
{$ENDIF}
{$POINTERMATH ON}
uses
System.RTLConsts,
Neslib.Utf8,
Neslib.Hash,
Neslib.SysUtils;
type
PInt32 = ^Int32;
{ TJsonValue }
procedure TJsonValue.Add(const AValue: Int64);
var
A: PJsonArray;
begin
A := PJsonArray(FBITS and VALUE_MASK);
if ((FBits and TYPE_MASK) <> TYPE_HEAP) or (A.FSubtype <> SUBTYPE_ARRAY) then
raise EInvalidOperation.Create('Add can only be used for JSON arrays');
A.Add(AValue);
end;
procedure TJsonValue.Add(const AValue: UInt32);
var
A: PJsonArray;
begin
A := PJsonArray(FBITS and VALUE_MASK);
if ((FBits and TYPE_MASK) <> TYPE_HEAP) or (A.FSubtype <> SUBTYPE_ARRAY) then
raise EInvalidOperation.Create('Add can only be used for JSON arrays');
A.Add(AValue);
end;
procedure TJsonValue.Add(const AValue: Int32);
var
A: PJsonArray;
begin
A := PJsonArray(FBITS and VALUE_MASK);
if ((FBits and TYPE_MASK) <> TYPE_HEAP) or (A.FSubtype <> SUBTYPE_ARRAY) then
raise EInvalidOperation.Create('Add can only be used for JSON arrays');
A.Add(AValue);
end;
procedure TJsonValue.Add(const AValue: Boolean);
var
A: PJsonArray;
begin
A := PJsonArray(FBITS and VALUE_MASK);
if ((FBits and TYPE_MASK) <> TYPE_HEAP) or (A.FSubtype <> SUBTYPE_ARRAY) then
raise EInvalidOperation.Create('Add can only be used for JSON arrays');
A.Add(AValue);
end;
procedure TJsonValue.Add(const AValue: UInt64);
var
A: PJsonArray;
begin
A := PJsonArray(FBITS and VALUE_MASK);
if ((FBits and TYPE_MASK) <> TYPE_HEAP) or (A.FSubtype <> SUBTYPE_ARRAY) then
raise EInvalidOperation.Create('Add can only be used for JSON arrays');
A.Add(AValue);
end;
procedure TJsonValue.Add(const AValue: JsonString);
var
A: PJsonArray;
begin
A := PJsonArray(FBITS and VALUE_MASK);
if ((FBits and TYPE_MASK) <> TYPE_HEAP) or (A.FSubtype <> SUBTYPE_ARRAY) then
raise EInvalidOperation.Create('Add can only be used for JSON arrays');