-
Notifications
You must be signed in to change notification settings - Fork 5
/
Copy pathqmsgpack.pas
4249 lines (4066 loc) · 123 KB
/
qmsgpack.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 qmsgpack;
{$i 'qdac.inc'}
interface
{
本源码来自QDAC项目，版权归swish(QQ:109867294)所有。
(1)、使用许可及限制
您可以自由复制、分发、修改本源码，但您的修改应该反馈给作者，并允许作者在必要时，
合并到本项目中以供使用，合并后的源码同样遵循QDAC版权声明限制。
您的产品的关于中，应包含以下的版本声明:
本产品使用的JSON解析器来自QDAC项目中的QJSON，版权归作者所有。
(2)、技术支持
有技术问题，您可以加入QDAC官方QQ群250530692共同探讨。
(3)、赞助
您可以自由使用本源码而不需要支付任何费用。如果您觉得本源码对您有帮助，您可以赞
助本项目（非强制），以使作者不为生活所迫，有更多的精力为您呈现更好的作品：
赞助方式：
支付宝： [email protected] 姓名：管耸寰
建设银行：
户名：管耸寰
账号：4367 4209 4324 0179 731
开户行：建设银行长春团风储蓄所
}
{ 修订日志
2014.11.9
==========
+ 新增IntByPath,IntByName，BoolByPath,BoolByName,FloatByPath,FloatByName,DateTimeByPath,
DateTimeByName函数，以简化判断编程(参考QJson)
2014.10.30
==========
+ 新增Detach、AttachTo、MoveTo、Remove函数
* 允许MsgPack结点名称重命名以避免调用MoveTo、AttachTo时元素未命名
2014.10.21
==========
* 修正了解析数组元素数量介于16-31之间时出错的问题（追梦报告）
2014.8.25
==========
* 修正了打开IO越界检查时，如果字符串长度为0,GetAsString出错的问题(天地弦报告)
2014.8.15
==========
* 修正了加载长二进制数据时，错误的跳过内容的前4个字节的问题(天地弦报告)
* 优化了AsVariant读写时，对字节数组时的转换效率
* 修正了CopyValue时，对于非字符串类型拷贝长度设置错误的问题
* 网络字节顺序和主机字节顺序转换统一改为使用ExchangeByteOrder函数完成
2014.8.2
=========
* 修正了SetAsString时如果长度为0时，未检查数组FValue造成访问越界的问题
2014.7.17
=========
* 合并QJson的相关RTTI函数(AK47完成)
2014.7.16
=========
* 修正了GetPath时，未初始化结果字符串造成Path属性可能出错的问题
2014.7.7
=========
* 修正了整数值-1~-31时，解码出错的问题(五毒报告)
2014.7.3
=========
* 修正了Assign时复制了当前结点名称的问题
2014.7.1
=========
* 修改AsString在空值时的返回内容为空字符串
2014.6.28
=========
* 修正了ForcePath('Items[]')默认添加了空子结点的问题(pony,光明报告)
+ 加入MsgPackRttiEnumAsInt全局选项，控制枚举值和集合值是否保存成其字符串表达，默认为True(同步自QJson)
2014.6.27
=========
* 修正了FromRTTI时，对于方法、事件等属性没有进行过滤的问题
* 修正了ToRtti.ToArray时，对于动态数组的设置长度时类型错误
* 修改了AsVariant的行为，对字节数组直接转换为TBytes，而不再使用普通的数组
2014.6.26
==========
* 修正了ToRtti.ToRecord子函数处理日期类型时的错误(感谢群友飞鸿大量的RTTI建议和测试)
* 加入HPPEMIT默认链接本单元(麦子仲肥 建议)
2014.6.23
==========
+ FromRecord支持动态数组和普通数组
2014.6.21
==========
+ 增加RTTI函数支持(Invoke/FromRtti/ToRtti/FromRecord/ToRecord)
2014.6.20
==========
+ 增加对Single类型的支持(AsSingle)，这样全部MessagePack格式的支持完整了
2014.6.19
==========
* 修正了QMsgPack解码时，对于长度为0的字符串解码出错的问题
2014.6.17
==========
* 首个正式版本发布，目前与RTTI相关的几个函数暂时不可用
}
uses classes, sysutils, math, qstring, qrbtree, typinfo,
variants
{$IFDEF UNICODE}, Generics.Collections, Rtti{$ENDIF}
{$IF RTLVersion<22}// 2007-2010
, PerlRegEx, pcre
{$ELSE}
, RegularExpressionsCore
{$IFEND};
{$HPPEMIT '#pragma link "qmsgpack"'}
type
TQMsgPack = class;
TQMsgPackType = (mptUnknown, mptInteger, mptNull, mptBoolean, mptSingle,
mptFloat, mptString, mptBinary, mptArray, mptMap, mptExtended, mptDateTime);
{$IFDEF UNICODE}
/// <summary>
/// RTTI信息过滤回调函数，在XE6上支持匿名函数，在XE及以前的版本采用事件回调
/// </summary>
/// <param name="ASender">触发事件的TQMsgPack对象</param>
/// <param name="AName">属性名(AddObject)或字段名(AddRecord)</param>
/// <param name="AType">属性或字段的类型信息</param>
/// <param name="Accept">是否记录该属性或字段</param>
/// <param name="ATag">用户自定义的附加数据成员</param>
TQMsgPackRttiFilterEventA = reference to procedure(ASender: TQMsgPack;
AObject: Pointer; AName: QStringW; AType: PTypeInfo; var Accept: Boolean;
ATag: Pointer);
/// <summary>
/// 结点过滤处理函数，以在XE6上支持匿名函数
/// </summary>
/// <param name="ASender">触发事件的TQMsgPack对象</param>
/// <param name="AItem">要过滤的对象</param>
/// <param name="Accept">是否要处理该对象</param>
/// <param name="ATag">用户附加的数据项</param>
TQMsgPackFilterEventA = reference to procedure(ASender, AItem: TQMsgPack;
var Accept: Boolean; ATag: Pointer);
{$ENDIF UNICODE}
/// <summary>
/// RTTI信息过滤回调函数，在XE6上支持匿名函数，在XE及以前的版本采用事件回调
/// </summary>
/// <param name="ASender">触发事件的TQMsgPack对象</param>
/// <param name="AName">属性名(AddObject)或字段名(AddRecord)</param>
/// <param name="AType">属性或字段的类型信息</param>
/// <param name="Accept">是否记录该属性或字段</param>
/// <param name="ATag">用户自定义的附加数据成员</param>
TQMsgPackRttiFilterEvent = procedure(ASender: TQMsgPack; AObject: Pointer;
AName: QStringW; AType: PTypeInfo; var Accept: Boolean; ATag: Pointer)
of object;
/// <summary>
/// 结点过滤处理函数，以在XE6上支持匿名函数
/// </summary>
/// <param name="ASender">触发事件的TQMsgPack对象</param>
/// <param name="AItem">要过滤的对象</param>
/// <param name="Accept">是否要处理该对象</param>
/// <param name="ATag">用户附加的数据项</param>
TQMsgPackFilterEvent = procedure(ASender, AItem: TQMsgPack;
var Accept: Boolean; ATag: Pointer) of object;
{$IFDEF UNICODE}
TQMsgPackList = TList<TQMsgPack>;
{$ELSE}
TQMsgPackList = TList;
{$ENDIF}
TQMsgPackEnumerator = class
private
FIndex: Integer;
FList: TQMsgPack;
public
constructor Create(AList: TQMsgPack);
function GetCurrent: TQMsgPack; inline;
function MoveNext: Boolean;
property Current: TQMsgPack read GetCurrent;
end;
TQMsgPack = class
private
FName: QStringW; // 名称
FNameHash: Cardinal; // 哈希值
FValue: TBytes; // 值
FItems: TQMsgPackList;
FParent: TQMsgPack;
FDataType: TQMsgPackType;
FExtType: Shortint;
FData: Pointer;
function GetAsBoolean: Boolean;
function GetAsDateTime: TDateTime;
function GetAsFloat: Double;
function GetAsInt64: Int64;
function GetAsInteger: Integer;
function GetAsMsgPack: TBytes;
function GetAsString: QStringW;
function GetAsVariant: Variant;
function GetCount: Integer;
function GetIsArray: Boolean;
function GetIsDateTime: Boolean;
function GetIsNull: Boolean;
function GetIsNumeric: Boolean;
function GetIsObject: Boolean;
function GetIsString: Boolean;
function GetItemIndex: Integer;
function GetItems(AIndex: Integer): TQMsgPack;
function GetPath: QStringW;
function GetValue: QStringW;
procedure SetAsBoolean(const Value: Boolean);
procedure SetAsDateTime(const Value: TDateTime);
procedure SetAsFloat(const Value: Double);
procedure SetAsInt64(const Value: Int64);
procedure SetAsInteger(const Value: Integer);
procedure SetAsMsgPack(const Value: TBytes);
procedure SetAsString(const Value: QStringW);
procedure SetAsVariant(const Value: Variant);
procedure SetDataType(const Value: TQMsgPackType);
procedure InternalParse(var p: PByte; l: Integer);
procedure ArrayNeeded(ANewType: TQMsgPackType);
function CreateItem: TQMsgPack; virtual;
procedure FreeItem(AItem: TQMsgPack); virtual;
procedure CopyValue(ASource: TQMsgPack); inline;
procedure SetExtType(const Value: Shortint);
function GetAsExtBytes: TBytes;
procedure SetExtBytes(const Value: TBytes);
function GetAsBytes: TBytes;
procedure SetAsBytes(const Value: TBytes);
function GetAsSingle: Single;
procedure SetAsSingle(const Value: Single);
procedure SetName(const Value: QStringW);
protected
procedure Replace(AIndex: Integer; ANewItem: TQMsgPack); virtual;
procedure DoNodeNameChanged(ANode: TQMsgPack); virtual;
public
/// <summary>构造函数</summary>
constructor Create; overload;
constructor Create(const AName: QStringW;
ADataType: TQMsgPackType = mptUnknown); overload;
/// <summary>析构函数</summary>
destructor Destroy; override;
{ <summary》添加一个子结点<、summary>
<param name="ANode">要添加的结点</param>
<returns>返回添加的结点索引</returns>
}
function Add(ANode: TQMsgPack): Integer; overload;
/// <summary>添加一个未命名的MsgPack子结点</summary>
/// <returns>返回添加的结点实例</returns>
/// <remarks>
/// 一般情况下，除非数组类型，不应添加未命名的实例
/// </remarks>
function Add: TQMsgPack; overload;
/// <summary>添加一个数组</summary>
/// <param name="AName">要添加的对象的结点名称</param>
/// <param name="AItems">要添加的数组内容</param>
/// <returns>返回创建的结点实例</returns>
function Add(const AName: QStringW; AItems: array of const)
: TQMsgPack; overload;
{ <summary>添加一个子结点</summary>
<param name="AName">要添加的结点名</param>
<param name="ADataType">要添加的结点数据类型，如果省略，则自动根据值的内容检测</param>
<returns>返回添加的新对象</returns>
<remarks>
1.如果当前类型不是jdtObject或jdtArray，将自动转换为jdtObject类型
2.上层应自己负责重名检查
</remarks>
}
function Add(AName: QStringW; ADataType: TQMsgPackType): TQMsgPack;
overload;
/// <summary>添加一个子结点</summary>
/// <param name="AName">要添加的结点名，如果当前结点为数组，则在输出时会忽略该值</param>
/// <param name="AValue">要添加的结点值</param>
/// <returns>返回添加的新对象</returns>
function Add(AName, AValue: QStringW): TQMsgPack; overload;
/// <summary>添加一个子结点</summary>
/// <param name="AName">要添加的结点名，如果当前结点为数组，则在输出时会忽略该值</param>
/// <param name="AValue">要添加的结点值</param>
/// <returns>返回添加的新对象</returns>
function Add(AName: QStringW; AValue: Double): TQMsgPack; overload;
/// <summary>添加一个子结点</summary>
/// <param name="AName">要添加的结点名，如果当前结点为数组，则在输出时会忽略该值</param>
/// <param name="AValue">要添加的结点值</param>
/// <returns>返回添加的新对象</returns>
function Add(AName: QStringW; AValue: Int64): TQMsgPack; overload;
/// <summary>添加一个子结点</summary>
/// <param name="AName">要添加的结点名，如果当前结点为数组，则在输出时会忽略该值</param>
/// <param name="AValue">要添加的结点值</param>
/// <returns>返回添加的新对象</returns>
function Add(AName: QStringW; AValue: Boolean): TQMsgPack; overload;
/// <summary>添加一个子结点</summary>
/// <param name="AName">要添加的结点名，如果当前结点为数组，则在输出时会忽略该值</param>
/// <param name="AValue">要添加的结点值</param>
/// <returns>返回添加的新对象</returns>
function Add(AName: QStringW; const AValue: TBytes): TQMsgPack; overload;
/// <summary>添加一个子结点</summary>
/// <param name="AName">要添加的结点名，如果当前结点为数组，则在输出时会忽略该值</param>
/// <param name="AValue">要添加的结点值</param>
/// <returns>返回添加的新对象</returns>
function AddDateTime(AName: QStringW; AValue: TDateTime)
: TQMsgPack; overload;
/// <summary>添加一个子结点(Null)</summary>
/// <param name="AName">要添加的结点名，如果当前结点为数组，则在输出时会忽略该值</param>
/// <returns>返回添加的新对象</returns>
function Add(AName: QStringW): TQMsgPack; overload; virtual;
/// <summary>强制一个路径存在,如果不存在,则依次创建需要的结点(jdtObject或jdtArray)</summary>
/// <param name="APath">要添加的结点路径</param>
/// <returns>返回路径对应的对象</returns>
/// <remarks>
/// 假设以下路径完全不存在，则ForcePath会按如下规则执行:
/// 1、如果APath中包含[]，则认为对应的路径结点为数组，示例如下：
/// (1)、'a.b[].name'：
/// a -> jdtObject
/// b -> jdtArray
/// b[0].name -> jdtNull(b的索引未指定，自动认为是b[0]
/// (2)、'a.c[2].name'：
/// a -> jdtObject
/// c -> jdtArray
/// c[2].name -> jdtNull
/// 其中,c[0],c[1]被自动创建，并赋值为jdtNull，执行完成后c为包含三个元素的数组
/// (3)、'a[0]'：
/// a -> jdtArray
/// a[0] -> jdtNull
/// 2、路径分隔符./\是等价的，并且结点名称中不应包含上述三个字符之一,即：
/// a.b.c和a\b\c和a/b/c是完全相同的路径
/// 3、如果APath指定的对象类型不匹配，则会抛出异常，如a为对象，但使用a[0].b访问时。
/// </remarks>
function ForcePath(APath: QStringW): TQMsgPack;
/// <summary>解析指定的MsgPack字节序列</summary>
/// <param name="p">要解析的字节序列</param>
/// <param name="l">字符串长度，<=0认为是以\0(#0)结尾的C语言标准字符串</param>
/// <remarks>如果l>=0，会检测p[l]是否为\0，如果不为\0，则会创建拷贝实例并解析拷贝实例</remarks>
procedure Parse(p: PByte; l: Integer = -1); overload;
/// <summary>解析指定的MsgPack字符串</summary>
/// <param name="s">要解析的MsgPack字符串</param>
procedure Parse(const s: TBytes); overload;
/// <summary>拷贝生成一个新的实例</summary>
/// <returns>返回新的拷贝实例</returns>
/// <remarks>因为是拷贝，所以新旧对象之间的内容变更没有任何关系，更改任意一个
/// 对象，不会对另外一个对象造成影响。
/// </remarks>
function Copy: TQMsgPack;
{$IFDEF UNICODE}
/// <summary>拷贝生成一个新的实例</summary>
/// <param name="ATag">用户附加的标签数据</param>
/// <param name="AFilter">用户过滤事件，用于控制要拷贝的内容</param>
/// <returns>返回新的拷贝实例</returns>
/// <remarks>因为是拷贝，所以新旧对象之间的内容变更没有任何关系，更改任意一个
/// 对象，不会对另外一个对象造成影响。
/// </remarks>
function CopyIf(const ATag: Pointer; AFilter: TQMsgPackFilterEventA)
: TQMsgPack; overload;
{$ENDIF UNICODE}
/// <summary>拷贝生成一个新的实例</summary>
/// <param name="ATag">用户附加的标签数据</param>
/// <param name="AFilter">用户过滤事件，用于控制要拷贝的内容</param>
/// <returns>返回新的拷贝实例</returns>
/// <remarks>因为是拷贝，所以新旧对象之间的内容变更没有任何关系，更改任意一个
/// 对象，不会对另外一个对象造成影响。
/// </remarks>
function CopyIf(const ATag: Pointer; AFilter: TQMsgPackFilterEvent)
: TQMsgPack; overload;
/// <summary>克隆生成一个新的实例</summary>
/// <returns>返回新的拷贝实例</returns>
/// <remarks>因为实际上执行的是拷贝，所以新旧对象之间的内容变更没有任何关系，
/// 更改任意一个对象，不会对另外一个对象造成影响，但此行为将来并不保证，可能
/// 会调整为引用，以便相互影响。
/// </remarks>
function Clone: TQMsgPack;
/// <summary>编码</summary>
/// <returns>返回编码后的字节流</returns>
/// <remarks>AsMsgPack等价于本函数</remarks>
function Encode: TBytes;
/// <summary>获取指定名称获取结点的值的字符串表示</summary>
/// <param name="AName">结点名称</param>
/// <returns>返回应结点的值</returns>
function ValueByName(AName, ADefVal: QStringW): QStringW;
/// <summary>获取指定名称获取结点的值的布尔值表示</summary>
/// <param name="AName">结点名称</param>
/// <param name="ADefVal">默认值</param>
/// <returns>返回应结点的值</returns>
function BoolByName(AName: QStringW; ADefVal: Boolean): Boolean;
/// <summary>获取指定名称获取结点的值的整数值表示</summary>
/// <param name="AName">结点名称</param>
/// <param name="ADefVal">默认值</param>
/// <returns>返回应结点的值</returns>
function IntByName(AName: QStringW; ADefVal: Int64): Int64;
/// <summary>获取指定名称获取结点的值的浮点值表示</summary>
/// <param name="AName">结点名称</param>
/// <param name="ADefVal">默认值</param>
/// <returns>返回应结点的值</returns>
function FloatByName(AName: QStringW; ADefVal: Extended): Extended;
/// <summary>获取指定名称获取结点的值的日期时间值表示</summary>
/// <param name="AName">结点名称</param>
/// <param name="ADefVal">默认值</param>
/// <returns>返回应结点的值</returns>
function DateTimeByName(AName: QStringW; ADefVal: TDateTime): TDateTime;
/// <summary>获取指定路径结点的值的字符串表示</summary>
/// <param name="AName">结点名称</param>
/// <returns>如果结果不存在，返回默认值，否则，返回原始值</returns>
function ValueByPath(APath, ADefVal: QStringW): QStringW;
/// <summary>获取指定路径结点的值的布尔值表示</summary>
/// <param name="AName">结点名称</param>
/// <param name="ADefVal">默认值</param>
/// <returns>如果结果不存在，返回默认值，否则，返回原始值</returns>
function BoolByPath(APath: QStringW; ADefVal: Boolean): Boolean;
/// <summary>获取指定路径结点的值的整数表示</summary>
/// <param name="AName">结点名称</param>
/// <param name="ADefVal">默认值</param>
/// <returns>如果结果不存在，返回默认值，否则，返回原始值</returns>
function IntByPath(APath: QStringW; ADefVal: Int64): Int64;
/// <summary>获取指定路径结点的值的浮点数表示</summary>
/// <param name="AName">结点名称</param>
/// <param name="ADefVal">默认值</param>
/// <returns>如果结果不存在，返回默认值，否则，返回原始值</returns>
function FloatByPath(APath: QStringW; ADefVal: Extended): Extended;
/// <summary>获取指定路径结点的值的日期时间表示</summary>
/// <param name="AName">结点名称</param>
/// <param name="ADefVal">默认值</param>
/// <returns>如果结果不存在，返回默认值，否则，返回原始值</returns>
function DateTimeByPath(APath: QStringW; ADefVal: TDateTime): TDateTime;
/// <summary>获取指定名称的第一个结点</summary>
/// <param name="AName">结点名称</param>
/// <returns>返回找到的结点，如果未找到，返回空(NULL/nil)</returns>
/// <remarks>注意QJson并不检查重名，因此，如果存在重名的结点，只会返回第一个结点</remarks>
/// <summary>获取指定名称的第一个结点</summary>
/// <param name="AName">结点名称</param>
/// <returns>返回找到的结点，如果未找到，返回空(NULL/nil)</returns>
/// <remarks>注意QMsgPack并不检查重名，因此，如果存在重名的结点，只会返回第一个结点</remarks>
function ItemByName(AName: QStringW): TQMsgPack; overload;
/// <summary>获取指定名称的结点到列表中</summary>
/// <param name="AName">结点名称</param>
/// <param name="AList">用于保存结点的列表对象</param>
/// <param name="ANest">是否递归查找子结点</param>
/// <returns>返回找到的结点数量，如果未找到，返回0</returns>
function ItemByName(const AName: QStringW; AList: TQMsgPackList;
ANest: Boolean = False): Integer; overload;
/// <summary>获取符合指定名称规则的结点到列表中</summary>
/// <param name="ARegex">正则表达式</param>
/// <param name="AList">用于保存结点的列表对象</param>
/// <param name="ANest">是否递归查找子结点</param>
/// <returns>返回找到的结点数量，如果未找到，返回0</returns>
function ItemByRegex(const ARegex: QStringW; AList: TQMsgPackList;
ANest: Boolean = False): Integer; overload;
/// <summary>获取指定路径的MsgPack对象</summary>
/// <param name="APath">路径，以"."或"/"或"\"分隔</param>
/// <returns>返回找到的子结点，如果未找到返回NULL(nil)</returns>
function ItemByPath(APath: QStringW): TQMsgPack;
/// <summary>从源对象复制MsgPack对象内容</summary>
/// <param name="ANode">要复制的源结点</param>
/// <remarks>注意不要复制子结点给自己，否则会造成死循环。要复制子结点，先复
/// 制一个子结点的新实例，再从新实例复制
/// </remarks>
procedure Assign(ANode: TQMsgPack); virtual;
/// <summary>删除指定索引的结点</summary>
/// <param name="AIndex">要删除的结点索引</param>
/// <remarks>
/// 如果指定索引的结点不存在，则抛出EOutRange异常
/// </remarks>
procedure Delete(AIndex: Integer); overload; virtual;
/// <summary>删除指定名称的结点</summary>
/// <param name="AName">要删除的结点名称</param>
/// <remarks>
/// 如果要多个重名的结点，则只删除第一个
procedure Delete(AName: QStringW); overload;
{$IFDEF UNICODE}
/// <summary>
/// 删除符合条件的子结点
/// </summary>
/// <param name="ATag">用户自己附加的额外标记</param>
/// <param name="ANest">是否嵌套调用，如果为false，则只对当前子结点过滤</param>
/// <param name="AFilter">过滤回调函数，如果为nil，等价于Clear</param>
procedure DeleteIf(const ATag: Pointer; ANest: Boolean;
AFilter: TQMsgPackFilterEventA); overload;
{$ENDIF UNICODE}
/// <summary>
/// 删除符合条件的子结点
/// </summary>
/// <param name="ATag">用户自己附加的额外标记</param>
/// <param name="ANest">是否嵌套调用，如果为false，则只对当前子结点过滤</param>
/// <param name="AFilter">过滤回调函数，如果为nil，等价于Clear</param>
procedure DeleteIf(const ATag: Pointer; ANest: Boolean;
AFilter: TQMsgPackFilterEvent); overload;
/// <summary>查找指定名称的结点的索引</summary>
/// <param name="AName">要查找的结点名称</param>
/// <returns>返回索引值，未找到返回-1</returns>
function IndexOf(const AName: QStringW): Integer; virtual;
{$IFDEF UNICODE}
/// <summary>遍历结点查找符合条件的结点</summary>
/// <param name="ATag">用户自定义的附加额外标记</param>
/// <param name="ANest">是否嵌套调用，如果为false，则只对当前子结点过滤</param>
/// <param name="AFilter">过滤回调函数，如果为nil，则返回nil</param>
function FindIf(const ATag: Pointer; ANest: Boolean;
AFilter: TQMsgPackFilterEventA): TQMsgPack; overload;
{$ENDIF UNICODE}
/// <summary>遍历结点查找符合条件的结点</summary>
/// <param name="ATag">用户自定义的附加额外标记</param>
/// <param name="ANest">是否嵌套调用，如果为false，则只对当前子结点过滤</param>
/// <param name="AFilter">过滤回调函数，如果为nil，则返回nil</param>
function FindIf(const ATag: Pointer; ANest: Boolean;
AFilter: TQMsgPackFilterEvent): TQMsgPack; overload;
/// <summary>清除所有的结点</summary>
procedure Clear; virtual;
/// <summary>保存当前对象内容到流中</summary>
/// <param name="AStream">目标流对象</param>
/// <param name="AEncoding">编码格式</param>
/// <param name="AWriteBom">是否写入BOM</param>
/// <remarks>注意当前结点的名称不会被写入</remarks>
procedure SaveToStream(AStream: TStream);
/// <summary>从流的当前位置开始加载MsgPack对象</summary>
/// <param name="AStream">源数据流</param>
/// <param name="AEncoding">源文件编码，如果为teUnknown，则自动判断</param>
/// <remarks>流的当前位置到结束的长度必需大于2字节，否则无意义</remarks>
procedure LoadFromStream(AStream: TStream);
/// <summary>保存当前对象内容到文件中</summary>
/// <param name="AFileName">文件名</param>
/// <param name="AEncoding">编码格式</param>
/// <param name="AWriteBOM">是否写入UTF-8的BOM</param>
/// <remarks>注意当前结点的名称不会被写入</remarks>
procedure SaveToFile(AFileName: String);
/// <summary>从指定的文件中加载当前对象</summary>
/// <param name="AFileName">要加载的文件名</param>
/// <param name="AEncoding">源文件编码，如果为teUnknown，则自动判断</param>
procedure LoadFromFile(AFileName: String);
/// / <summary>重置值为Null，等价于直接设置DataType为jdtNull</summary>
procedure ResetNull;
/// <summary>重载TObject.ToString函数</summary>
function ToString: string; {$IFDEF UNICODE}override; {$ELSE}virtual;
{$ENDIF}
{$IFDEF UNICODE}
/// <summary>使用当前Json对象参数调用指定对象的相应函数</summary>
/// <param name="AInstance">函数所隶属的对象实例</param>
/// <returns>返回函数调用的结果</returns>
/// <remarks>函数名称为当前结点名称，函数的参数名称与子结点的名称要保持一致</remarks>
function Invoke(AInstance: TValue): TValue;
/// <summary>将当前的值转换为TValue类型的值</summary>
/// <returns>返回当前结点转换后的TValue值</returns>
function ToRttiValue: TValue;
/// <summary>从指定的RTTI实例中生成JSON数据</summary>
/// <param name="AInstance">对象或其它RTTI类型值</param>
/// <remarks>注意不是全部RTTI类型都受支持，如接口啥的</remarks>
procedure FromRtti(AInstance: TValue); overload;
/// <summary>将指定的来源地址按指定的类型生成JSON数据</summary>
/// <param name="ASource">对象或结构体地址</param>
/// <param name="AType">对象或结构体类型信息</param>
procedure FromRtti(ASource: Pointer; AType: PTypeInfo); overload;
/// <summary>从指定的记录实例中生成JSON数据</summary>
/// <param name="ARecord">记录实例</param>
procedure FromRecord<T>(const ARecord: T);
/// <summary>从当前JSON中还原到指定的对象实例中</summary>
/// <param name="AInstance">实例地址</param>
/// <remarks>实际上参数只支持对象，记录由于目前无法直接转换为TValue，所以没
/// 意义，而其它类型因为是值拷贝，实际就算赋值了也返回不了，因此无意义</remarks>
procedure ToRtti(AInstance: TValue); overload;
/// <summary>从当前JSON中按指定的类型信息还原到指定的地址</summary>
/// <param name="ADest">目的地址</param>
/// <param name="AType">对象或结构体的类型信息</param>
/// <remarks>ADest对应的应是记录或对象，其它类型不受支持</remarks>
procedure ToRtti(ADest: Pointer; AType: PTypeInfo); overload;
/// <summary>从当前的JSON中还原到指定的记录实例中</summary>
/// <param name="ARecord">目的记录实例</param>
procedure ToRecord<T: record >(var ARecord: T);
{$ENDIF}
function GetEnumerator: TQMsgPackEnumerator;
/// <summary>判断自己是否是一个指定的对象的子对象</summary>
/// <param name="AParent">可能的父对象</param>
/// <returns>如果自己是指定对象的子对象，则返回True，否则，返回False</returns>
function IsChildOf(AParent: TQMsgPack): Boolean;
/// <summary>判断自己是否是一个指定的对象的父对象</summary>
/// <param name="AParent">可能的子对象</param>
/// <returns>如果自己是指定对象的父对象，则返回True，否则，返回False</returns>
function IsParentOf(AChild: TQMsgPack): Boolean;
/// <summary>从流中加载二进制数据</summary>
/// <param name="AStream">源数据流</param>
/// <param name="ACount">要拷贝的字节数，如果为0，则拷贝源数据流的全部内容</param>
procedure BytesFromStream(AStream: TStream; ACount: Integer);
/// <summary>从文件中加载二进制数据</summary>
/// <param name="AFileName">源文件名</param>
procedure BytesFromFile(AFileName: QStringW);
/// <summary>将当前数据保存到流中</summary>
/// <param name="AStream">目标数据流</param>
procedure BytesToStream(AStream: TStream);
/// <summary>将当前数据保存到文件中</summary>
/// <param name="AFileName">目标文件名</param>
procedure BytesToFile(AFileName: QStringW);
/// <summary>将指定索引的子结点移除</summary>
/// <param name="AItemIndex">要移除的子结点索引</param>
/// <returns>返回被移除的子结点，如果指定的索引不存在，返回nil</returns>
/// <remarks>被移除的子结点需要用户自己手工释放</remarks>
function Remove(AItemIndex: Integer): TQMsgPack; overload; virtual;
/// <summary>将指定的子结点移除</summary>
/// <param name="ANode">要移除的子结点</param>
/// <remarks>被移除的子结点需要用户自己手工释放</remarks>
procedure Remove(ANode: TQMsgPack); overload;
/// <summary>从当前XML父结点中分离当前结点</summary>
/// <remarks>分离后的结点需要单独释放</remarks>
procedure Detach;
/// <summary>将当前结点附加到新的父结点上</summary>
/// <param name="AParent">要附加的目标结点</param>
/// <remarks>附加后的结点由父结点负责释放</remarks>
procedure AttachTo(ANewParent: TQMsgPack);
/// <summary>将当前结点移动的新的父结点的指定位置</summary>
/// <param name="ANewParent">新的父结点</param>
/// <param name="AIndex">新位置索引</param>
/// <remarks>如果新位置索引小于等于0，则插入到起始位置，如果大于父的已有结点数量，则插入到
/// 父结点末尾，否则添加到指定位置</remarks>
procedure MoveTo(ANewParent: TQMsgPack; AIndex: Integer);
/// <summary>父结点</summary>
property Parent: TQMsgPack read FParent;
/// <summary>结点类型</summary>
/// <seealso>TQMsgPackType</seealso>
property DataType: TQMsgPackType read FDataType write SetDataType;
/// <summary>结点名称</summary>
property Name: QStringW read FName write SetName;
/// <summary>子结点数量</<summary>summary>
property Count: Integer read GetCount;
/// <summary>子结点数组</summary>
property Items[AIndex: Integer]: TQMsgPack read GetItems; default;
/// <summary>子结点的值</summary>
property Value: QStringW read GetValue;
/// <summary>判断是否是NULL类型</summary>
property IsNull: Boolean read GetIsNull;
/// <summary>判断是否是数字类型</summary>
property IsNumeric: Boolean read GetIsNumeric;
/// <summary>判断是否是日期时间类型</summary>
property IsDateTime: Boolean read GetIsDateTime;
/// <summary>判断是否是字符串类型</summary>
property IsString: Boolean read GetIsString;
/// <summary>判断是否是对象</summary>
property IsObject: Boolean read GetIsObject;
/// <summary>判断是否是数组</summary>
property IsArray: Boolean read GetIsArray;
/// <summary>将当前结点当作布尔类型访问</summary>
property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
/// <summary>将当前结点作为字节流来访问</summary>
property AsBytes: TBytes read GetAsBytes write SetAsBytes;
/// <summary>将当前结点当作整数类型来访问</summary>
property AsInteger: Integer read GetAsInteger write SetAsInteger;
/// <summary>将当前结点当作64位整数类型来访问</summary>
property AsInt64: Int64 read GetAsInt64 write SetAsInt64;
/// <summary>将当前结点当作双浮点类型来访问</summary>
property AsFloat: Double read GetAsFloat write SetAsFloat;
/// <summary>将当前结点当作单精度浮点类型来访问</summary>
property AsSingle: Single read GetAsSingle write SetAsSingle;
/// <summary>将当前结点当作日期时间类型来访问</summary>
property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
/// <summary>将当前结点当作字符串类型访问</summary>
property AsString: QStringW read GetAsString write SetAsString;
/// <summary>将自己当做Variant类型来访问</summary>
property AsVariant: Variant read GetAsVariant write SetAsVariant;
/// <summary>将自己当做MsgPack序列来访问</summary>
property AsMsgPack: TBytes read GetAsMsgPack write SetAsMsgPack;
/// <summary>将自己当做扩展对象来访问</summary>
property AsExtBytes: TBytes read GetAsExtBytes write SetExtBytes;
// <summary>额外的附加数据成员，供用户关联附加内容</summary>
property Data: Pointer read FData write FData;
/// <summary>结点的路径，路径中间以"\"分隔</summary>
property Path: QStringW read GetPath;
/// <summary>在父结点中的索引顺序，从0开始，如果是-1，则代表自己是根结点</summary>
property ItemIndex: Integer read GetItemIndex;
/// <summary>名称哈希值</summary>
property NameHash: Cardinal read FNameHash;
/// <summary>扩展类型</summary>
property ExtType: Shortint read FExtType write SetExtType;
end;
TQHashedMsgPack = class(TQMsgPack)
protected
FHashTable: TQHashTable;
function CreateItem: TQMsgPack; override;
procedure Replace(AIndex: Integer; ANewItem: TQMsgPack); override;
procedure DoNodeNameChanged(ANode: TQMsgPack); override;
public
constructor Create; overload;
destructor Destroy; override;
procedure Assign(ANode: TQMsgPack); override;
function Add(AName: QStringW): TQMsgPack; override;
function IndexOf(const AName: QStringW): Integer; override;
function Remove(AIndex: Integer): TQMsgPack; override;
procedure Clear; override;
end;
/// <summary>用于外部支持对象池的函数，创建一个新的TQMsgPack对象，注意从池中创建的对象</summary>
/// <returns>返回新创建的TQMsgPack对象</returns>
TQMsgPackCreateEvent = function: TQMsgPack;
/// <summary>用于外部将对象缓存，以便重用对象</summary>
/// <param name="AObj">要释放的MsgPack对象</param>
TQMsgPackFreeEvent = procedure(AObj: TQMsgPack);
var
/// <summary>日期类型转换为字符串时，这个变量控制如何格式化</summary>
MsgPackDateFormat: QStringW;
/// <summary>时间类型转换为字符串时，这个变量控制如何格式化</summary>
MsgPackTimeFormat: QStringW;
/// <summary>日期时间类型转换为字符串时，这个变量控制如何格式化</summary>
MsgPackDateTimeFormat: QStringW;
/// <summary>在ItemByName/ItemByPath/ValueByName/ValueByPath等函数的判断中，是否区分名称大小写</summary>
MsgPackCaseSensitive: Boolean;
/// <summary>指定如何处理RTTI中的枚举和集合类型</summary>
MsgPackRttiEnumAsInt: Boolean;
/// 在需要新建一个TQMsgPack对象时触发
OnQMsgPackCreate: TQMsgPackCreateEvent;
/// 在需要释放一个TQMsgPack对象时触发
OnQMsgPackFree: TQMsgPackFreeEvent;
QMsgPackPathDelimiter: QCharW = '\';
implementation
resourcestring
SNotArrayOrMap = '%s 不是映射或数组。';
SUnsupportArrayItem = '添加的动态数组第%d个元素类型不受支持。';
SBadMsgPackArray = '%s 不是一个有效的MsgPack数组定义。';
SBadMsgPackName = '%s 不是一个有效的MsgPack名称。';
SBadConvert = '%s 不是一个有效的 %s 类型的值。';
SVariantNotSupport = '不支持转换为Variant类型。';
SNotSupport = '函数 [%s] 在当前开发环境下不受支持。';
SReservedExtType = '<0的扩展类型被标准声明为保留不可用。';
SReplaceTypeNeed = '替换结点的类型要求是 %s 或其子类。';
SParamMissed = '参数 %s 同名的结点未找到。';
SMethodMissed = '指定的函数 %s 不存在。';
SMissRttiTypeDefine =
'无法找到 %s 的RTTI类型信息，尝试将对应的类型单独定义(如array[0..1] of Byte改为TByteArr=array[0..1]，然后用TByteArr声明)。';
SUnsupportPropertyType = '不支持的属性类型';
SUnsupportValueType = 'TValue不支持二进制或扩展类型.';
SArrayTypeMissed = '未知的数组元素类型。';
SMapNameMissed = '映射名称未找到，无效和MessagePack格式？';
SCantAttachToSelf = '不允许自己附加为自己的子结点。';
SCanAttachToNoneContainer = '不能将结点附加到非数组和映射类型的结点下。';
SCantAttachNoNameNodeToObject = '不能将未命名的结点做为映射类型的子结点。';
SNodeNameExists = '指定的父结点下已经存在名为 %s 的子结点。';
SCantMoveToChild = '不能将自己移动到自己的子结点下面';
type
TQMsgPackValue = packed record
ValueType: Byte;
case Integer of
0:
(U8Val: Byte);
1:
(I8Val: Shortint);
2:
(U16Val: Word);
3:
(I16Val: Smallint);
4:
(U32Val: Cardinal);
5:
(I32Val: Integer);
6:
(U64Val: UInt64);
7:
(I64Val: Int64);
8:
(F32Val: Single);
9:
(F64Val: Double);
10:
(BArray: array [0 .. 16] of Byte);
end;
const
MsgPackTypeName: array [0 .. 10] of QStringW = ('Unknown', 'Integer', 'Null',
'Boolean', 'Float', 'String', 'Binary', 'Array', 'Map', 'Extended',
'DateTime');
{ TQMsgPack }
constructor TQMsgPack.Create;
begin
inherited;
end;
constructor TQMsgPack.Create(const AName: QStringW; ADataType: TQMsgPackType);
begin
FName := AName;
DataType := ADataType;
end;
function TQMsgPack.CreateItem: TQMsgPack;
begin
if Assigned(OnQMsgPackCreate) then
Result := OnQMsgPackCreate
else
Result := TQMsgPack.Create;
end;
function TQMsgPack.DateTimeByName(AName: QStringW;
ADefVal: TDateTime): TDateTime;
var
AChild: TQMsgPack;
begin
AChild := ItemByName(AName);
if Assigned(AChild) then
begin
try
Result := AChild.AsDateTime;
except
Result:=ADefVal;
end;
end
else
Result := ADefVal;
end;
function TQMsgPack.DateTimeByPath(APath: QStringW;
ADefVal: TDateTime): TDateTime;
var
AItem: TQMsgPack;
begin
AItem := ItemByPath(APath);
if Assigned(AItem) then
begin
try
Result := AItem.AsDateTime;
except
Result := ADefVal;
end;
end
else
Result := ADefVal;
end;
procedure TQMsgPack.Delete(AName: QStringW);
var
I: Integer;
begin
I := IndexOf(AName);
if I <> -1 then
Delete(I);
end;
procedure TQMsgPack.Delete(AIndex: Integer);
begin
if FDataType in [mptArray, mptMap] then
begin
FreeItem(Items[AIndex]);
FItems.Delete(AIndex);
end
else
raise Exception.Create(Format(SNotArrayOrMap, [FName]));
end;
procedure TQMsgPack.DeleteIf(const ATag: Pointer; ANest: Boolean;
AFilter: TQMsgPackFilterEvent);
procedure DeleteChildren(AParent: TQMsgPack);
var
I: Integer;
Accept: Boolean;
AChild: TQMsgPack;
begin
I := 0;
while I < AParent.Count do
begin
Accept := True;
AChild := AParent.Items[I];
if ANest then
DeleteChildren(AChild);
AFilter(Self, AChild, Accept, ATag);
if Accept then
AParent.Delete(I)
else
Inc(I);
end;
end;
begin
if Assigned(AFilter) then
DeleteChildren(Self)
else
Clear;
end;
{$IFDEF UNICODE}
procedure TQMsgPack.DeleteIf(const ATag: Pointer; ANest: Boolean;
AFilter: TQMsgPackFilterEventA);
procedure DeleteChildren(AParent: TQMsgPack);
var
I: Integer;
Accept: Boolean;
AChild: TQMsgPack;
begin
I := 0;
while I < AParent.Count do
begin
Accept := True;
AChild := AParent.Items[I];
if ANest then
DeleteChildren(AChild);
AFilter(Self, AChild, Accept, ATag);
if Accept then
AParent.Delete(I)
else
Inc(I);
end;
end;
begin
if Assigned(AFilter) then
DeleteChildren(Self)
else
Clear;
end;
{$ENDIF UNICODE}
destructor TQMsgPack.Destroy;
begin
if DataType in [mptArray, mptMap] then
begin
Clear;
FreeObject(FItems);
end;
inherited;
end;
procedure TQMsgPack.Detach;
begin
if Assigned(FParent) then
FParent.Remove(Self);
end;
procedure TQMsgPack.DoNodeNameChanged(ANode: TQMsgPack);
begin
end;
function TQMsgPack.Add(const AName: QStringW; AItems: array of const)
: TQMsgPack;
var
I: Integer;
begin
Result := Add(AName, mptArray);
for I := Low(AItems) to High(AItems) do
begin
case AItems[I].VType of
vtInteger:
Result.Add.AsInteger := AItems[I].VInteger;
vtBoolean:
Result.Add.AsBoolean := AItems[I].VBoolean;
{$IFNDEF NEXTGEN}
vtChar:
Result.Add.AsString := QStringW(AItems[I].VChar);
{$ENDIF !NEXTGEN}
vtExtended:
Result.Add.AsFloat := AItems[I].VExtended^;
{$IFNDEF NEXTGEN}
vtPChar:
Result.Add.AsString := QStringW(AItems[I].VPChar);
vtString:
Result.Add.AsString := QStringW(AItems[I].VString^);
vtAnsiString:
Result.Add.AsString := QStringW(
{$IFDEF UNICODE}
PAnsiString(AItems[I].VAnsiString)^
{$ELSE}
AItems[I].VPChar
{$ENDIF UNICODE}
);
vtWideString:
Result.Add.AsString := PWideString(AItems[I].VWideString)^;
{$ENDIF !NEXTGEN}
vtPointer:
Result.Add.AsInt64 := IntPtr(AItems[I].VPointer);
vtWideChar:
Result.Add.AsString := AItems[I].VWideChar;
vtPWideChar:
Result.Add.AsString := AItems[I].VPWideChar;
vtCurrency:
Result.Add.AsFloat := AItems[I].VCurrency^;
vtInt64:
Result.Add.AsInt64 := AItems[I].VInt64^;
{$IFDEF UNICODE} // variants
vtUnicodeString:
Result.Add.AsString := AItems[I].VPWideChar;
{$ENDIF UNICODE}
vtVariant:
Result.Add.AsVariant := AItems[I].VVariant^;
vtObject:
begin
if TObject(AItems[I].VObject) is TQMsgPack then
Result.Add(TObject(AItems[I].VObject) as TQMsgPack)
else
raise Exception.Create(Format(SUnsupportArrayItem, [I]));
end
else
raise Exception.Create(Format(SUnsupportArrayItem, [I]));
end; // End case
end; // End for
end;
function TQMsgPack.Add(AName: QStringW; ADataType: TQMsgPackType): TQMsgPack;
begin
Result := Add(AName);
Result.DataType := ADataType;
end;
function TQMsgPack.Add: TQMsgPack;
begin
ArrayNeeded(mptMap);
Result := TQMsgPack.Create;
Result.FParent := Self;
FItems.Add(Result);
end;
function TQMsgPack.Add(AName: QStringW; AValue: Boolean): TQMsgPack;
begin
Result := Add(AName);
Result.AsBoolean := AValue;
end;