From eee7b743f7a1a2a0091146f266df07037fd31695 Mon Sep 17 00:00:00 2001 From: QDAC <286195153@qq.com> Date: Mon, 15 Apr 2019 11:25:41 +0800 Subject: [PATCH] =?UTF-8?q?[SVN=E7=89=88=E6=9C=AC:820]?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 修正了 Unsubscribe 没有传送 QoS 级别造成部分服务器可能会断开连接的问题 + 增加 PopupPosition/PopupMonitor 属性 * 优化 CustomDialog 显示效果 [SVN版本:819] + 增加示例 [SVN版本:818] [QMQTT] * Windows 平台启用 OpenSSL 编译选项 * 修正了 Windows 平台下编译错误的问题 [qrbtree] * 移除 QWorker 的引用 [SVN版本:817] [QMQTT] + 增加跨平台支持 [QString] + 修正了非 Windows 平台获取时区代码无法编译的问题 + 修正了 ParseInt 在超过64位整数表示范围的数字时没有正确处理溢出的问题 [QJson] + 增加 jdtBcd 类型和 AsBcd 属性来处理超大数字的表示问题（如果超出BCD的表示范围，俺表示概不负责，您那个时候应该用字符串来表示了，感谢AK47反馈并测试验证） --- Demos/Delphi/VCL/dialgBuilder/Unit1.dfm | 55 +- Demos/Delphi/VCL/dialgBuilder/Unit1.pas | 85 +-- Source/QMqttClient.pas | 405 +++++++----- Source/qdialog_builder.pas | 321 +++++++-- Source/qjson.pas | 839 +++++++++--------------- Source/qrbtree.pas | 2 - Source/qstring.pas | 34 +- 7 files changed, 950 insertions(+), 791 deletions(-) diff --git a/Demos/Delphi/VCL/dialgBuilder/Unit1.dfm b/Demos/Delphi/VCL/dialgBuilder/Unit1.dfm index 50e155c..5bb115d 100644 --- a/Demos/Delphi/VCL/dialgBuilder/Unit1.dfm +++ b/Demos/Delphi/VCL/dialgBuilder/Unit1.dfm @@ -2,7 +2,7 @@ object Form1: TForm1 Left = 0 Top = 0 Caption = 'Dialog Builder '#31034#20363 - ClientHeight = 375 + ClientHeight = 396 ClientWidth = 574 Color = clWindow Font.Charset = DEFAULT_CHARSET @@ -16,12 +16,12 @@ object Form1: TForm1 TextHeight = 13 object Label1: TLabel Left = 24 - Top = 354 + Top = 370 Width = 3 Height = 13 end object Button1: TButton - Left = 16 + Left = 8 Top = 8 Width = 120 Height = 32 @@ -128,4 +128,53 @@ object Form1: TForm1 TabOrder = 11 OnClick = Button12Click end + object GroupBox1: TGroupBox + Left = 24 + Top = 160 + Width = 521 + Height = 201 + Caption = 'Popup position' + TabOrder = 12 + object RadioGroup1: TRadioGroup + AlignWithMargins = True + Left = 5 + Top = 18 + Width = 236 + Height = 178 + Align = alLeft + Caption = 'Position' + Columns = 2 + ItemIndex = 0 + Items.Strings = ( + 'dppDefault' + 'dppLeftTop' + 'dppCenterTop' + 'dppRightTop' + 'dppLeftCenter' + 'dppCenter' + 'dppRightCenter' + 'dppLeftBottom' + 'dppCenterBottom' + 'dppRightBottom') + TabOrder = 0 + end + object Button13: TButton + Left = 336 + Top = 32 + Width = 121 + Height = 57 + Caption = 'Popup on control' + TabOrder = 1 + OnClick = Button13Click + end + object Button14: TButton + Left = 336 + Top = 95 + Width = 121 + Height = 57 + Caption = 'Popup on monitor' + TabOrder = 2 + OnClick = Button14Click + end + end end diff --git a/Demos/Delphi/VCL/dialgBuilder/Unit1.pas b/Demos/Delphi/VCL/dialgBuilder/Unit1.pas index 3870cda..1bd7178 100644 --- a/Demos/Delphi/VCL/dialgBuilder/Unit1.pas +++ b/Demos/Delphi/VCL/dialgBuilder/Unit1.pas @@ -23,6 +23,10 @@ TForm1 = class(TForm) Button10: TButton; Button11: TButton; Button12: TButton; + GroupBox1: TGroupBox; + RadioGroup1: TRadioGroup; + Button13: TButton; + Button14: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); @@ -35,11 +39,13 @@ TForm1 = class(TForm) procedure Button10Click(Sender: TObject); procedure Button11Click(Sender: TObject); procedure Button12Click(Sender: TObject); + procedure Button13Click(Sender: TObject); + procedure Button14Click(Sender: TObject); private { Private declarations } FBuilder: IDialogBuilder; FEditor: TEdit; - procedure DoDialogResult(FBuilder: IDialogBuilder); + procedure DoDialogResult(ABuilder: IDialogBuilder); procedure ValidBuilder; procedure LoadUser32Icon(APicture: TPicture; AResId: Integer); public @@ -55,8 +61,7 @@ implementation procedure TForm1.Button10Click(Sender: TObject); begin - CustomDialog('Զرմ', 'ڽ5ر', 'AFlags 16λΪʱ', ['ر'], - diInformation, CDF_DISPLAY_REMAIN_TIME or 5); + CustomDialog('Զرմ', 'ڽ5ر', 'AFlags 16λΪʱ', ['ر'], diInformation, CDF_DISPLAY_REMAIN_TIME or 5); end; procedure TForm1.Button11Click(Sender: TObject); @@ -70,6 +75,7 @@ procedure TForm1.Button11Click(Sender: TObject); ABuilder := NewDialog('ȴ'); ABuilder.ItemSpace := 10; ABuilder.AutoSize := True; + ABuilder.Dialog.Padding.SetBounds(5, 5, 5, 5); AHint := TLabel(ABuilder.AddControl(TLabel).Control); AHint.Caption := 'ڴ0%...'; AHint.AlignWithMargins := True; @@ -111,10 +117,7 @@ procedure TForm1.Button12Click(Sender: TObject); begin ABuilder := NewDialog; ABuilder.AutoSize := True; - ABuilder.Dialog.Padding.Left := 5; - ABuilder.Dialog.Padding.Top := 5; - ABuilder.Dialog.Padding.Right := 5; - ABuilder.Dialog.Padding.Bottom := 5; + ABuilder.Dialog.Padding.SetBounds(5, 5, 5, 5); for I := 0 to 5 do begin with ABuilder.AddContainer(amHorizLeft) do @@ -151,6 +154,20 @@ procedure TForm1.Button12Click(Sender: TObject); end; end; +procedure TForm1.Button13Click(Sender: TObject); +begin + ValidBuilder; + FBuilder.PopupPosition := TQDialogPopupPosition(RadioGroup1.ItemIndex); + FBuilder.Popup(GroupBox1); +end; + +procedure TForm1.Button14Click(Sender: TObject); +begin + ValidBuilder; + FBuilder.PopupPosition := TQDialogPopupPosition(RadioGroup1.ItemIndex); + FBuilder.Popup(nil); +end; + procedure TForm1.Button1Click(Sender: TObject); begin ValidBuilder; @@ -171,11 +188,10 @@ procedure TForm1.Button3Click(Sender: TObject); begin // ʾʾͨPropTextԼûСѡб ABuilder := NewDialog('ѡĿ'); + ABuilder.Dialog.Padding.SetBounds(5, 5, 5, 5); ABuilder.PropText := '{"Width":300,"Height":150}'; - ABuilder.AddControl(TRadioButton, - '{"Caption":"Ŀһ","AlignWithMargins":True,"Margins":{"Left":10},"Height":30}'); - ABuilder.AddControl(TRadioButton, - '{"Caption":"Ŀ","AlignWithMargins":True,"Margins":{"Left":10},"Height":30}'); + ABuilder.AddControl(TRadioButton, '{"Caption":"Ŀһ","AlignWithMargins":True,"Margins":{"Left":10},"Height":30}'); + ABuilder.AddControl(TRadioButton, '{"Caption":"Ŀ","AlignWithMargins":True,"Margins":{"Left":10},"Height":30}'); with ABuilder.AddContainer(amHorizRight) do begin Height := 32; @@ -189,8 +205,7 @@ procedure TForm1.Button3Click(Sender: TObject); begin if Supports(ABuilder[I], IControlDialogItem, ACtrl) then begin - if (ACtrl.Control is TRadioButton) and - (TRadioButton(ACtrl.Control).Checked) then + if (ACtrl.Control is TRadioButton) and (TRadioButton(ACtrl.Control).Checked) then begin ShowMessage(TRadioButton(ACtrl.Control).Caption + ' ѡ'); Break; @@ -207,6 +222,7 @@ procedure TForm1.Button4Click(Sender: TObject); ABuilder := NewDialog('ʾ'); ABuilder.ItemSpace := 10; ABuilder.AutoSize := True; + ABuilder.Dialog.Padding.SetBounds(5, 5, 5, 5); with TLabel(ABuilder.AddControl(TLabel).Control) do begin Caption := '𴲻·ˣ'; @@ -238,33 +254,28 @@ procedure TForm1.Button5Click(Sender: TObject); // ʾʾ÷ ABuilder := NewDialog('ʾ'); ABuilder.AutoSize := True; + ABuilder.Dialog.Padding.SetBounds(5, 5, 5, 5); // ӵһRadioButton with ABuilder.AddContainer(amVertTop) do begin ItemSpace := 10; AutoSize := True; - AddControl(TLabel, - '{"Caption":"һ","Color":"clGray","Transparent":False,"Font":{"Color":"clWhite","Size":11}}'); - AddControl(TRadioButton, - '{"Caption":"ǵһĵһ","AlignWithMargins":True,"Margins":{"Left":10},"Height":30}') - .GroupName := 'Group1'; - AddControl(TRadioButton, - '{"Caption":"ǵһĵڶ","AlignWithMargins":True,"Margins":{"Left":10},"Height":30}') - .GroupName := 'Group1'; + AddControl(TLabel, '{"Caption":"һ","Color":"clGray","Transparent":False,"Font":{"Color":"clWhite","Size":11}}'); + AddControl(TRadioButton, '{"Caption":"ǵһĵһ","AlignWithMargins":True,"Margins":{"Left":10},"Height":30}').GroupName + := 'Group1'; + AddControl(TRadioButton, '{"Caption":"ǵһĵڶ","AlignWithMargins":True,"Margins":{"Left":10},"Height":30}').GroupName + := 'Group1'; end; // ӵڶRadioButton with ABuilder.AddContainer(amVertTop) do begin AutoSize := True; ItemSpace := 10; - AddControl(TLabel, - '{"Caption":"ڶ","Color":"clGray","Transparent":False,"Font":{"Color":"clWhite","Size":11}}'); - AddControl(TRadioButton, - '{"Caption":"ǵڶĵһ","AlignWithMargins":True,"Margins":{"Left":10},"Height":30}') - .GroupName := 'Group2'; - AddControl(TRadioButton, - '{"Caption":"ǵڶĵڶ","AlignWithMargins":True,"Margins":{"Left":10},"Height":30}') - .GroupName := 'Group2'; + AddControl(TLabel, '{"Caption":"ڶ","Color":"clGray","Transparent":False,"Font":{"Color":"clWhite","Size":11}}'); + AddControl(TRadioButton, '{"Caption":"ǵڶĵһ","AlignWithMargins":True,"Margins":{"Left":10},"Height":30}').GroupName + := 'Group2'; + AddControl(TRadioButton, '{"Caption":"ǵڶĵڶ","AlignWithMargins":True,"Margins":{"Left":10},"Height":30}').GroupName + := 'Group2'; end; with ABuilder.AddContainer(amHorizRight) do begin @@ -304,6 +315,7 @@ procedure TForm1.Button7Click(Sender: TObject); ABuilder := NewDialog(''); ABuilder.AutoSize := True; ABuilder.ItemSpace := 5; + ABuilder.Dialog.Padding.SetBounds(5, 5, 5, 5); with ABuilder.AddContainer(amHorizLeft) do begin AutoSize := True; @@ -342,8 +354,7 @@ procedure TForm1.Button7Click(Sender: TObject); procedure TForm1.Button8Click(Sender: TObject); begin - case CustomDialog('', 'ƵĴѾˣ', - 'ѡҪеIJ'#13#10#13#10' - أҲʧ'#13#10' - ɣܿԣٻ', + case CustomDialog('', 'ƵĴѾˣ', 'ѡҪеIJ'#13#10#13#10' - أҲʧ'#13#10' - ɣܿԣٻ', ['', ''], diWarning) of 0: ShowMessage('ʿɶԷѾѴյ'); @@ -356,13 +367,14 @@ procedure TForm1.Button8Click(Sender: TObject); procedure TForm1.Button9Click(Sender: TObject); begin - CustomDialog('ͼ', 'ͼshell32.dll', '', ['ȷ'], 48, 'shell32', - TSize.Create(64, 64)); + CustomDialog('ͼ', 'ͼshell32.dll', '', ['ȷ'], 48, 'shell32', TSize.Create(64, 64)); end; -procedure TForm1.DoDialogResult(FBuilder: IDialogBuilder); +procedure TForm1.DoDialogResult(ABuilder: IDialogBuilder); begin Label1.Caption := '༭' + FEditor.Text; + if ABuilder=FBuilder then + FBuilder:=nil; end; procedure TForm1.LoadUser32Icon(APicture: TPicture; AResId: Integer); @@ -379,12 +391,12 @@ procedure TForm1.LoadUser32Icon(APicture: TPicture; AResId: Integer); end; procedure TForm1.ValidBuilder; - begin if not Assigned(FBuilder) then begin FBuilder := NewDialog('DialogBuilder ʾ'); FBuilder.AutoSize := True; + FBuilder.Dialog.Padding.SetBounds(5, 5, 5, 5); with FBuilder.AddContainer(amHorizLeft) do begin Height := 32; @@ -405,8 +417,7 @@ procedure TForm1.ValidBuilder; end; end; // ʾʹû JSON Զ - FBuilder.AddControl(TLabel, - '{"AlignWithMargins":True,"Caption":".","Font":{"Color":"clGray"}}'); + FBuilder.AddControl(TLabel, '{"AlignWithMargins":True,"Caption":".","Font":{"Color":"clGray"}}'); with FBuilder.AddControl(TEdit, '{"AlignWithMargins":true}') do begin FEditor := TEdit(Control); diff --git a/Source/QMqttClient.pas b/Source/QMqttClient.pas index 774d065..e56baf2 100644 --- a/Source/QMqttClient.pas +++ b/Source/QMqttClient.pas @@ -16,11 +16,23 @@ interface { ҪԶ¼־ôѡԪ͵־QMQTTԱдʱԶд뵽һض־ļ } { .$DEFINE LogMqttContent } -{$DEFINE EnableSSLMqtt } -uses classes, sysutils, windows, messages, winsock, qstring, - netencoding, generics.collections, syncobjs, variants, ExtCtrls, - RegularExpressionsCore{$IFDEF LogMqttContent}, +{$I qdac.inc} +{$WARN UNIT_PLATFORM OFF} +{$WARN SYMBOL_PLATFORM OFF} +{$IFDEF MSWINDOWS} +{$DEFINE EnableSSLMqtt } +//ƽ̨OpenSSLʱȲ֧ +{$ENDIF} +uses classes, sysutils, qstring, qworker, + netencoding, generics.collections, syncobjs, variants, + RegularExpressionsCore{$IFDEF POSIX} + , Posix.Base, Posix.Stdio, Posix.Pthread, Posix.UniStd, IOUtils, + Posix.NetDB, Posix.SysSocket, Posix.Fcntl, Posix.StrOpts, Posix.Errno, + Posix.NetinetIn, Posix.arpainet, Posix.SysSelect, Posix.Systime +{$ELSE} + , windows, messages, winsock, TlHelp32 +{$ENDIF}{$IFDEF LogMqttContent}, qlog{$ENDIF}{$IFDEF EnableSSLMqtt}, qdac_ssl{$ENDIF}; const @@ -184,7 +196,8 @@ interface /// /// ڲϢת״̬ /// - TQMQTMessageState = (msSending, msSent, msRecving, msRecved, msDispatching, msDispatched, msNeedWait, msWaiting); + TQMQTMessageState = (msSending, msSent, msRecving, msRecved, msDispatching, + msDispatched, msNeedWait, msWaiting); TQMQTMessageStates = set of TQMQTMessageState; TQMQTTMessageClient = class; @@ -215,23 +228,29 @@ TQMQTTSubscribeResult = record /// /// Ľ֪ͨ¼ /// - TQMQTTTopicSubscribeResultNotify = procedure(ASender: TQMQTTMessageClient; const AResults: TQMQTTSubscribeResults) of object; + TQMQTTTopicSubscribeResultNotify = procedure(ASender: TQMQTTMessageClient; + const AResults: TQMQTTSubscribeResults) of object; /// /// ȡĽ֪ͨ¼ /// - TQMQTTTopicUnsubscribeEvent = procedure(ASender: TQMQTTMessageClient; const ATopic: String) of object; + TQMQTTTopicUnsubscribeEvent = procedure(ASender: TQMQTTMessageClient; + const ATopic: String) of object; /// /// Ϣɷ¼ATopic ָ˱ɷϢ⣬ȻҲԴ AReq ȡ TopicName Եֵ ATopic /// Ǵ AReq.TopicName ֵ /// - TQMQTTTopicDispatchEvent = procedure(ASender: TQMQTTMessageClient; const ATopic: String; const AReq: PQMQTTMessage) of object; - TQMQTTTopicDispatchEventG = procedure(ASender: TQMQTTMessageClient; const ATopic: String; const AReq: PQMQTTMessage); - TQMQTTTopicDispatchEventA = reference to procedure(ASender: TQMQTTMessageClient; const ATopic: String; + TQMQTTTopicDispatchEvent = procedure(ASender: TQMQTTMessageClient; + const ATopic: String; const AReq: PQMQTTMessage) of object; + TQMQTTTopicDispatchEventG = procedure(ASender: TQMQTTMessageClient; + const ATopic: String; const AReq: PQMQTTMessage); + TQMQTTTopicDispatchEventA = reference to procedure + (ASender: TQMQTTMessageClient; const ATopic: String; const AReq: PQMQTTMessage); /// /// ϵͳʱĴ¼ /// - TQMQTTErrorEvent = procedure(ASender: TQMQTTMessageClient; const AErrorCode: Integer; const AErrorMsg: String) of object; + TQMQTTErrorEvent = procedure(ASender: TQMQTTMessageClient; + const AErrorCode: Integer; const AErrorMsg: String) of object; /// /// ֪ͨ¼ /// @@ -264,8 +283,10 @@ TQMQTTMessage = record procedure SetPayloadSize(Value: Cardinal); procedure EncodeInt(var ABuf: PByte; V: Cardinal); procedure EncodeInt64(var ABuf: PByte; V: UInt64); - function DecodeInt(var ABuf: PByte; AMaxCount: Integer; var AResult: Cardinal): Boolean; - function DecodeInt64(var ABuf: PByte; AMaxCount: Integer; var AResult: Int64): Boolean; + function DecodeInt(var ABuf: PByte; AMaxCount: Integer; + var AResult: Cardinal): Boolean; + function DecodeInt64(var ABuf: PByte; AMaxCount: Integer; + var AResult: Int64): Boolean; function GetBof: PByte; function GetEof: PByte; function GetPosition: Integer; @@ -299,15 +320,18 @@ TQMQTTMessage = record /// /// ǰλдһַ /// - function Cat(const S: QStringW; AWriteZeroLen: Boolean = false): PQMQTTMessage; overload; + function Cat(const S: QStringW; AWriteZeroLen: Boolean = false) + : PQMQTTMessage; overload; /// /// ǰλдһַ /// - function Cat(const S: QStringA; AWriteZeroLen: Boolean = false): PQMQTTMessage; overload; + function Cat(const S: QStringA; AWriteZeroLen: Boolean = false) + : PQMQTTMessage; overload; /// /// ǰλдָ /// - function Cat(const ABuf: Pointer; const ALen: Cardinal): PQMQTTMessage; overload; + function Cat(const ABuf: Pointer; const ALen: Cardinal) + : PQMQTTMessage; overload; /// /// ǰλдָ /// @@ -325,7 +349,8 @@ TQMQTTMessage = record /// /// Ƿб루ο EncodeInt EncodeInt64 ʵ֣ /// - function Cat(const V: Word; AEncode: Boolean = false): PQMQTTMessage; overload; + function Cat(const V: Word; AEncode: Boolean = false) + : PQMQTTMessage; overload; /// /// ǰλдһ32λ޷ /// @@ -335,7 +360,8 @@ TQMQTTMessage = record /// /// Ƿб루ο EncodeInt EncodeInt64 ʵ֣ /// - function Cat(const V: Cardinal; AEncode: Boolean = false): PQMQTTMessage; overload; + function Cat(const V: Cardinal; AEncode: Boolean = false) + : PQMQTTMessage; overload; /// /// ǰλдһ64λ޷ @@ -346,7 +372,8 @@ TQMQTTMessage = record /// /// Ƿб루ο EncodeInt EncodeInt64 ʵ֣ /// - function Cat(const V: UInt64; AEncode: Boolean = false): PQMQTTMessage; overload; + function Cat(const V: UInt64; AEncode: Boolean = false) + : PQMQTTMessage; overload; /// /// ǰλдһ8λ /// @@ -360,7 +387,8 @@ TQMQTTMessage = record /// /// Ƿб루ο EncodeInt EncodeInt64 ʵ֣ /// - function Cat(const V: Smallint; AEncode: Boolean = false): PQMQTTMessage; overload; + function Cat(const V: Smallint; AEncode: Boolean = false) + : PQMQTTMessage; overload; /// /// ǰλдһ32λ /// @@ -370,7 +398,8 @@ TQMQTTMessage = record /// /// Ƿб루ο EncodeInt EncodeInt64 ʵ֣ /// - function Cat(const V: Integer; AEncode: Boolean = false): PQMQTTMessage; overload; + function Cat(const V: Integer; AEncode: Boolean = false) + : PQMQTTMessage; overload; /// /// ǰλдһ64λ /// @@ -380,7 +409,8 @@ TQMQTTMessage = record /// /// Ƿб루ο EncodeInt EncodeInt64 ʵ֣ /// - function Cat(const V: Int64; AEncode: Boolean = false): PQMQTTMessage; overload; + function Cat(const V: Int64; AEncode: Boolean = false) + : PQMQTTMessage; overload; /// /// ǰλдһ32λ /// @@ -390,7 +420,8 @@ TQMQTTMessage = record /// /// Ƿб루ο EncodeInt EncodeInt64 ʵ֣ /// - function Cat(const V: Single; AEncode: Boolean = false): PQMQTTMessage; overload; + function Cat(const V: Single; AEncode: Boolean = false) + : PQMQTTMessage; overload; /// /// ǰλдһ64λ /// @@ -400,7 +431,8 @@ TQMQTTMessage = record /// /// Ƿб루ο EncodeInt EncodeInt64 ʵ֣ /// - function Cat(const V: Double; AEncode: Boolean = false): PQMQTTMessage; overload; + function Cat(const V: Double; AEncode: Boolean = false) + : PQMQTTMessage; overload; /// /// ӵǰλöȡһֽڵֵ8λ޷ @@ -489,7 +521,8 @@ TQMQTTMessage = record /// /// /// - property ControlType: TQMQTTControlType read GetControlType write SetControlType; + property ControlType: TQMQTTControlType read GetControlType + write SetControlType; /// /// ʮͼʽʾϢݣڼ¼־ /// @@ -545,7 +578,8 @@ TQMQTTMessage = record /// /// ضֽڵֵ /// - property Bytes[const AIndex: Integer]: Byte read GetByte write SetByte; default; + property Bytes[const AIndex: Integer]: Byte read GetByte + write SetByte; default; /// /// ǰ״̬ /// @@ -611,7 +645,8 @@ TQMQTTSubscribeItem = record TQMQTTProtocolVersion = (pv3_1_1 = 4, pv5_0 = 5); TQMQTT5AuthMode = (amNone); - TQMQTT5PropDataType = (ptUnknown, ptByte, ptWord, ptInt, ptVarInt, ptString, ptBinary); + TQMQTT5PropDataType = (ptUnknown, ptByte, ptWord, ptInt, ptVarInt, ptString, + ptBinary); TQMQTT5PropType = record private @@ -667,9 +702,11 @@ TQMQTT5Props = class procedure WriteProps(AMessage: PQMQTTMessage); procedure Replace(AProps: TQMQTT5Props); property PropTypes[const APropId: Byte]: PQMQTT5PropType read GetPropTypes; - property Values[const APropId: Byte]: Variant read GetAsVariant write SetAsVariant; + property Values[const APropId: Byte]: Variant read GetAsVariant + write SetAsVariant; property AsInt[const APropId: Byte]: Cardinal read GetAsInt write SetAsInt; - property AsString[const APropId: Byte]: String read GetAsString write SetAsString; + property AsString[const APropId: Byte]: String read GetAsString + write SetAsString; property IsSet[const APropId: Byte]: Boolean read GetIsSet; property DataSize[const APropId: Byte]: Integer read GetDataSize; property PayloadSize: Integer read GetPayloadSize; @@ -723,7 +760,6 @@ TQMQTTMessageClient = class(TComponent) FSentTopics: Cardinal; FRecvTopics: Cardinal; FConnectProps: TQMQTT5Props; - FTimer: TTimer; FStates: TQMQTTClientStates; FPeekInterval: Word; FServerPort: Word; @@ -780,7 +816,7 @@ TQMQTTMessageClient = class(TComponent) {$IFDEF EnableSSLMqtt} function GetSSLManager: TQSSLManager; {$ENDIF} - procedure DoTimer(ASender: TObject); + procedure DoTimer(AJob: PQJob); procedure ReconnectNeeded; procedure DoCleanup; public @@ -821,7 +857,8 @@ TQMQTTMessageClient = class(TComponent) /// 1 Ҫ󲢲յķҪһ£ָ֧üʱܽ
/// 2δӵӦڷɺԶģƱϳϳƱ𣩡 /// - procedure Subscribe(const ATopics: array of String; const AQoS: TQMQTTQoSLevel; AProps: TQMQTT5Props = nil); + procedure Subscribe(const ATopics: array of String; + const AQoS: TQMQTTQoSLevel; AProps: TQMQTT5Props = nil); /// /// ȡָⶩ /// @@ -844,7 +881,8 @@ TQMQTTMessageClient = class(TComponent) /// /// Ҫ /// - procedure Publish(const ATopic, AContent: String; AQoSLevel: TQMQTTQoSLevel); overload; + procedure Publish(const ATopic, AContent: String; + AQoSLevel: TQMQTTQoSLevel); overload; /// /// һϢ /// @@ -857,7 +895,8 @@ TQMQTTMessageClient = class(TComponent) /// /// Ҫ /// - procedure Publish(const ATopic: String; AContent: TBytes; AQoSLevel: TQMQTTQoSLevel); overload; + procedure Publish(const ATopic: String; AContent: TBytes; + AQoSLevel: TQMQTTQoSLevel); overload; /// /// һϢ /// @@ -870,7 +909,8 @@ TQMQTTMessageClient = class(TComponent) /// /// Ҫ /// - procedure Publish(const ATopic: String; const AContent; ALen: Cardinal; AQoSLevel: TQMQTTQoSLevel); overload; + procedure Publish(const ATopic: String; const AContent; ALen: Cardinal; + AQoSLevel: TQMQTTQoSLevel); overload; /// /// עһϢɷ @@ -884,11 +924,14 @@ TQMQTTMessageClient = class(TComponent) /// /// Ϣ /// - procedure RegisterDispatch(const ATopic: String; AHandler: TQMQTTTopicDispatchEvent; + procedure RegisterDispatch(const ATopic: String; + AHandler: TQMQTTTopicDispatchEvent; AType: TTopicMatchType = mtFull); overload; - procedure RegisterDispatch(const ATopic: String; AHandler: TQMQTTTopicDispatchEventG; + procedure RegisterDispatch(const ATopic: String; + AHandler: TQMQTTTopicDispatchEventG; AType: TTopicMatchType = mtFull); overload; - procedure RegisterDispatch(const ATopic: String; AHandler: TQMQTTTopicDispatchEventA; + procedure RegisterDispatch(const ATopic: String; + AHandler: TQMQTTTopicDispatchEventA; AType: TTopicMatchType = mtFull); overload; /// /// ƳһϢɷע @@ -918,7 +961,8 @@ TQMQTTMessageClient = class(TComponent) /// /// ӳʱ /// - property ConnectionTimeout: Cardinal read FConnectionTimeout write FConnectionTimeout; + property ConnectionTimeout: Cardinal read FConnectionTimeout + write FConnectionTimeout; /// /// ĬϷҪ /// @@ -938,12 +982,14 @@ TQMQTTMessageClient = class(TComponent) /// /// ǷʱϴλỰϢ /// - property CleanLastSession: Boolean read FCleanLastSession write FCleanLastSession; + property CleanLastSession: Boolean read FCleanLastSession + write FCleanLastSession; /// /// λΪ /// property PeekInterval: Word read FPeekInterval write FPeekInterval; - property ReconnectInterval: Cardinal read FReconnectInterval write FReconnectInterval; + property ReconnectInterval: Cardinal read FReconnectInterval + write FReconnectInterval; /// /// ͻǷѾɹӵ /// @@ -958,14 +1004,16 @@ TQMQTTMessageClient = class(TComponent) /// property SentTopics: Cardinal read FSentTopics; {$IFDEF LogMqttContent} - property LogPackageContent: Boolean read FLogPackageContent write FLogPackageContent; + property LogPackageContent: Boolean read FLogPackageContent + write FLogPackageContent; {$ENDIF} {$IFDEF EnableSSLMqtt} property UseSSL: Boolean read FUseSSL write FUseSSL; property SSLManager: TQSSLManager read GetSSLManager; {$ENDIF} // MQTT 5.0 Added - property ProtocolVersion: TQMQTTProtocolVersion read FProtocolVersion write FProtocolVersion; + property ProtocolVersion: TQMQTTProtocolVersion read FProtocolVersion + write FProtocolVersion; property ConnectProps: TQMQTT5Props read GetConnectProps; /// @@ -975,59 +1023,73 @@ TQMQTTMessageClient = class(TComponent) /// /// ǰ֪ͨ /// - property BeforeConnect: TQMQTTNotifyEvent read FBeforeConnect write FBeforeConnect; + property BeforeConnect: TQMQTTNotifyEvent read FBeforeConnect + write FBeforeConnect; /// /// Ӻ֪ͨ /// - property AfterConnected: TQMQTTNotifyEvent read FAfterConnected write FAfterConnected; + property AfterConnected: TQMQTTNotifyEvent read FAfterConnected + write FAfterConnected; /// /// Ͽ֪ͨ /// - property AfterDisconnected: TQMQTTNotifyEvent read FAfterDisconnected write FAfterDisconnected; + property AfterDisconnected: TQMQTTNotifyEvent read FAfterDisconnected + write FAfterDisconnected; /// /// ɷǰ֪ͨ /// - property BeforeDispatch: TQMQTTTopicDispatchEvent read FBeforeDispatch write FBeforeDispatch; + property BeforeDispatch: TQMQTTTopicDispatchEvent read FBeforeDispatch + write FBeforeDispatch; /// /// ɷ֪ͨ /// - property AfterDispatch: TQMQTTTopicDispatchEvent read FAfterDispatch write FAfterDispatch; + property AfterDispatch: TQMQTTTopicDispatchEvent read FAfterDispatch + write FAfterDispatch; /// /// ǰ֪ͨ /// - property BeforePublish: TQMQTTTopicDispatchEvent read FBeforePublish write FBeforePublish; + property BeforePublish: TQMQTTTopicDispatchEvent read FBeforePublish + write FBeforePublish; /// /// ֪ͨ /// - property AfterPublished: TQMQTTTopicDispatchEvent read FAfterPublished write FAfterPublished; + property AfterPublished: TQMQTTTopicDispatchEvent read FAfterPublished + write FAfterPublished; /// /// ǰ֪ͨ /// - property BeforeSubscribe: TQMQTTTopicDispatchEvent read FBeforeSubscribe write FBeforeSubscribe; + property BeforeSubscribe: TQMQTTTopicDispatchEvent read FBeforeSubscribe + write FBeforeSubscribe; /// /// ĺ֪ͨ /// - property AfterSubscribed: TQMQTTTopicSubscribeResultNotify read FAfterSubscribed write FAfterSubscribed; + property AfterSubscribed: TQMQTTTopicSubscribeResultNotify + read FAfterSubscribed write FAfterSubscribed; /// /// ȡǰ֪ͨ /// - property BeforeUnsubscribe: TQMQTTTopicDispatchEvent read FBeforeUnsubscribe write FBeforeUnsubscribe; + property BeforeUnsubscribe: TQMQTTTopicDispatchEvent read FBeforeUnsubscribe + write FBeforeUnsubscribe; /// /// ȡĺ֪ͨ /// - property AfterUnsubscribed: TQMQTTTopicUnsubscribeEvent read FAfterUnsubscribed write FAfterUnsubscribed; + property AfterUnsubscribed: TQMQTTTopicUnsubscribeEvent + read FAfterUnsubscribed write FAfterUnsubscribed; /// /// ǰ֪ͨ /// - property BeforeSend: TQMQTTMessageNotifyEvent read FBeforeSend write FBeforeSend; + property BeforeSend: TQMQTTMessageNotifyEvent read FBeforeSend + write FBeforeSend; /// /// ݺ֪ͨ /// - property AfterSent: TQMQTTMessageNotifyEvent read FAfterSent write FAfterSent; + property AfterSent: TQMQTTMessageNotifyEvent read FAfterSent + write FAfterSent; /// /// յϢʱ֪ͨ /// - property OnRecvTopic: TQMQTTTopicDispatchEvent read FOnRecvTopic write FOnRecvTopic; + property OnRecvTopic: TQMQTTTopicDispatchEvent read FOnRecvTopic + write FOnRecvTopic; end; /// @@ -1040,7 +1102,8 @@ implementation resourcestring STooLargePayload = 'غɴС %d '; SClientNotRunning = 'ͻδӵܶ'; - SInitSSLFailed = 'ʼ SSL ʧܣĿ¼Ƿ ssleay32.dll libeay32.dll/libssl32.dll'; + SInitSSLFailed = + 'ʼ SSL ʧܣĿ¼Ƿ ssleay32.dll libeay32.dll/libssl32.dll'; const MQTT5PropTypes: array [0 .. 41] of TQMQTT5PropType = ( // @@ -1133,7 +1196,8 @@ TTopicHandler = class FNext: TTopicHandler; FMatchType: TTopicMatchType; public - constructor Create(const ATopic: String; AHandler: TQMQTTTopicDispatchEvent; AMatchType: TTopicMatchType); + constructor Create(const ATopic: String; AHandler: TQMQTTTopicDispatchEvent; + AMatchType: TTopicMatchType); destructor Destroy; override; function IsMatch(const ATopic: String): Boolean; end; @@ -1152,14 +1216,16 @@ function DefaultMqttClient: TQMQTTMessageClient; if not Assigned(_DefaultClient) then begin AClient := TQMQTTMessageClient.Create(nil); - if AtomicCmpExchange(Pointer(_DefaultClient), Pointer(AClient), nil) <> nil then + if AtomicCmpExchange(Pointer(_DefaultClient), Pointer(AClient), nil) <> nil + then FreeAndNil(AClient); end; Result := _DefaultClient; end; { TMessageQueue } -function TQMQTTMessageClient.AcquirePackageId(AReq: PQMQTTMessage; AIsWaitAck: Boolean): Word; +function TQMQTTMessageClient.AcquirePackageId(AReq: PQMQTTMessage; + AIsWaitAck: Boolean): Word; var ALast: Word; ATryTimes: Integer; @@ -1198,7 +1264,7 @@ function TQMQTTMessageClient.AcquirePackageId(AReq: PQMQTTMessage; AIsWaitAck: B procedure TQMQTTMessageClient.BeforeDestruction; begin inherited; - FTimer.Enabled := false; + Workers.Clear(DoTimer, INVALID_JOB_DATA); Stop; end; @@ -1250,9 +1316,6 @@ constructor TQMQTTMessageClient.Create(AOwner: TComponent); FSubscribes.Sorted := true; FSubscribes.Duplicates := dupIgnore; FProtocolVersion := pv3_1_1; - FTimer := TTimer.Create(Self); - FTimer.Enabled := false; - FTimer.OnTimer := DoTimer; end; destructor TQMQTTMessageClient.Destroy; @@ -1260,7 +1323,6 @@ destructor TQMQTTMessageClient.Destroy; I: Integer; AProps: TQMQTT5Props; begin - FreeAndNil(FTimer); FreeAndNil(FNotifyEvent); ClearHandlers; FreeAndNil(FTopicHandlers); @@ -1303,9 +1365,11 @@ procedure TQMQTTMessageClient.InvokeTopicHandlers( begin case IntPtr(TMethod(AItem.FOnDispatch).Data) of 0: - TQMQTTTopicDispatchEventG(TMethod(AItem.FOnDispatch).Code)(Self, ATopic, AMsg); + TQMQTTTopicDispatchEventG(TMethod(AItem.FOnDispatch).Code) + (Self, ATopic, AMsg); 1: - TQMQTTTopicDispatchEventA(TMethod(AItem.FOnDispatch).Code)(Self, ATopic, AMsg); + TQMQTTTopicDispatchEventA(TMethod(AItem.FOnDispatch).Code) + (Self, ATopic, AMsg); else AItem.FOnDispatch(Self, ATopic, AMsg); end; @@ -1410,7 +1474,8 @@ function TQMQTTMessageClient.DNSLookupV4( begin Result := 0; Utf8Host := qstring.Utf8Encode(AHost); - AEntry := gethostbyname({$IFDEF UNICODE}MarshaledAString{$ELSE}PAnsiChar{$ENDIF}(PQCharA(Utf8Host))); + AEntry := gethostbyname + ({$IFDEF UNICODE}MarshaledAString{$ELSE}PAnsiChar{$ENDIF}(PQCharA(Utf8Host))); if Assigned(AEntry) then begin if AEntry.h_addrtype = AF_INET then @@ -1546,7 +1611,8 @@ procedure TQMQTTMessageClient.DoBeforeConnect; end; end; -procedure TQMQTTMessageClient.DoBeforePublish(ATopic: String; AMsg: PQMQTTMessage); +procedure TQMQTTMessageClient.DoBeforePublish(ATopic: String; +AMsg: PQMQTTMessage); begin if Assigned(FBeforePublish) then begin @@ -1577,11 +1643,17 @@ procedure TQMQTTMessageClient.DoCleanup; end; procedure TQMQTTMessageClient.DoCloseSocket; +const + SD_BOTH = 2; begin if FSocket <> 0 then begin shutdown(FSocket, SD_BOTH); +{$IFDEF MSWINDOWS} closesocket(FSocket); +{$ELSE} + __close(FSocket); +{$ENDIF} FSocket := 0; FPingStarted := 0; DoAfterDisconnected; @@ -1600,7 +1672,8 @@ procedure TQMQTTMessageClient.DoConnect; AHeader: PMQTTConnectHeader; const - Protocol: array [0 .. 5] of Byte = (0, 4, Ord('M'), Ord('Q'), Ord('T'), Ord('T')); + Protocol: array [0 .. 5] of Byte = (0, 4, Ord('M'), Ord('Q'), Ord('T'), + Ord('T')); begin FConnected := false; AReq := TQMQTTMessage.Create(Self); @@ -1878,7 +1951,8 @@ procedure TQMQTTMessageClient.DoDispatch(var AReq: TQMQTTMessage); procedure begin {$IFDEF LogMqttContent} - PostLog(llDebug, 'Ping ʱ %d ms', [GetTickCount - FPingStarted], 'QMQTT'); + PostLog(llDebug, 'Ping ʱ %d ms', + [GetTickCount - FPingStarted], 'QMQTT'); {$ENDIF} FPingStarted := 0; end); @@ -1887,11 +1961,13 @@ procedure TQMQTTMessageClient.DoDispatch(var AReq: TQMQTTMessage); begin {$IFDEF LogMqttContent} if LogPackageContent then - PostLog(llDebug, '[]յ %dTopicId=%d,غɴС:%d,ܴС:%d :'#13#10'%s', [Ord(AReq.ControlType), Integer(AReq.TopicId), - Integer(AReq.PayloadSize), Integer(AReq.Size), AReq.ContentAsHexText], 'QMQTT') + PostLog(llDebug, '[]յ %dTopicId=%d,غɴС:%d,ܴС:%d :'#13#10'%s', + [Ord(AReq.ControlType), Integer(AReq.TopicId), Integer(AReq.PayloadSize), + Integer(AReq.Size), AReq.ContentAsHexText], 'QMQTT') else - PostLog(llDebug, '[]յ %dTopicId=%d,غɴС:%d,ܴС:%d', [Ord(AReq.ControlType), Integer(AReq.TopicId), - Integer(AReq.PayloadSize), Integer(AReq.Size)], 'QMQTT'); + PostLog(llDebug, '[]յ %dTopicId=%d,غɴС:%d,ܴС:%d', + [Ord(AReq.ControlType), Integer(AReq.TopicId), Integer(AReq.PayloadSize), + Integer(AReq.Size)], 'QMQTT'); {$ENDIF} AReq.States := AReq.States + [msDispatching]; case AReq.ControlType of @@ -1919,8 +1995,8 @@ procedure TQMQTTMessageClient.DoDispatch(var AReq: TQMQTTMessage); procedure TQMQTTMessageClient.DoError(AErrorCode: Integer); const - KnownErrorMessages: array [0 .. 6] of String = ('ɹ', 'Э汾Ų֧', 'ͻID', '񲻿', 'û', 'ͻδȨ', - 'ָʧ'); + KnownErrorMessages: array [0 .. 6] of String = ('ɹ', 'Э汾Ų֧', + 'ͻID', '񲻿', 'û', 'ͻδȨ', 'ָʧ'); var AMsg: String; begin @@ -1951,7 +2027,7 @@ procedure TQMQTTMessageClient.DoPing; begin if (FPingStarted = 0) and Assigned(FSendThread) then begin - FPingStarted := GetTickCount; + FPingStarted := {$IF RTLVersion>=23}TThread.{$IFEND} GetTickCount; AReq := TQMQTTMessage.Create(Self); AReq.PayloadSize := 0; AReq.ControlType := TQMQTTControlType.ctPing; @@ -1961,22 +2037,24 @@ procedure TQMQTTMessageClient.DoPing; end; procedure TQMQTTMessageClient.FreeMessage(AMsg: PQMQTTMessage); -var - APkgId: Word; +// var +// APkgId: Word; begin if Assigned(AMsg) then begin - Lock; - try - APkgId := AMsg.TopicId; - if APkgId <> 0 then - begin - if Assigned(FWaitAcks[APkgId]) and (FWaitAcks[APkgId] = AMsg) then - DebugBreak; - end; - finally - Unlock; - end; + // {$IFDEF MSWINDOWS} + // Lock; + // try + // APkgId := AMsg.TopicId; + // if APkgId <> 0 then + // begin + // if Assigned(FWaitAcks[APkgId]) and (FWaitAcks[APkgId] = AMsg) then + // DebugBreak; + // end; + // finally + // Unlock; + // end; + // {$ENDIF} Dispose(AMsg); end; end; @@ -2097,7 +2175,7 @@ procedure TQMQTTMessageClient.ReconnectNeeded; DoCloseSocket; FStates := FStates + [qcsReconnecting]; if FReconnectTimes = 0 then - FReconnectTime := TThread.GetTickCount; + FReconnectTime := {$IF RTLVersion>=23}TThread.{$IFEND} GetTickCount; if FReconnectTimes < 5 then // 5ξ,5ΣҪȥʱʱ begin Inc(FReconnectTimes); @@ -2108,15 +2186,15 @@ procedure TQMQTTMessageClient.ReconnectNeeded; procedure TQMQTTMessageClient.RecreateSocket; var - Addr: TSockAddrIn; - tm: TTimeVal; + Addr: sockaddr_in; + tm: TIMEVAL; mode: Integer; - fdWrite, fdError: TFdSet; + fdWrite, fdError: {$IFDEF MSWINDOWS}TFdSet{$ELSE}FD_SET{$ENDIF}; begin DoCloseSocket; DoBeforeConnect; FSocket := Socket(PF_INET, SOCK_STREAM, 0); - if FSocket = THandle(INVALID_SOCKET) then + if FSocket = THandle(-1) then RaiseLastOSError; try // ӵԶ̵ַ @@ -2127,14 +2205,23 @@ procedure TQMQTTMessageClient.RecreateSocket; RaiseLastOSError; tm.tv_sec := FConnectionTimeout div 1000; tm.tv_usec := (FConnectionTimeout mod 1000) * 1000; +{$IFDEF MSWINDOWS} mode := 1; - if ioctlsocket(FSocket, FIONBIO, mode) <> NO_ERROR then +{$ENDIF} + if {$IFDEF MSWINDOWS}ioctlsocket(FSocket, FIONBIO, mode) <> + NO_ERROR{$ELSE}Fcntl(FSocket, F_SETFL, Fcntl(FSocket, F_GETFL, 0) or + O_NONBLOCK) = -1{$ENDIF} then RaiseLastOSError; - CONNECT(FSocket, TSockAddr(Addr), SizeOf(Addr)); + CONNECT(FSocket, {$IFDEF MSWINDOWS}sockaddr_in{$ELSE}sockaddr{$ENDIF}(Addr), SizeOf(Addr)); FD_ZERO(fdWrite); FD_ZERO(fdError); +{$IFDEF MSWINDOWS} FD_SET(FSocket, fdWrite); FD_SET(FSocket, fdError); +{$ELSE} + _FD_SET(FSocket, fdWrite); + _FD_SET(FSocket, fdError); +{$ENDIF} select(0, nil, @fdWrite, @fdError, @tm); if not FD_ISSET(FSocket, fdWrite) then RaiseLastOSError; @@ -2168,7 +2255,7 @@ procedure TQMQTTMessageClient.RecreateSocket; end; {$ENDIF} DoConnect; - FLastConnectTime := GetTickCount; + FLastConnectTime := {$IF RTLVersion>=23}TThread.{$IFEND} GetTickCount; except on E: Exception do begin @@ -2177,7 +2264,7 @@ procedure TQMQTTMessageClient.RecreateSocket; FOnError(Self, mode, E.Message); FStates := FStates - [qcsConnecting]; DoCloseSocket; - FReconnectTime := GetTickCount; + FReconnectTime := {$IF RTLVersion>=23}TThread.{$IFEND} GetTickCount; if not(qcsReconnecting in FStates) then begin if qcsRunning in FStates then @@ -2188,8 +2275,8 @@ procedure TQMQTTMessageClient.RecreateSocket; end; end; -procedure TQMQTTMessageClient.RegisterDispatch(const ATopic: String; AHandler: TQMQTTTopicDispatchEventG; -AType: TTopicMatchType); +procedure TQMQTTMessageClient.RegisterDispatch(const ATopic: String; +AHandler: TQMQTTTopicDispatchEventG; AType: TTopicMatchType); var AMethod: TMethod; ATemp: TQMQTTTopicDispatchEvent absolute AMethod; @@ -2199,8 +2286,8 @@ procedure TQMQTTMessageClient.RegisterDispatch(const ATopic: String; AHandler: T RegisterDispatch(ATopic, ATemp, AType); end; -procedure TQMQTTMessageClient.RegisterDispatch(const ATopic: String; AHandler: TQMQTTTopicDispatchEventA; -AType: TTopicMatchType); +procedure TQMQTTMessageClient.RegisterDispatch(const ATopic: String; +AHandler: TQMQTTTopicDispatchEventA; AType: TTopicMatchType); var AMethod: TMethod; ATemp: TQMQTTTopicDispatchEvent absolute AMethod; @@ -2210,8 +2297,8 @@ procedure TQMQTTMessageClient.RegisterDispatch(const ATopic: String; AHandler: T RegisterDispatch(ATopic, ATemp, AType); end; -procedure TQMQTTMessageClient.RegisterDispatch(const ATopic: String; AHandler: TQMQTTTopicDispatchEvent; -AType: TTopicMatchType); +procedure TQMQTTMessageClient.RegisterDispatch(const ATopic: String; +AHandler: TQMQTTTopicDispatchEvent; AType: TTopicMatchType); var AItem, AFirst: TTopicHandler; AIdx: Integer; @@ -2239,7 +2326,7 @@ procedure TQMQTTMessageClient.RegisterDispatch(const ATopic: String; AHandler: T AItem := TTopicHandler.Create(ATopic, AHandler, AType); AItem.FNext := AFirst; if Assigned(AFirst) then - FTopicHandlers.Objects[AIdx]:=AItem + FTopicHandlers.Objects[AIdx] := AItem else FTopicHandlers.AddObject(ARealTopic, AItem); end; @@ -2249,11 +2336,10 @@ procedure TQMQTTMessageClient.DoRecv; AReq: PQMQTTMessage; AReaded, ATotal, ATick, ALastLargeIoTick: Cardinal; ARecv: Integer; - tm: TTimeVal; - fdRead, fdError: TFdSet; + tm: TIMEVAL; + fdRead, fdError: {$IFDEF MSWINDOWS}TFdSet{$ELSE}FD_SET{$ENDIF}; rc: Integer; AErrorCode: Integer; - ALastHandle: THandle; const InvalidSize = Cardinal(-1); MinBufferSize = 4096; @@ -2271,7 +2357,6 @@ procedure TQMQTTMessageClient.DoRecv; try FReconnectTimes := 0; ALastLargeIoTick := 0; - ALastHandle := FSocket; if FSocket = 0 then TThread.Queue(nil, RecreateSocket); repeat @@ -2291,30 +2376,39 @@ procedure TQMQTTMessageClient.DoRecv; repeat FD_ZERO(fdRead); FD_ZERO(fdError); +{$IFDEF MSWINDOWS} FD_SET(FSocket, fdRead); FD_SET(FSocket, fdError); +{$ELSE} + __FD_SET(FSocket, fdRead); + __FD_SET(FSocket, fdError); +{$ENDIF} try rc := select(0, @fdRead, nil, @fdError, @tm); if (rc > 0) then begin - if FD_ISSET(FSocket, fdRead) and (not FD_ISSET(FSocket, fdError)) then + if FD_ISSET(FSocket, fdRead) and (not FD_ISSET(FSocket, fdError)) + then begin {$IFDEF EnableSSLMqtt} if UseSSL then begin if Assigned(FSSL) then - ARecv := FSSL.Read(AReq.FData[AReaded], Cardinal(Length(AReq.FData)) - AReaded) + ARecv := FSSL.Read(AReq.FData[AReaded], + Cardinal(Length(AReq.FData)) - AReaded) else Exit; end else {$ENDIF} - ARecv := Recv(FSocket, AReq.FData[AReaded], Cardinal(Length(AReq.FData)) - AReaded, 0); + ARecv := Recv(FSocket, AReq.FData[AReaded], + Cardinal(Length(AReq.FData)) - AReaded, 0); if TSocketRecvThread(TThread.Current).Terminated then Break; - if ARecv = SOCKET_ERROR then + if ARecv = -1 then begin - if GetLastError = WSAEWOULDBLOCK then + if GetLastError = + {$IFDEF MSWINDOWS}WSAEWOULDBLOCK{$ELSE}EWOULDBLOCK{$ENDIF} then begin Sleep(10); continue; @@ -2328,11 +2422,11 @@ procedure TQMQTTMessageClient.DoRecv; else if ARecv = 0 then // ûнһʱóCPU begin TThread.Queue(nil, DoPing); - SleepEx(10, true); + Sleep(10); continue; end; Inc(AReaded, ARecv); - FLastIoTick := GetTickCount; + FLastIoTick := {$IF RTLVersion>=23}TThread.{$IFEND} GetTickCount; if AReaded > 4096 then ALastLargeIoTick := FLastIoTick; if ATotal = InvalidSize then @@ -2368,9 +2462,10 @@ procedure TQMQTTMessageClient.DoRecv; end else if rc = 0 then // ʱǷҪPing begin - ATick := GetTickCount; + ATick := {$IF RTLVersion>=23}TThread.{$IFEND} GetTickCount; // 5ȡ乻ݣСڴռ - if (AReq.Capacity > MinBufferSize) and (AReaded < MinBufferSize) and (ATick - ALastLargeIoTick > 5000) then + if (AReq.Capacity > MinBufferSize) and (AReaded < MinBufferSize) and + (ATick - ALastLargeIoTick > 5000) then begin AReq.PayloadSize := 0; AReq.Capacity := MinBufferSize; @@ -2380,10 +2475,10 @@ procedure TQMQTTMessageClient.DoRecv; end; until TSocketRecvThread(TThread.Current).Terminated; - if (AErrorCode <> 0) and (not TSocketThread(TThread.Current).Terminated) then + if (AErrorCode <> 0) and (not TSocketThread(TThread.Current).Terminated) + then begin DebugOut(SysErrorMessage(AErrorCode)); - ALastHandle := FSocket; TThread.Synchronize(nil, ReconnectNeeded); end; until TSocketThread(TThread.Current).Terminated; @@ -2402,10 +2497,13 @@ function TQMQTTMessageClient.DoSend(AReq: PQMQTTMessage): Boolean; begin {$IFDEF LogMqttContent} if LogPackageContent then - PostLog(llDebug, ' %d(%x),ID=%d,غɴС:%d,ܴС:%d,:'#13#10'%s', [Ord(AReq.ControlType), IntPtr(AReq), - Integer(AReq.TopicId), Integer(AReq.PayloadSize), Integer(AReq.Size), AReq.ContentAsHexText], 'QMQTT') + PostLog(llDebug, ' %d(%x),ID=%d,غɴС:%d,ܴС:%d,:'#13#10'%s', + [Ord(AReq.ControlType), IntPtr(AReq), Integer(AReq.TopicId), + Integer(AReq.PayloadSize), Integer(AReq.Size), + AReq.ContentAsHexText], 'QMQTT') else - PostLog(llDebug, ' %d(%x),ID=%d,غɴС:%d,ܴС:%d', [Ord(AReq.ControlType), IntPtr(AReq), Integer(AReq.TopicId), + PostLog(llDebug, ' %d(%x),ID=%d,غɴС:%d,ܴС:%d', + [Ord(AReq.ControlType), IntPtr(AReq), Integer(AReq.TopicId), Integer(AReq.PayloadSize), Integer(AReq.Size)], 'QMQTT'); {$ENDIF} Result := false; @@ -2435,12 +2533,13 @@ function TQMQTTMessageClient.DoSend(AReq: PQMQTTMessage): Boolean; {$ENDIF} begin ASent := Send(AReq.Client.FSocket, p^, ASize, 0); - if ASent <> SOCKET_ERROR then + if ASent <> -1 then begin Inc(p, ASent); Dec(ASize, ASent); end - else if ASent = WSAEWOULDBLOCK then + else if ASent = + {$IFDEF MSWINDOWS} WSAEWOULDBLOCK{$ELSE}EWOULDBLOCK{$ENDIF} then begin Sleep(10); continue @@ -2452,7 +2551,7 @@ function TQMQTTMessageClient.DoSend(AReq: PQMQTTMessage): Boolean; if ASize = 0 then begin AReq.States := AReq.States + [msSent] - [msSending]; - AReq.FSentTime := GetTickCount; + AReq.FSentTime := {$IF RTLVersion>=23}TThread.{$IFEND} GetTickCount; Inc(AReq.FSentTimes); AReq.Client.FLastIoTick := AReq.FSentTime; Result := true; @@ -2466,21 +2565,23 @@ function TQMQTTMessageClient.DoSend(AReq: PQMQTTMessage): Boolean; end; end; -procedure TQMQTTMessageClient.DoTimer(ASender: TObject); +procedure TQMQTTMessageClient.DoTimer(AJob: PQJob); var ATick: Cardinal; begin - ATick := GetTickCount; + ATick := {$IF RTLVersion>=23}TThread.{$IFEND} GetTickCount; if qcsConnecting in FStates then Exit; if FSocket = 0 then begin - if ((ATick - FReconnectTime) > (FReconnectInterval * 1000)) and (qcsRunning in FStates) then + if ((ATick - FReconnectTime) > (FReconnectInterval * 1000)) and + (qcsRunning in FStates) then RecreateSocket; end else if ((ATick - FLastIoTick) >= (FPeekInterval * 1000)) then DoPing - else if (FPingStarted > 0) and ((ATick - FPingStarted) > 1000) then // Ping 1ڷأֱ + else if (FPingStarted > 0) and ((ATick - FPingStarted) > 1000) then + // Ping 1ڷأֱ ReconnectNeeded; end; @@ -2526,7 +2627,7 @@ procedure TQMQTTMessageClient.Start; FRecvThread := TSocketRecvThread.Create(Self); if not Assigned(FSendThread) then FSendThread := TSocketSendThread.Create(Self); - FTimer.Enabled := true; + Workers.Delay(DoTimer, 1000, nil, true, jdfFreeByUser, true); end; procedure TQMQTTMessageClient.Stop; @@ -2534,7 +2635,7 @@ procedure TQMQTTMessageClient.Stop; FStates := FStates + [qcsStop] - [qcsRunning]; FReconnectTimes := 0; FReconnectTime := 0; - FTimer.Enabled := false; + Workers.Clear(DoTimer, INVALID_JOB_DATA); Disconnect; DoCloseSocket; if Assigned(FRecvThread) then @@ -2552,7 +2653,8 @@ procedure TQMQTTMessageClient.Stop; ClearWaitAcks; end; -procedure TQMQTTMessageClient.Subscribe(const ATopics: array of String; const AQoS: TQMQTTQoSLevel; AProps: TQMQTT5Props); +procedure TQMQTTMessageClient.Subscribe(const ATopics: array of String; +const AQoS: TQMQTTQoSLevel; AProps: TQMQTT5Props); var AReq: PQMQTTMessage; APayloadSize: Integer; @@ -2616,7 +2718,8 @@ procedure TQMQTTMessageClient.Unlock; TMonitor.Exit(Self); end; -procedure TQMQTTMessageClient.UnregisterDispatch(AHandler: TQMQTTTopicDispatchEvent); +procedure TQMQTTMessageClient.UnregisterDispatch + (AHandler: TQMQTTTopicDispatchEvent); var AItem, APrior, ANext: TTopicHandler; I: Integer; @@ -2680,6 +2783,7 @@ procedure TQMQTTMessageClient.Unsubscribe( AReq := TQMQTTMessage.Create(Self); AReq.PayloadSize := APayloadSize; AReq.ControlType := TQMQTTControlType.ctUnsubscribe; + AReq.QosLevel:=TQMQTTQoSLevel.qlAtLeast1; APackageId := AcquirePackageId(AReq, true); AReq.Cat(APackageId); for I := 0 to C - 1 do @@ -2703,7 +2807,8 @@ procedure TQMQTTMessageClient.ValidClientId; if Length(FClientId) = 0 then begin CreateGUID(AId); - FClientId := DeleteRightW(TNetEncoding.Base64.EncodeBytesToString(@AId, SizeOf(AId)), '=', false, 1); + FClientId := DeleteRightW(TNetEncoding.Base64.EncodeBytesToString(@AId, + SizeOf(AId)), '=', false, 1); end; end; @@ -2805,7 +2910,8 @@ function TQMQTTMessage.Copy: PQMQTTMessage; Result.FSentTimes := FSentTimes; end; -class function TQMQTTMessage.Create(AClient: TQMQTTMessageClient): PQMQTTMessage; +class function TQMQTTMessage.Create(AClient: TQMQTTMessageClient) + : PQMQTTMessage; begin New(Result); Result.FClient := AClient; @@ -3169,7 +3275,8 @@ function TQMQTTMessage.GetTopicText: String; if QosLevel > qlMax1 then // ܴڵPackageId Inc(p, 2); - Result := qstring.Utf8Decode(PQCharA(p), Length(FData) - (IntPtr(p) - IntPtr(@FData[0]))); + Result := qstring.Utf8Decode(PQCharA(p), + Length(FData) - (IntPtr(p) - IntPtr(@FData[0]))); end else Result := ''; @@ -3550,7 +3657,8 @@ procedure CleanSocket; inline; constructor TTopicHandler.Create( - const ATopic: String; AHandler: TQMQTTTopicDispatchEvent; AMatchType: TTopicMatchType); + const ATopic: String; AHandler: TQMQTTTopicDispatchEvent; +AMatchType: TTopicMatchType); begin inherited Create; FMatchType := AMatchType; @@ -3771,7 +3879,8 @@ destructor TQMQTT5Props.Destroy; begin for I := 0 to High(FItems) do begin - if (MQTT5PropTypes[I].DataType in [ptString, ptBinary]) and Assigned(FItems[I].AsString) then + if (MQTT5PropTypes[I].DataType in [ptString, ptBinary]) and + Assigned(FItems[I].AsString) then begin if MQTT5PropTypes[I].DataType = ptString then Dispose(FItems[I].AsString) @@ -3853,9 +3962,11 @@ function TQMQTT5Props.GetAsVariant(const APropId: Byte): Variant; begin if Assigned(FItems[APropId - 1].AsBytes) then begin - Result := VarArrayCreate([0, Length(FItems[APropId - 1].AsBytes^) - 1], varByte); + Result := VarArrayCreate([0, Length(FItems[APropId - 1].AsBytes^) - + 1], varByte); p := VarArrayLock(Result); - Move(FItems[APropId - 1].AsBytes^[0], p^, Length(FItems[APropId - 1].AsBytes^)); + Move(FItems[APropId - 1].AsBytes^[0], p^, + Length(FItems[APropId - 1].AsBytes^)); VarArrayUnlock(Result); end else @@ -4060,8 +4171,10 @@ procedure TQMQTT5Props.SetAsVariant(const APropId: Byte; const Value: Variant); begin if not Assigned(FItems[APropId - 1].AsBytes) then New(FItems[APropId - 1].AsBytes); - SetLength(FItems[APropId - 1].AsBytes^, VarArrayHighBound(Value, 1) + 1); - Move(VarArrayLock(Value)^, FItems[APropId - 1].AsBytes^[0], Length(FItems[APropId - 1].AsBytes^)); + SetLength(FItems[APropId - 1].AsBytes^, + VarArrayHighBound(Value, 1) + 1); + Move(VarArrayLock(Value)^, FItems[APropId - 1].AsBytes^[0], + Length(FItems[APropId - 1].AsBytes^)); VarArrayUnlock(Value); end; end; diff --git a/Source/qdialog_builder.pas b/Source/qdialog_builder.pas index 1ba03de..6643009 100644 --- a/Source/qdialog_builder.pas +++ b/Source/qdialog_builder.pas @@ -136,6 +136,8 @@ interface TDialogResultCallback = reference to procedure(ABuilder: IDialogBuilder); {$ENDIF} TDialogResultEvent = procedure(ABuilder: IDialogBuilder) of object; + TQDialogPopupPosition = (dppDefault, dppLeftTop, dppCenterTop, dppRightTop, dppLeftCenter, dppCenter, dppRightCenter, + dppLeftBottom, dppCenterBottom, dppRightBottom); // Ի򹹽 IDialogBuilder = interface(IDialogContainer) @@ -177,6 +179,10 @@ interface procedure SetCloseDelay(const ASeconds: Word); function GetDisplayRemainTime: Boolean; procedure SetDisplayRemainTime(const AValue: Boolean); + function GetPopupPosition: TQDialogPopupPosition; + procedure SetPopupPosition(const Value: TQDialogPopupPosition); + function GetPopupMonitor: TMonitor; + procedure SetPopupMonitor(const Value: TMonitor); property PropText: String read GetPropText write SetPropText; property ModalResult: TModalResult read GetModalResult write SetModalResult; property OnResult: TDialogResultEvent read GetOnResult write SetOnResult; @@ -184,16 +190,21 @@ interface property CanClose: Boolean read GetCanClose write SetCanClose; property CloseDelay: Word read GetCloseDelay write SetCloseDelay; property DisplayRemainTime: Boolean read GetDisplayRemainTime write SetDisplayRemainTime; + property PopupPosition: TQDialogPopupPosition read GetPopupPosition write SetPopupPosition; + property PopupMonitor: TMonitor read GetPopupMonitor write SetPopupMonitor; end; TDialogIcon = (diNone, diWarning, diHelp, diError, diInformation, diShield); // ½һԻӿڣָ⣬ΪApplication.Title function NewDialog(ACaption: String = ''): IDialogBuilder; overload; function NewDialog(AClass: TFormClass): IDialogBuilder; overload; +function LoadDialogIcon(APicture: TPicture; const AIcon: TDialogIcon; ASize: TSize): Boolean; overload; +function LoadDialogIcon(APicture: TPicture; const AIconREsFile: String; const AIconResId: Integer; ASize: TSize) + : Boolean; overload; function CustomDialog(const ACaption, ATitle, AMessage: String; AButtons: array of String; AIcon: TDialogIcon; AFlags: Integer = 0; const ACustomProps: String = ''): Integer; overload; function CustomDialog(const ACaption, ATitle, AMessage: String; AButtons: array of String; AIconResId: Integer; - AIconResFile: String; AIconSize: TSize; AFlags: Integer = 0; const ACustomProps: String = ''): Integer; overload; + AIconREsFile: String; AIconSize: TSize; AFlags: Integer = 0; const ACustomProps: String = ''): Integer; overload; implementation @@ -291,7 +302,7 @@ TDialogContainer = class(TControlDialogItem, IDialogContainer) property ItemSpace: Integer read FItemSpace write FItemSpace; end; - TDialogBuilderState = (dbsAlignRequest, dbsAligning, dbsPopup, dbsModal); + TDialogBuilderState = (dbsAlignRequest, dbsAligning, dbsPopuping, dbsPopup, dbsModal); TDialogBuilderStates = set of TDialogBuilderState; TDialogPopupHelper = class(TComponent) @@ -308,6 +319,8 @@ TDialogPopupHelper = class(TComponent) end; TDialogBuilder = class(TDialogContainer, IDialogBuilder) + private + protected FDialog: TForm; FGroups: TStringList; @@ -319,10 +332,12 @@ TDialogBuilder = class(TDialogContainer, IDialogBuilder) FPopupHelper: TDialogPopupHelper; FLastActiveWnd: THandle; FRefCountFix: Integer; + FPopupPosition: TQDialogPopupPosition; FCloseDelay: Word; FCanClose: Boolean; FDisplayRemainTime: Boolean; FInitializeCaption: String; + FPopupMonitor: TMonitor; function GetGroups: TStrings; procedure ChangeGroup(AItem: IBaseDialogItem; ANewName: String); procedure GroupCast(ASender: IBaseDialogItem; AEvent: TDialogNotifyEvent); @@ -350,11 +365,18 @@ TDialogBuilder = class(TDialogContainer, IDialogBuilder) procedure TimerNeeded; procedure DoCloseTimer(ASender: TObject); function CalcControlPopupPos(AControl: TControl): TPoint; + function GetPopupPosition: TQDialogPopupPosition; + procedure SetPopupPosition(const Value: TQDialogPopupPosition); + function GetPopupMonitor: TMonitor; + procedure SetPopupMonitor(const Value: TMonitor); {$IFDEF UNICODE} procedure SetOnResultCallback(ACallback: TDialogResultCallback); procedure FixupRefCount(ADelta: Integer); procedure ApplyRefCountFix; {$ENDIF} + function IsAppVisible(ABringToFrontIfVisible: Boolean): Boolean; + procedure BeforePopup; + procedure AfterPopup; public constructor Create(const ACaption: String); overload; constructor Create(const AClass: TFormClass); overload; @@ -371,11 +393,13 @@ TDialogBuilder = class(TDialogContainer, IDialogBuilder) {$ENDIF} property Dialog: TForm read FDialog; property Groups: TStrings read GetGroups; + property PopupPosition: TQDialogPopupPosition read GetPopupPosition write SetPopupPosition; property ModalResult: TModalResult read GetModalResult write SetModalResult; property OnResult: TDialogResultEvent read FOnResult write SetOnResult; property CanClose: Boolean read FCanClose write SetCanClose; property CloseDelay: Word read FCloseDelay write SetCloseDelay; property DisplayRemainTime: Boolean read FDisplayRemainTime write FDisplayRemainTime; + property PopupMonitor: TMonitor read GetPopupMonitor write SetPopupMonitor; end; function NewDialog(ACaption: String): IDialogBuilder; @@ -391,6 +415,30 @@ function NewDialog(AClass: TFormClass): IDialogBuilder; Result := TDialogBuilder.Create(AClass); end; +function LoadDialogIcon(APicture: TPicture; const AIconREsFile: String; const AIconResId: Integer; ASize: TSize): Boolean; +var + AIcon: TIcon; +begin + AIcon := TIcon.Create; + try + AIcon.SetSize(ASize.cx, ASize.cy); + AIcon.Handle := LoadImage(GetModuleHandle(PChar(AIconREsFile)), MAKEINTRESOURCE(AIconResId), IMAGE_ICON, ASize.cx, + ASize.cy, 0); + Result := AIcon.HandleAllocated; + if Result then + APicture.Assign(AIcon); + finally + FreeAndNil(AIcon); + end; +end; + +function LoadDialogIcon(APicture: TPicture; const AIcon: TDialogIcon; ASize: TSize): Boolean; +const + IconResId: array [TDialogIcon] of Integer = (0, 101, 102, 103, 104, 106); +begin + Result := LoadDialogIcon(APicture, user32, IconResId[AIcon], ASize); +end; + function CustomDialog(const ACaption, ATitle, AMessage: String; AButtons: array of String; AIcon: TDialogIcon; AFlags: Integer; const ACustomProps: String): Integer; var @@ -404,7 +452,7 @@ function CustomDialog(const ACaption, ATitle, AMessage: String; AButtons: array end; function CustomDialog(const ACaption, ATitle, AMessage: String; AButtons: array of String; AIconResId: Integer; - AIconResFile: String; AIconSize: TSize; AFlags: Integer; const ACustomProps: String): Integer; + AIconREsFile: String; AIconSize: TSize; AFlags: Integer; const ACustomProps: String): Integer; var AIcon: TIcon; ABuilder: IDialogBuilder; @@ -414,6 +462,8 @@ function CustomDialog(const ACaption, ATitle, AMessage: String; AButtons: array ABuilder := NewDialog(ACaption); ABuilder.ItemSpace := 10; ABuilder.AutoSize := True; + // ABuilder.Dialog.Padding.SetBounds(5, 10, 5, 5); + // ABuilder.Dialog.Color := clWhite; // УDZ⣬ͼ+⣬ͼ+ϢϢ with ABuilder.AddContainer(amVertTop) do begin @@ -422,28 +472,21 @@ function CustomDialog(const ACaption, ATitle, AMessage: String; AButtons: array begin Padding.Left := ABuilder.ItemSpace; Padding.Right := ABuilder.ItemSpace; + Padding.Top := ABuilder.ItemSpace; ParentBackground := false; Color := clWhite; end; with AddContainer(amHorizLeft) do begin AutoSize := True; - if (Length(AIconResFile) > 0) and (AIconResId > 0) then + if (Length(AIconREsFile) > 0) and (AIconResId > 0) then begin - AIcon := TIcon.Create; - try - AIcon.SetSize(AIconSize.cx, AIconSize.cy); - AIconImage := TImage(AddControl(TImage).Control); - with AIconImage do - begin - AutoSize := True; - AlignWithMargins := True; - AIcon.Handle := LoadImage(GetModuleHandle(PChar(AIconResFile)), MAKEINTRESOURCE(AIconResId), IMAGE_ICON, - AIconSize.cx, AIconSize.cy, 0); - Picture.Assign(AIcon); - end; - finally - FreeAndNil(AIcon); + AIconImage := TImage(AddControl(TImage).Control); + with AIconImage do + begin + AutoSize := True; + AlignWithMargins := True; + LoadDialogIcon(Picture, AIconREsFile, AIconResId, AIconSize); end; end; if Length(ATitle) > 0 then @@ -898,30 +941,129 @@ procedure TDialogBuilder.AddToGroup(AItem: TBaseDialogItem); end; {$IFDEF UNICODE} +procedure TDialogBuilder.AfterPopup; +begin + FStates := FStates - [dbsPopuping]; +end; + procedure TDialogBuilder.ApplyRefCountFix; begin AtomicDecrement(FRefCount, FRefCountFix); FRefCountFix := 0; end; + +procedure TDialogBuilder.BeforePopup; +begin + if dbsPopuping in FStates then + Exit; + FStates := FStates + [dbsPopuping]; + if not(dbsPopup in FStates) then // Աظʱּ + begin + FStates := FStates + [dbsPopup]; + _AddRef; + end; + Dialog.BorderStyle := bsNone; + if Dialog.BorderStyle <> bsNone then + RequestAlign; + IsAppVisible(True); + Dialog.BorderStyle := bsNone; + Dialog.Position := poDesigned; + Dialog.ModalResult := mrNone; + if dbsAlignRequest in FStates then + Realign; + Dialog.FormStyle := fsStayOnTop; +end; + {$ENDIF} function TDialogBuilder.CalcControlPopupPos(AControl: TControl): TPoint; var - AMonitor: TMonitor; + R: TRect; ASize: TSize; + AMonitor: TMonitor; begin - FLastActiveWnd := GetParentForm(AControl).Handle; - Result := AControl.ClientToScreen(Point(0, AControl.Height)); ASize := ItemSize; - AMonitor := Screen.MonitorFromPoint(Result); - if Result.X + ASize.cx > AMonitor.BoundsRect.Right then - Result.X := AMonitor.BoundsRect.Right - ASize.cx; - if Result.Y + ASize.cy > AMonitor.BoundsRect.Bottom then + if Assigned(AControl) then begin - if Result.Y - AControl.Height - ASize.cy > AMonitor.BoundsRect.Top then - Result.Y := Result.Y - AControl.Height - ASize.cy - else - Result.Y := AMonitor.BoundsRect.Bottom - ASize.cy; + R := AControl.ClientRect; + R.Offset(AControl.ClientOrigin); + FLastActiveWnd := GetParentForm(AControl).Handle; + AMonitor := Screen.MonitorFromRect(R); + end + else + begin + FLastActiveWnd := 0; + AMonitor := PopupMonitor; + R := AMonitor.WorkareaRect; + end; + case PopupPosition of + dppDefault: + begin + if Assigned(AControl) then + begin + Result.X := R.Left; + Result.Y := R.Top + R.Height; + if Result.X + ASize.cx > AMonitor.BoundsRect.Right then + Result.X := AMonitor.BoundsRect.Right - ASize.cx; + if Result.Y + ASize.cy > AMonitor.BoundsRect.Bottom then + begin + if Result.Y - AControl.Height - ASize.cy > AMonitor.BoundsRect.Top then + Result.Y := Result.Y - AControl.Height - ASize.cy + else + Result.Y := AMonitor.BoundsRect.Bottom - ASize.cy; + end; + end + else + begin + Result.X := R.Left + (R.Width - Dialog.Width) shr 1; + Result.Y := R.Top + (R.Height - Dialog.Height) shr 1; + end; + end; + dppLeftTop: + begin + Result.X := R.Left; + Result.Y := R.Top; + end; + dppCenterTop: + begin + Result.X := R.Left + (R.Width - Dialog.Width) shr 1; + Result.Y := R.Top; + end; + dppRightTop: + begin + Result.X := R.Left + R.Width - Dialog.Width; + Result.Y := R.Top; + end; + dppLeftCenter: + begin + Result.X := R.Left; + Result.Y := R.Top + (R.Height - Dialog.Height) shr 1; + end; + dppCenter: + begin + Result.X := R.Left + (R.Width - Dialog.Width) shr 1; + Result.Y := R.Top + (R.Height - Dialog.Height) shr 1; + end; + dppRightCenter: + begin + Result.X := R.Left + R.Width - Dialog.Width; + Result.Y := R.Top + (R.Height - Dialog.Height) shr 1; + end; + dppLeftBottom: + begin + Result.X := R.Left; + Result.Y := R.Top + R.Height - Dialog.Height; + end; + dppCenterBottom: + begin + Result.X := R.Left + (R.Width - Dialog.Width) shr 1; + Result.Y := R.Top + R.Height - Dialog.Height; + end; + dppRightBottom: + begin + Result.X := R.Left + R.Width - Dialog.Width; + Result.Y := R.Top + R.Height - Dialog.Height; + end; end; end; @@ -1000,8 +1142,6 @@ procedure TDialogBuilder.DoCloseTimer(ASender: TObject); end else if DisplayRemainTime then begin - if Length(FInitializeCaption) = 0 then - FInitializeCaption := Dialog.Caption; Dialog.Caption := FInitializeCaption + '-' + RollupTime(CloseDelay - FTimer.Tag); end; end; @@ -1088,7 +1228,7 @@ procedure TDialogBuilder.DoResult; procedure TDialogBuilder.FixupRefCount(ADelta: Integer); begin - Inc(FRefCountFix, ADelta); + // Inc(FRefCountFix, ADelta); end; function TDialogBuilder.GetBounds: TRect; @@ -1131,6 +1271,18 @@ function TDialogBuilder.GetOnResult: TDialogResultEvent; Result := FOnResult; end; +function TDialogBuilder.GetPopupMonitor: TMonitor; +begin + Result := FPopupMonitor; + if not Assigned(Result) then + Result := Screen.PrimaryMonitor; +end; + +function TDialogBuilder.GetPopupPosition: TQDialogPopupPosition; +begin + Result := FPopupPosition; +end; + function TDialogBuilder.GroupByName(const AName: String): IDialogItemGroup; var AIdx: Integer; @@ -1161,57 +1313,77 @@ procedure TDialogBuilder.GroupCast(ASender: IBaseDialogItem; AEvent: TDialogNoti end; end; -procedure TDialogBuilder.Popup(APos: TPoint); +function TDialogBuilder.IsAppVisible(ABringToFrontIfVisible: Boolean): Boolean; +var + AppHandle: HWND; + AForm: TForm; + APos: TPoint; begin - // ÿؼλ - if not(dbsPopup in FStates) then // Աظʱּ + if Application.MainFormOnTaskBar and Assigned(Application.MainForm) then + AppHandle := Application.MainForm.Handle + else + AppHandle := Application.Handle; + if IsWindowVisible(AppHandle) then begin - FStates := FStates + [dbsPopup]; - _AddRef; + if IsIconic(AppHandle) and ABringToFrontIfVisible then + Application.Restore; end; - if Dialog.BorderStyle <> bsNone then - RequestAlign; - Dialog.BorderStyle := bsNone; - Dialog.Position := poDesigned; - Dialog.ModalResult := mrNone; - if dbsAlignRequest in FStates then - Realign; - Dialog.SetBounds(APos.X, APos.Y, Dialog.Width, Dialog.Height); - Dialog.FormStyle := fsStayOnTop; - { - VCL û÷ǻڵʾ Show/VisibleõǰڱΪ - ڣԭĴڻʧȥ㣬Ҫ£ - 1 SetWindowPos Էǻ״̬ʾ - 2ǿ޸Ĵڵ Visible Ϊ True - 3 CM_VISIBLECHANGED Ϣ֪ͨؿؼ - ͬʱΪ˱ԻеĿؼʱԭĴʾΪʧȥ״̬ҲҪ - Ϣ忴 DoDialogWndProc 롣 - ĶԻûλʱӦԶʧԻҪϢû - ǵǰλʱԶʧ - } - if FLastActiveWnd = 0 then - FLastActiveWnd := GetActiveWindow; - SetClassLong(Dialog.Handle, GCL_STYLE, GetClassLong(Dialog.Handle, GCL_STYLE) or CS_DROPSHADOW); - SetWindowPos(Dialog.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE OR SWP_NOSIZE OR SWP_NOMOVE OR SWP_SHOWWINDOW); - PBoolean(@Dialog.Visible)^ := True; - Dialog.Perform(CM_VISIBLECHANGED, 0, 0); - if not Assigned(FAppEvents) then - begin - FAppEvents := TApplicationEvents.Create(Dialog); - FAppEvents.OnMessage := DoPopupMessage; +end; + +procedure TDialogBuilder.Popup(APos: TPoint); +var + R: TRect; +begin + // ÿؼλ + BeforePopup; + try + Dialog.SetBounds(APos.X, APos.Y, Dialog.Width, Dialog.Height); + { + VCL û÷ǻڵʾ Show/VisibleõǰڱΪ + ڣԭĴڻʧȥ㣬Ҫ£ + 1 SetWindowPos Էǻ״̬ʾ + 2ǿ޸Ĵڵ Visible Ϊ True + 3 CM_VISIBLECHANGED Ϣ֪ͨؿؼ + ͬʱΪ˱ԻеĿؼʱԭĴʾΪʧȥ״̬ҲҪ + Ϣ忴 DoDialogWndProc 롣 + ĶԻûλʱӦԶʧԻҪϢû + ǵǰλʱԶʧ + } + if FLastActiveWnd = 0 then + FLastActiveWnd := GetActiveWindow; + SetClassLong(Dialog.Handle, GCL_STYLE, GetClassLong(Dialog.Handle, GCL_STYLE) or CS_DROPSHADOW); + FInitializeCaption := Dialog.Caption; + SetWindowPos(Dialog.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE OR SWP_NOSIZE OR SWP_NOMOVE OR SWP_SHOWWINDOW); + PBoolean(@Dialog.Visible)^ := True; + Dialog.Perform(CM_VISIBLECHANGED, 0, 0); + if not Assigned(FAppEvents) then + begin + FAppEvents := TApplicationEvents.Create(Dialog); + FAppEvents.OnMessage := DoPopupMessage; + end; + if CloseDelay > 0 then + FTimer.Enabled := True; + finally + AfterPopup; end; end; procedure TDialogBuilder.Popup(AControl: TControl); +var + APos: TPoint; begin + BeforePopup; + if IsAppVisible(True) then + APos := CalcControlPopupPos(AControl) + else + APos := CalcControlPopupPos(nil); if not Assigned(FPopupHelper) then begin FPopupHelper := TDialogPopupHelper.Create(nil); FPopupHelper.Builder := Self; end; FPopupHelper.Control := AControl; - FLastActiveWnd := GetParentForm(AControl).Handle; - Popup(CalcControlPopupPos(AControl)); + Popup(APos); end; procedure TDialogBuilder.Realign; @@ -1309,6 +1481,16 @@ procedure TDialogBuilder.SetOnResultCallback(ACallback: TDialogResultCallback); SetOnResult(AEvent); end; +procedure TDialogBuilder.SetPopupMonitor(const Value: TMonitor); +begin + FPopupMonitor := Value; +end; + +procedure TDialogBuilder.SetPopupPosition(const Value: TQDialogPopupPosition); +begin + FPopupPosition := Value; +end; + procedure TDialogBuilder.SetCloseDelay(const Value: Word); begin if FCloseDelay <> Value then @@ -1355,6 +1537,7 @@ procedure TDialogBuilder.ShowModal; Realign; if CloseDelay > 0 then FTimer.Enabled := True; + FInitializeCaption := Dialog.Caption; SetClassLong(Dialog.Handle, GCL_STYLE, GetClassLong(Dialog.Handle, GCL_STYLE) and (not CS_DROPSHADOW)); FDialog.ShowModal; DoResult; diff --git a/Source/qjson.pas b/Source/qjson.pas index 49e6402..869dc62 100644 --- a/Source/qjson.pas +++ b/Source/qjson.pas @@ -21,7 +21,6 @@ interface ˺ţ4367 4209 4324 0179 731 Угŷ索 - } { ޶־ @@ -37,7 +36,7 @@ interface 2017.1.1 ========== - + Insert ϵкָλòһ㣨ľֺ뽨飩 + + Insert ϵкָλòһ㣨ľֺ뽨飩 {I 2016.11.23 ========== @@ -307,7 +306,7 @@ interface * Assignһ } // ԻΪDelphi 2007XE6汾Ŀ޸ -uses classes, sysutils, math, qstring, typinfo, qrbtree, +uses classes, sysutils, math, qstring, typinfo, qrbtree, fmtbcd, {$IF RTLVersion>27} System.NetEncoding{$ELSE}EncdDecd{$IFEND} {$IFDEF MSWINDOWS}, windows{$ENDIF} @@ -353,6 +352,9 @@ interface /// jdtFloat˫ȸ(Double) /// /// + /// jdtBcdBCD + /// + /// /// jdtBoolean /// /// @@ -365,8 +367,7 @@ interface /// jdtObject /// /// - TQJsonDataType = (jdtUnknown, jdtNull, jdtString, jdtInteger, jdtFloat, - jdtBoolean, jdtDateTime, jdtArray, jdtObject); + TQJsonDataType = (jdtUnknown, jdtNull, jdtString, jdtInteger, jdtFloat, jdtBcd, jdtBoolean, jdtDateTime, jdtArray, jdtObject); TQJson = class; {$IF RTLVersion>=21} /// @@ -377,9 +378,8 @@ TQJson = class; /// ԻֶεϢ /// Ƿ¼Իֶ /// ûԶĸݳԱ - TQJsonRttiFilterEventA = reference to procedure(ASender: TQJson; - AObject: Pointer; AName: QStringW; AType: PTypeInfo; var Accept: Boolean; - ATag: Pointer); + TQJsonRttiFilterEventA = reference to procedure(ASender: TQJson; AObject: Pointer; AName: QStringW; AType: PTypeInfo; + var Accept: Boolean; ATag: Pointer); /// /// ˴XE6֧ /// @@ -387,8 +387,7 @@ TQJson = class; /// Ҫ˵Ķ /// ǷҪö /// ûӵ - TQJsonFilterEventA = reference to procedure(ASender, AItem: TQJson; - var Accept: Boolean; ATag: Pointer); + TQJsonFilterEventA = reference to procedure(ASender, AItem: TQJson; var Accept: Boolean; ATag: Pointer); {$IFEND >=2010} /// /// RTTIϢ˻صXE6֧XEǰİ汾¼ص @@ -398,9 +397,8 @@ TQJson = class; /// ԻֶεϢ /// Ƿ¼Իֶ /// ûԶĸݳԱ - TQJsonRttiFilterEvent = procedure(ASender: TQJson; AObject: Pointer; - AName: QStringW; AType: PTypeInfo; var Accept: Boolean; ATag: Pointer) - of object; + TQJsonRttiFilterEvent = procedure(ASender: TQJson; AObject: Pointer; AName: QStringW; AType: PTypeInfo; var Accept: Boolean; + ATag: Pointer) of object; /// /// ˴XE6֧ /// @@ -408,8 +406,7 @@ TQJson = class; /// Ҫ˵Ķ /// ǷҪö /// ûӵ - TQJsonFilterEvent = procedure(ASender, AItem: TQJson; var Accept: Boolean; - ATag: Pointer) of object; + TQJsonFilterEvent = procedure(ASender, AItem: TQJson; var Accept: Boolean; ATag: Pointer) of object; TListSortCompareEvent = function(Item1, Item2: Pointer): Integer of object; PQJson = ^TQJson; {$IF RTLVersion>=21} @@ -479,12 +476,11 @@ TQJsonEnumerator = class; /// jesWithCommentʱע /// /// - TJsonEncodeSetting = (jesIgnoreNull, jesIgnoreDefault, jesDoFormat, - jesDoEscape, jesNullAsString, jesJavaDateTime, jesWithComment); + TJsonEncodeSetting = (jesIgnoreNull, jesIgnoreDefault, jesDoFormat, jesDoEscape, jesNullAsString, jesJavaDateTime, + jesWithComment); TJsonEncodeSettings = set of TJsonEncodeSetting; - TQJsonEncodeBytesEvent = procedure(const ABytes: TBytes; - var AResult: QStringW); + TQJsonEncodeBytesEvent = procedure(const ABytes: TBytes; var AResult: QStringW); TQJsonDecodeBytesEvent = procedure(const S: QStringW; var AResult: TBytes); EJsonError = class(Exception) @@ -507,39 +503,31 @@ EJsonError = class(Exception) TQJsonCommentStyle = (jcsIgnore, jcsInherited, jcsBeforeName, jcsAfterValue); TQJsonMergeMethod = (jmmIgnore, jmmAsSource, jmmAppend, jmmReplace); TQJsonForEachCallback = procedure(AItem: TQJson; ATag: Pointer) of object; - TQJsonMatchFilterCallback = procedure(AItem: TQJson; ATag: Pointer; - var Accept: Boolean) of object; + TQJsonMatchFilterCallback = procedure(AItem: TQJson; ATag: Pointer; var Accept: Boolean) of object; {$IFDEF UNICODE} TQJsonForEachCallbackA = reference to procedure(AItem: TQJson); - TQJsonMatchFilterCallbackA = reference to procedure(AItem: TQJson; - var Accept: Boolean); + TQJsonMatchFilterCallbackA = reference to procedure(AItem: TQJson; var Accept: Boolean); {$ENDIF} - TQJsonMatchSetting = (jmsIgnoreCase, jmsNest, jmsMatchName, jmsMatchPath, - jmsMatchValue); + TQJsonMatchSetting = (jmsIgnoreCase, jmsNest, jmsMatchName, jmsMatchPath, jmsMatchValue); TQJsonMatchSettings = set of TQJsonMatchSetting; TQJsonContainerEnumerator = class; - IQJsonContainer=interface; + IQJsonContainer = interface; + IQJsonContainer = interface ['{C9FF8471-19FC-435A-B1A7-21F0D5206720}'] function GetCount: Integer; function GetItems(const AIndex: Integer): TQJson; - {$IFDEF UNICODE} - function ForEach(ACallback: TQJsonForEachCallback; ATag: Pointer = nil) - : IQJsonContainer; overload; +{$IFDEF UNICODE} + function ForEach(ACallback: TQJsonForEachCallback; ATag: Pointer = nil): IQJsonContainer; overload; - function ForEach(ACallback: TQJsonForEachCallbackA) - : IQJsonContainer; overload; - function Match(const AFilter: TQJsonMatchFilterCallbackA; - ATag: Pointer = nil): IQJsonContainer; overload; + function ForEach(ACallback: TQJsonForEachCallbackA): IQJsonContainer; overload; + function Match(const AFilter: TQJsonMatchFilterCallbackA; ATag: Pointer = nil): IQJsonContainer; overload; - function Match(const ARegex: QStringW; ASettings: TQJsonMatchSettings) - : IQJsonContainer; overload; + function Match(const ARegex: QStringW; ASettings: TQJsonMatchSettings): IQJsonContainer; overload; function Match(const AIndexes: array of Integer): IQJsonContainer; overload; - function Match(const AStart, AStop, AStep: Integer) - : IQJsonContainer; overload; - function Match(const AFilter: TQJsonMatchFilterCallback; - ATag: Pointer = nil): IQJsonContainer; overload; - {$ENDIF} + function Match(const AStart, AStop, AStep: Integer): IQJsonContainer; overload; + function Match(const AFilter: TQJsonMatchFilterCallback; ATag: Pointer = nil): IQJsonContainer; overload; +{$ENDIF} function GetEnumerator: TQJsonContainerEnumerator; function GetIsEmpty: Boolean; property Items[const AIndex: Integer]: TQJson read GetItems; default; @@ -563,21 +551,15 @@ TQJsonContainer = class(TInterfacedObject, IQJsonContainer) FItems: TQJsonItemList; function GetCount: Integer; function GetItems(const AIndex: Integer): TQJson; - function ForEach(ACallback: TQJsonForEachCallback; ATag: Pointer = nil) - : IQJsonContainer; overload; + function ForEach(ACallback: TQJsonForEachCallback; ATag: Pointer = nil): IQJsonContainer; overload; {$IFDEF UNICODE} - function ForEach(ACallback: TQJsonForEachCallbackA) - : IQJsonContainer; overload; - function Match(const AFilter: TQJsonMatchFilterCallbackA; - ATag: Pointer = nil): IQJsonContainer; overload; + function ForEach(ACallback: TQJsonForEachCallbackA): IQJsonContainer; overload; + function Match(const AFilter: TQJsonMatchFilterCallbackA; ATag: Pointer = nil): IQJsonContainer; overload; {$ENDIF} - function Match(const ARegex: QStringW; ASettings: TQJsonMatchSettings) - : IQJsonContainer; overload; + function Match(const ARegex: QStringW; ASettings: TQJsonMatchSettings): IQJsonContainer; overload; function Match(const AIndexes: array of Integer): IQJsonContainer; overload; - function Match(const AStart, AStop, AStep: Integer) - : IQJsonContainer; overload; - function Match(const AFilter: TQJsonMatchFilterCallback; ATag: Pointer) - : IQJsonContainer; overload; + function Match(const AStart, AStop, AStep: Integer): IQJsonContainer; overload; + function Match(const AFilter: TQJsonMatchFilterCallback; ATag: Pointer): IQJsonContainer; overload; function GetIsEmpty: Boolean; function GetEnumerator: TQJsonContainerEnumerator; public @@ -595,6 +577,8 @@ TQJsonContainer = class(TInterfacedObject, IQJsonContainer) /// ͬijԱʡΪjdtArrayjdtObjectʱӽ. /// TQJson = class + private + protected FName: QStringW; FNameHash: Cardinal; @@ -627,6 +611,8 @@ TQJson = class procedure SetAsInteger(const Value: Integer); procedure SetAsString(const Value: QStringW); procedure SetAsDateTime(const Value: TDateTime); + function GetAsBcd: TBcd; + procedure SetAsBcd(const Value: TBcd); function GetCount: Integer; function GetItems(AIndex: Integer): TQJson; class function CharUnescape(var p: PQCharW): QCharW; @@ -634,17 +620,13 @@ TQJson = class procedure ArrayNeeded(ANewType: TQJsonDataType); procedure ValidArray; procedure ParseObject(var p: PQCharW); - function ParseJsonPair(ABuilder: TQStringCatHelperW; - var p: PQCharW): Integer; + function ParseJsonPair(ABuilder: TQStringCatHelperW; var p: PQCharW): Integer; function ParseName(ABuilder: TQStringCatHelperW; var p: PQCharW): Integer; procedure ParseValue(ABuilder: TQStringCatHelperW; var p: PQCharW); - function FormatParseError(ACode: Integer; AMsg: QStringW; ps, p: PQCharW) - : QStringW; - function FormatParseErrorEx(ACode: Integer; AMsg: QStringW; ps, p: PQCharW) - : EJsonError; + function FormatParseError(ACode: Integer; AMsg: QStringW; ps, p: PQCharW): QStringW; + function FormatParseErrorEx(ACode: Integer; AMsg: QStringW; ps, p: PQCharW): EJsonError; procedure RaiseParseException(ACode: Integer; ps, p: PQCharW); - function TryParseValue(ABuilder: TQStringCatHelperW; - var p: PQCharW): Integer; + function TryParseValue(ABuilder: TQStringCatHelperW; var p: PQCharW): Integer; function BooleanToStr(const b: Boolean): QStringW; function GetIsNull: Boolean; function GetIsNumeric: Boolean; @@ -664,11 +646,9 @@ TQJson = class function CreateJson: TQJson; virtual; procedure FreeJson(AJson: TQJson); inline; procedure CopyValue(ASource: TQJson); inline; - procedure InternalRttiFilter(ASender: TQJson; AObject: Pointer; - APropName: QStringW; APropType: PTypeInfo; var Accept: Boolean; - ATag: Pointer); - function InternalEncode(ABuilder: TQStringCatHelperW; - ASettings: TJsonEncodeSettings; const AIndent: QStringW) + procedure InternalRttiFilter(ASender: TQJson; AObject: Pointer; APropName: QStringW; APropType: PTypeInfo; + var Accept: Boolean; ATag: Pointer); + function InternalEncode(ABuilder: TQStringCatHelperW; ASettings: TJsonEncodeSettings; const AIndent: QStringW) : TQStringCatHelperW; function ArrayItemTypeName(ATypeName: QStringW): QStringW; function ArrayItemType(ArrType: PTypeInfo): PTypeInfo; @@ -677,8 +657,7 @@ TQJson = class function GetIsBool: Boolean; function GetAsBytes: TBytes; procedure SetAsBytes(const Value: TBytes); - class function SkipSpaceAndComment(var p: PQCharW; var AComment: QStringW; - lastvalidchar: QCharW = #0): Integer; + class function SkipSpaceAndComment(var p: PQCharW; var AComment: QStringW; lastvalidchar: QCharW = #0): Integer; procedure DoParsed; virtual; procedure SetIgnoreCase(const Value: Boolean); function HashName(const S: QStringW): TQHashType; @@ -711,15 +690,12 @@ TQJson = class procedure SetAsBase64Bytes(const Value: TBytes); function GetAsHexBytes: TBytes; procedure SetAsHexBytes(const Value: TBytes); - function InternalGetAsBytes(AConverter: TQJsonDecodeBytesEvent; - AEncoding: TTextEncoding; AWriteBom: Boolean): TBytes; - procedure InternalSetAsBytes(AConverter: TQJsonEncodeBytesEvent; - ABytes: TBytes); + function InternalGetAsBytes(AConverter: TQJsonDecodeBytesEvent; AEncoding: TTextEncoding; AWriteBom: Boolean): TBytes; + procedure InternalSetAsBytes(AConverter: TQJsonEncodeBytesEvent; ABytes: TBytes); public /// 캯 constructor Create; overload; - constructor Create(const AName, AValue: QStringW; - ADataType: TQJsonDataType = jdtUnknown); overload; + constructor Create(const AName, AValue: QStringW; ADataType: TQJsonDataType = jdtUnknown); overload; /// destructor Destroy; override; { һӽ @@ -738,14 +714,12 @@ TQJson = class /// Ҫӵݵֵʽַ /// ʽͣΪjdtUnknownԶ /// شĽ - function Add(AName, AValue: QStringW; ADataType: TQJsonDataType) - : Integer; overload; + function Add(AName, AValue: QStringW; ADataType: TQJsonDataType): Integer; overload; /// һ /// ҪӵĶĽ /// Ҫӵ /// شĽʵ - function Add(const AName: QStringW; AItems: array of const) - : TQJson; overload; + function Add(const AName: QStringW; AItems: array of const): TQJson; overload; { һӽ ҪӵĽ ҪӵĽͣʡԣԶֵݼ @@ -798,16 +772,11 @@ TQJson = class function Add(AName: QStringW): TQJson; overload; virtual; function Insert(AIndex: Integer; const AName: String): TQJson; overload; - function Insert(AIndex: Integer; const AName: String; - ADataType: TQJsonDataType): TQJson; overload; - function Insert(AIndex: Integer; const AName, AValue: String; - ADataType: TQJsonDataType = jdtString): TQJson; overload; - function Insert(AIndex: Integer; const AName: String; AValue: Extended) - : TQJson; overload; - function Insert(AIndex: Integer; const AName: String; AValue: Int64) - : TQJson; overload; - function Insert(AIndex: Integer; const AName: String; AValue: Boolean) - : TQJson; overload; + function Insert(AIndex: Integer; const AName: String; ADataType: TQJsonDataType): TQJson; overload; + function Insert(AIndex: Integer; const AName, AValue: String; ADataType: TQJsonDataType = jdtString): TQJson; overload; + function Insert(AIndex: Integer; const AName: String; AValue: Extended): TQJson; overload; + function Insert(AIndex: Integer; const AName: String; AValue: Int64): TQJson; overload; + function Insert(AIndex: Integer; const AName: String; AValue: Boolean): TQJson; overload; procedure Insert(AIndex: Integer; AChild: TQJson); overload; /// ǿһ·,,δҪĽ(jdtObjectjdtArray) /// ҪӵĽ· @@ -837,8 +806,7 @@ TQJson = class /// ӽ /// ӽڣ򷵻ָӽ㣬ڣӽ㲢 /// Add ӽǷڣԱظ Add 顣ForcePathڲʶеַӶ - function ForceName(AName: QStringW; - AType: TQJsonDataType = jdtNull): TQJson; + function ForceName(AName: QStringW; AType: TQJsonDataType = jdtNull): TQJson; /// ָJSONַ /// Ҫַ /// ַȣ<=0Ϊ\0(#0)βCԱ׼ַ @@ -871,8 +839,7 @@ TQJson = class /// Ϊǿ¾ɶ֮ݱûκιϵһ /// 󣬲һӰ졣 /// - function CopyIf(const ATag: Pointer; AFilter: TQJsonFilterEventA) - : TQJson; overload; + function CopyIf(const ATag: Pointer; AFilter: TQJsonFilterEventA): TQJson; overload; {$IFEND >=2010} /// һµʵ /// ûӵıǩ @@ -881,8 +848,7 @@ TQJson = class /// Ϊǿ¾ɶ֮ݱûκιϵһ /// 󣬲һӰ졣 /// - function CopyIf(const ATag: Pointer; AFilter: TQJsonFilterEvent) - : TQJson; overload; + function CopyIf(const ATag: Pointer; AFilter: TQJsonFilterEvent): TQJson; overload; /// ¡һµʵ /// µĿʵ /// Ϊʵִеǿ¾ɶ֮ݱûκιϵ @@ -896,10 +862,8 @@ TQJson = class /// ADoFormatΪTrueʱݣĬΪո /// رַ /// AsJsonȼEncode(True,' ') - function Encode(ADoFormat: Boolean; ADoEscape: Boolean = False; - AIndent: QStringW = ' '): QStringW; overload; - function Encode(ASettings: TJsonEncodeSettings; AIndent: QStringW = ' ') - : QStringW; overload; + function Encode(ADoFormat: Boolean; ADoEscape: Boolean = False; AIndent: QStringW = ' '): QStringW; overload; + function Encode(ASettings: TJsonEncodeSettings; AIndent: QStringW = ' '): QStringW; overload; /// ȡָƻȡֵַʾ /// /// Ĭֵ @@ -966,18 +930,15 @@ TQJson = class /// Ƿݹӽ /// ҵĽδҵ0 /// ˺ְ֧±귽ʽ - function ItemByName(const AName: QStringW; AList: TQJsonItemList; - ANest: Boolean = False): Integer; overload; + function ItemByName(const AName: QStringW; AList: TQJsonItemList; ANest: Boolean = False): Integer; overload; {$IFDEF ENABLE_REGEX} /// ȡָƹĽ㵽б /// ʽ /// ڱб /// Ƿݹӽ /// ҵĽδҵ0 - function ItemByRegex(const ARegex: QStringW; AList: TQJsonItemList; - ANest: Boolean = False): Integer; overload; - function Match(const ARegex: QStringW; AMatches: TQJsonMatchSettings) - : IQJsonContainer; + function ItemByRegex(const ARegex: QStringW; AList: TQJsonItemList; ANest: Boolean = False): Integer; overload; + function Match(const ARegex: QStringW; AMatches: TQJsonMatchSettings): IQJsonContainer; {$ENDIF} /// ȡָ·JSON /// ·".""/""\"ָ @@ -1010,8 +971,7 @@ TQJson = class /// ûԼӵĶ /// ǷǶ׵ãΪfalseֻԵǰӽ /// ˻صΪnilȼClear - procedure DeleteIf(const ATag: Pointer; ANest: Boolean; - AFilter: TQJsonFilterEventA); overload; + procedure DeleteIf(const ATag: Pointer; ANest: Boolean; AFilter: TQJsonFilterEventA); overload; {$IFEND >=2010} /// /// ɾӽ @@ -1019,8 +979,7 @@ TQJson = class /// ûԼӵĶ /// ǷǶ׵ãΪfalseֻԵǰӽ /// ˻صΪnilȼClear - procedure DeleteIf(const ATag: Pointer; ANest: Boolean; - AFilter: TQJsonFilterEvent); overload; + procedure DeleteIf(const ATag: Pointer; ANest: Boolean; AFilter: TQJsonFilterEvent); overload; /// ָƵĽ /// ҪҵĽ /// ֵδҵ-1 @@ -1029,34 +988,29 @@ TQJson = class /// ҪҵĽֵ /// ǷϸģʽȽ /// ֵδҵ-1 - function IndexOfValue(const AValue: Variant; - AStrict: Boolean = False): Integer; + function IndexOfValue(const AValue: Variant; AStrict: Boolean = False): Integer; /// еӽ /// ص /// ǷǶ׵ãΪfalseֻԵǰӽ /// ûԶĸӶ - procedure ForEach(ACallback: TQJsonFilterEvent; ANest: Boolean; - const ATag: Pointer); overload; + procedure ForEach(ACallback: TQJsonFilterEvent; ANest: Boolean; const ATag: Pointer); overload; {$IF RTLVersion>=21} /// еӽ /// ص /// ǷǶ׵ãΪfalseֻԵǰӽ /// ûԶĸӶ - procedure ForEach(ACallback: TQJsonFilterEventA; ANest: Boolean; - const ATag: Pointer); overload; + procedure ForEach(ACallback: TQJsonFilterEventA; ANest: Boolean; const ATag: Pointer); overload; /// ҷĽ /// ûԶĸӶ /// ǷǶ׵ãΪfalseֻԵǰӽ /// ˻صΪnil򷵻nil - function FindIf(const ATag: Pointer; ANest: Boolean; - AFilter: TQJsonFilterEventA): TQJson; overload; + function FindIf(const ATag: Pointer; ANest: Boolean; AFilter: TQJsonFilterEventA): TQJson; overload; {$IFEND >=2010} /// ҷĽ /// ûԶĸӶ /// ǷǶ׵ãΪfalseֻԵǰӽ /// ˻صΪnil򷵻nil - function FindIf(const ATag: Pointer; ANest: Boolean; - AFilter: TQJsonFilterEvent): TQJson; overload; + function FindIf(const ATag: Pointer; ANest: Boolean; AFilter: TQJsonFilterEvent): TQJson; overload; /// еĽ procedure Clear; virtual; /// 浱ǰݵ @@ -1065,28 +1019,25 @@ TQJson = class /// ǷдBOM /// ǷʽJson /// ע⵱ǰƲᱻд - procedure SaveToStream(AStream: TStream; AEncoding: TTextEncoding = teUtf8; - AWriteBom: Boolean = True; ADoFormat: Boolean = True); + procedure SaveToStream(AStream: TStream; AEncoding: TTextEncoding = teUtf8; AWriteBom: Boolean = True; + ADoFormat: Boolean = True); /// ĵǰλÿʼJSON /// Դ /// Դļ룬ΪteUnknownԶж /// ĵǰλõijȱ2ֽڣ - procedure LoadFromStream(AStream: TStream; - AEncoding: TTextEncoding = teUnknown); + procedure LoadFromStream(AStream: TStream; AEncoding: TTextEncoding = teUnknown); /// 浱ǰݵļ /// ļ /// ʽ /// ǷдUTF-8BOM /// ǷʽJson /// ע⵱ǰƲᱻд - procedure SaveToFile(const AFileName: String; - AEncoding: TTextEncoding = teUtf8; AWriteBom: Boolean = True; + procedure SaveToFile(const AFileName: String; AEncoding: TTextEncoding = teUtf8; AWriteBom: Boolean = True; ADoFormat: Boolean = True); /// ָļмصǰ /// Ҫصļ /// Դļ룬ΪteUnknownԶж - procedure LoadFromFile(const AFileName: String; - AEncoding: TTextEncoding = teUnknown); + procedure LoadFromFile(const AFileName: String; AEncoding: TTextEncoding = teUnknown); /// / ֵΪNullȼֱDataTypeΪjdtNull procedure ResetNull; function Escape(const S: QStringW): QStringW; @@ -1128,20 +1079,17 @@ TQJson = class /// ǷڻָTCollectionԪʱеԪ,ĬΪtrur /// ʵϲֶֻ֧󣬼¼Ŀǰ޷ֱתΪTValueû /// 壬Ϊֵʵʾ㸳ֵҲزˣ - procedure ToRtti(AInstance: TValue; - AClearCollections: Boolean = True); overload; + procedure ToRtti(AInstance: TValue; AClearCollections: Boolean = True); overload; /// ӵǰJSONаָϢԭָĵַ /// Ŀĵַ /// ṹϢ /// ǷڻָTCollectionԪʱеԪ,ĬΪtrur /// ADestӦӦǼ¼Ͳ֧ - procedure ToRtti(ADest: Pointer; AType: PTypeInfo; - AClearCollections: Boolean = True); overload; + procedure ToRtti(ADest: Pointer; AType: PTypeInfo; AClearCollections: Boolean = True); overload; /// ӵǰJSONлԭָļ¼ʵ /// Ŀļ¼ʵ /// ǷڻָTCollectionԪʱеԪ,ĬΪtrur - procedure ToRecord(var ARecord: T; - AClearCollections: Boolean = True); + procedure ToRecord(var ARecord: T; AClearCollections: Boolean = True); {$IFEND} /// ָӽƳ /// ҪƳӽ @@ -1189,24 +1137,21 @@ TQJson = class /// Ŀ길 /// ·ָ /// · - function GetRelPath(AParent: TQJson; APathDelimiter: QCharW = '\') - : QStringW; + function GetRelPath(AParent: TQJson; APathDelimiter: QCharW = '\'): QStringW; /// ӽ /// Ƿ /// Ƿӽ /// ӽݣΪjdtUnknownԶ⣬ָ /// ȽϷָĬϹ򣬷 /// AByTypeΪjdtUnknown豣֤ӽֵܹתΪĿ - procedure Sort(AByName, ANest: Boolean; AByType: TQJsonDataType; - AOnCompare: TListSortCompareEvent); overload; + procedure Sort(AByName, ANest: Boolean; AByType: TQJsonDataType; AOnCompare: TListSortCompareEvent); overload; /// ӽ /// Ƿ /// Ƿӽ /// ӽݣΪjdtUnknownԶ⣬ָ /// ȽϷָĬϹ򣬷 /// AByTypeΪjdtUnknown豣֤ӽֵܹתΪĿ - procedure Sort(AByName, ANest: Boolean; AByType: TQJsonDataType; - AOnCompare: TListSortCompare); overload; + procedure Sort(AByName, ANest: Boolean; AByType: TQJsonDataType; AOnCompare: TListSortCompare); overload; {$IF RTLVersion>=21} /// ӽ /// Ƿ @@ -1214,8 +1159,7 @@ TQJson = class /// ӽݣΪjdtUnknownԶ⣬ָ /// ȽϷָĬϹ򣬷 /// AByTypeΪjdtUnknown豣֤ӽֵܹתΪĿ - procedure Sort(AByName, ANest: Boolean; AByType: TQJsonDataType; - AOnCompare: TListSortCompareFunc); overload; + procedure Sort(AByName, ANest: Boolean; AByType: TQJsonDataType; AOnCompare: TListSortCompareFunc); overload; {$IFEND} /// ת˳ /// ǷǶת @@ -1234,8 +1178,7 @@ TQJson = class /// ǷǶ׼ӽ /// ǷϸҪƥ /// true򣬷false - function ContainsValue(const AValue: Variant; ANest: Boolean = False; - AStrict: Boolean = False): Boolean; + function ContainsValue(const AValue: Variant; ANest: Boolean = False; AStrict: Boolean = False): Boolean; /// жǷָ·ӽ /// ҪҵĽ /// trueʧܣfalse @@ -1268,17 +1211,12 @@ TQJson = class /// ǷӸƳԼ procedure Reset(ADetach: Boolean); virtual; // תһJsonֵΪַ - class function BuildJsonString(ABuilder: TQStringCatHelperW; var p: PQCharW) - : Boolean; overload; + class function BuildJsonString(ABuilder: TQStringCatHelperW; var p: PQCharW): Boolean; overload; class function BuildJsonString(S: QStringW): QStringW; overload; - class function BuildJsonString(ABuilder: TQStringCatHelperW; S: QStringW) - : Boolean; overload; - class procedure JsonCat(ABuilder: TQStringCatHelperW; const S: QStringW; - ADoEscape: Boolean); overload; - class function JsonCat(const S: QStringW; ADoEscape: Boolean) - : QStringW; overload; - class function JsonEscape(const S: QStringW; ADoEscape: Boolean) - : QStringW; overload; + class function BuildJsonString(ABuilder: TQStringCatHelperW; S: QStringW): Boolean; overload; + class procedure JsonCat(ABuilder: TQStringCatHelperW; const S: QStringW; ADoEscape: Boolean); overload; + class function JsonCat(const S: QStringW; ADoEscape: Boolean): QStringW; overload; + class function JsonEscape(const S: QStringW; ADoEscape: Boolean): QStringW; overload; class function JsonUnescape(const S: QStringW): QStringW; class function EncodeDateTime(const AValue: TDateTime): QStringW; procedure Replace(AIndex: Integer; ANewItem: TQJson); virtual; @@ -1317,6 +1255,8 @@ TQJson = class property AsInt64: Int64 read GetAsInt64 write SetAsInt64; /// ǰ㵱 property AsFloat: Extended read GetAsFloat write SetAsFloat; + /// ǰ㵱BCDֵ + property AsBcd: TBcd read GetAsBcd write SetAsBcd; /// ǰ㵱ʱ property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime; /// ǰ㵱ַͷ @@ -1347,8 +1287,7 @@ TQJson = class /// JSON property Root: TQJson read GetRoot; /// עʽ - property CommentStyle: TQJsonCommentStyle read FCommentStyle - write FCommentStyle; + property CommentStyle: TQJsonCommentStyle read FCommentStyle write FCommentStyle; /// ע property Comment: QStringW read FComment write FComment; // Super Object ݷģʽ @@ -1407,13 +1346,11 @@ TQJsonStreamHelper = record FWriteBom: Boolean; FLast: PQStreamHelperStack; FStringHelper: TQStringCatHelperW; - procedure InternalWriteString(S: QStringW; - ADoAppend: Boolean = True); inline; + procedure InternalWriteString(S: QStringW; ADoAppend: Boolean = True); inline; procedure Push; procedure Pop; public - procedure BeginWrite(AStream: TStream; AEncoding: TTextEncoding; - ADoEscape: Boolean = False; AWriteBom: Boolean = True); + procedure BeginWrite(AStream: TStream; AEncoding: TTextEncoding; ADoEscape: Boolean = False; AWriteBom: Boolean = True); procedure EndWrite; procedure BeginObject; overload; procedure BeginObject(const AName: QStringW); overload; @@ -1437,15 +1374,13 @@ TQJsonStreamHelper = record procedure Write(const AName: QStringW; AValue: TBytes); overload; procedure Write(const AName: QStringW; AValue: Boolean); overload; procedure WriteDateTime(const AName: QStringW; AValue: TDateTime); overload; - procedure Write(const AName: QStringW; const p: PByte; - const l: Integer); overload; + procedure Write(const AName: QStringW; const p: PByte; const l: Integer); overload; procedure WriteNull(const AName: QStringW); overload; property DoEscape: Boolean read FDoEscape write FDoEscape; end; TJsonDatePrecision = (jdpMillisecond, jdpSecond); - TJsonIntToTimeStyle = (tsDeny, tsSecondsFrom1970, tsSecondsFrom1899, - tsMsFrom1970, tsMsFrom1899); + TJsonIntToTimeStyle = (tsDeny, tsSecondsFrom1970, tsSecondsFrom1899, tsMsFrom1970, tsMsFrom1899); const JSON_NO_TIMEZONE = -128; @@ -1536,8 +1471,7 @@ implementation SSupportFloat = 'NaN/+/-޲JSON淶֧֡'; SParamMissed = ' %s ͬĽδҵ'; SMethodMissed = 'ָĺ %s ڡ'; - SMissRttiTypeDefine = - '޷ҵ %s RTTIϢԽӦ͵(array[0..1] of ByteΪTByteArr=array[0..1]ȻTByteArr)'; + SMissRttiTypeDefine = '޷ҵ %s RTTIϢԽӦ͵(array[0..1] of ByteΪTByteArr=array[0..1]ȻTByteArr)'; SUnsupportPropertyType = 'ֵ֧͡'; SArrayTypeMissed = 'δ֪Ԫ͡'; SUnknownError = 'δ֪Ĵ'; @@ -1550,8 +1484,8 @@ implementation SUnsupportVarType = 'ֵ֧ı %d '; const - JsonTypeName: array [TQJsonDataType] of QStringW = ('Unknown', 'Null', - 'String', 'Integer', 'Float', 'Boolean', 'DateTime', 'Array', 'Object'); + JsonTypeName: array [TQJsonDataType] of QStringW = ('Unknown', 'Null', 'String', 'Integer', 'Float', 'Bcd', 'Boolean', + 'DateTime', 'Array', 'Object'); EParse_Unknown = -1; EParse_BadStringStart = 1; EParse_BadJson = 2; @@ -1561,6 +1495,8 @@ implementation EParse_BadNameStart = 6; EParse_BadNameEnd = 7; EParse_NameNotFound = 8; + MaxInt64: Int64 = 9223372036854775807; + MinInt64: Int64 = -9223372036854775808; procedure DoEncodeAsBase64(const ABytes: TBytes; var AResult: QStringW); {$IF RTLVersion<=27} @@ -1652,8 +1588,7 @@ function TQJson.DoCompareName(Item1, Item2: Pointer): Integer; AIgnoreCase := AItem1.IgnoreCase; if AIgnoreCase <> AItem2.IgnoreCase then AIgnoreCase := False; - Result := StrCmpW(PWideChar(AItem1.Name), PWideChar(AItem2.Name), - AIgnoreCase); + Result := StrCmpW(PWideChar(AItem1.Name), PWideChar(AItem2.Name), AIgnoreCase); end; function TQJson.DoCompareValueBoolean(Item1, Item2: Pointer): Integer; @@ -1754,8 +1689,7 @@ function TQJson.DoCompareValueString(Item1, Item2: Pointer): Integer; AIgnoreCase := AItem1.IgnoreCase; if AIgnoreCase <> AItem2.IgnoreCase then AIgnoreCase := False; - Result := StrCmpW(PWideChar(AItem1.AsString), PWideChar(AItem2.AsString), - AIgnoreCase); + Result := StrCmpW(PWideChar(AItem1.AsString), PWideChar(AItem2.AsString), AIgnoreCase); end; { TQJson } @@ -1833,8 +1767,7 @@ function TQJson.Add(ANode: TQJson): Integer; ANode.FIgnoreCase := FIgnoreCase; end; -function TQJson.Add(AName, AValue: QStringW; ADataType: TQJsonDataType) - : Integer; +function TQJson.Add(AName, AValue: QStringW; ADataType: TQJsonDataType): Integer; var ANode: TQJson; begin @@ -2034,8 +1967,7 @@ function TQJson.BooleanToStr(const b: Boolean): QStringW; Result := CharFalse; end; -class function TQJson.BuildJsonString(ABuilder: TQStringCatHelperW; - S: QStringW): Boolean; +class function TQJson.BuildJsonString(ABuilder: TQStringCatHelperW; S: QStringW): Boolean; var p: PQCharW; begin @@ -2058,8 +1990,7 @@ class function TQJson.BuildJsonString(S: QStringW): QStringW; end; end; -class function TQJson.BuildJsonString(ABuilder: TQStringCatHelperW; - var p: PQCharW): Boolean; +class function TQJson.BuildJsonString(ABuilder: TQStringCatHelperW; var p: PQCharW): Boolean; var AQuoter: QCharW; ps: PQCharW; @@ -2143,8 +2074,7 @@ function TQJson.BytesByPath(APath: QStringW; ADefVal: TBytes): TBytes; Result := ADefVal; end; -class procedure TQJson.JsonCat(ABuilder: TQStringCatHelperW; const S: QStringW; - ADoEscape: Boolean); +class procedure TQJson.JsonCat(ABuilder: TQStringCatHelperW; const S: QStringW; ADoEscape: Boolean); var ps, p, pd: PQCharW; ADelta: Integer; @@ -2409,16 +2339,13 @@ class function TQJson.CharUnescape(var p: PQCharW): QCharW; 'u': begin // \uXXXX - if IsHexChar(p[1]) and IsHexChar(p[2]) and IsHexChar(p[3]) and - IsHexChar(p[4]) then + if IsHexChar(p[1]) and IsHexChar(p[2]) and IsHexChar(p[3]) and IsHexChar(p[4]) then begin - Result := WideChar((HexValue(p[1]) shl 12) or (HexValue(p[2]) shl 8) - or (HexValue(p[3]) shl 4) or HexValue(p[4])); + Result := WideChar((HexValue(p[1]) shl 12) or (HexValue(p[2]) shl 8) or (HexValue(p[3]) shl 4) or HexValue(p[4])); Inc(p, 5); end else - raise Exception.CreateFmt(SCharNeeded, - ['0-9A-Fa-f', StrDupW(p, 0, 4)]); + raise Exception.CreateFmt(SCharNeeded, ['0-9A-Fa-f', StrDupW(p, 0, 4)]); end else begin @@ -2472,8 +2399,7 @@ function TQJson.ContainsName(AName: QStringW; ANest: Boolean): Boolean; end; end; -function TQJson.ContainsValue(const AValue: Variant; - ANest, AStrict: Boolean): Boolean; +function TQJson.ContainsValue(const AValue: Variant; ANest, AStrict: Boolean): Boolean; var I, H: Integer; AItem: TQJson; @@ -2485,13 +2411,10 @@ function TQJson.ContainsValue(const AValue: Variant; begin if AItem.DataType = jdtString then Result := StrCmpW(PWideChar(AItem.AsString), - PWideChar({$IFNDEF UNICODE}QStringW({$ENDIF}VarToStr - (AValue){$IFNDEF UNICODE}){$ENDIF}), IgnoreCase) = 0 - else if (AItem.DataType in [jdtInteger, jdtFloat, jdtBoolean]) and - VarIsNumeric(AValue) then + PWideChar({$IFNDEF UNICODE}QStringW({$ENDIF}VarToStr(AValue){$IFNDEF UNICODE}){$ENDIF}), IgnoreCase) = 0 + else if (AItem.DataType in [jdtInteger, jdtFloat, jdtBoolean]) and VarIsNumeric(AValue) then Result := (AItem.AsVariant = AValue) - else if (AItem.DataType = jdtDateTime) and - (FindVarData(AValue)^.VType = varDate) then + else if (AItem.DataType = jdtDateTime) and (FindVarData(AValue)^.VType = varDate) then Result := SameValue(AItem.AsDateTime, VarToDateTime(AValue)) else Result := False; @@ -2534,8 +2457,7 @@ function TQJson.Copy: TQJson; end; {$IF RTLVersion>=21} -function TQJson.CopyIf(const ATag: Pointer; - AFilter: TQJsonFilterEventA): TQJson; +function TQJson.CopyIf(const ATag: Pointer; AFilter: TQJsonFilterEventA): TQJson; procedure NestCopy(AParentSource, AParentDest: TQJson); var I: Integer; @@ -2549,8 +2471,7 @@ function TQJson.CopyIf(const ATag: Pointer; AFilter(Self, AChildSource, Accept, ATag); if Accept then begin - AChildDest := AParentDest.Add(AChildSource.FName, - AChildSource.DataType); + AChildDest := AParentDest.Add(AChildSource.FName, AChildSource.DataType); if AChildSource.DataType in [jdtArray, jdtObject] then begin AChildDest.DataType := AChildSource.DataType; @@ -2593,8 +2514,7 @@ function TQJson.CopyIf(const ATag: Pointer; AFilter: TQJsonFilterEvent): TQJson; AFilter(Self, AChildSource, Accept, ATag); if Accept then begin - AChildDest := AParentDest.Add(AChildSource.FName, - AChildSource.DataType); + AChildDest := AParentDest.Add(AChildSource.FName, AChildSource.DataType); if AChildSource.DataType in [jdtArray, jdtObject] then NestCopy(AChildSource, AChildDest) else @@ -2630,8 +2550,7 @@ procedure TQJson.CopyValue(ASource: TQJson); Move(PQCharW(ASource.FValue)^, PQCharW(FValue)^, l shl 1); end; -constructor TQJson.Create(const AName, AValue: QStringW; - ADataType: TQJsonDataType); +constructor TQJson.Create(const AName, AValue: QStringW; ADataType: TQJsonDataType); begin inherited Create; FName := AName; @@ -2696,8 +2615,7 @@ procedure TQJson.Delete(AName: QStringW); end; {$IF RTLVersion>=21} -procedure TQJson.DeleteIf(const ATag: Pointer; ANest: Boolean; - AFilter: TQJsonFilterEventA); +procedure TQJson.DeleteIf(const ATag: Pointer; ANest: Boolean; AFilter: TQJsonFilterEventA); procedure DeleteChildren(AParent: TQJson); var I: Integer; @@ -2727,8 +2645,7 @@ procedure TQJson.DeleteIf(const ATag: Pointer; ANest: Boolean; end; {$IFEND >=2010} -procedure TQJson.DeleteIf(const ATag: Pointer; ANest: Boolean; - AFilter: TQJsonFilterEvent); +procedure TQJson.DeleteIf(const ATag: Pointer; ANest: Boolean; AFilter: TQJsonFilterEvent); procedure DeleteChildren(AParent: TQJson); var I: Integer; @@ -2833,8 +2750,7 @@ procedure TQJson.DoParsed; end; -function TQJson.Encode(ADoFormat: Boolean; ADoEscape: Boolean; - AIndent: QStringW): QStringW; +function TQJson.Encode(ADoFormat: Boolean; ADoEscape: Boolean; AIndent: QStringW): QStringW; var ASettings: TJsonEncodeSettings; begin @@ -2846,8 +2762,7 @@ function TQJson.Encode(ADoFormat: Boolean; ADoEscape: Boolean; Result := Encode(ASettings, AIndent); end; -function TQJson.Encode(ASettings: TJsonEncodeSettings; AIndent: QStringW) - : QStringW; +function TQJson.Encode(ASettings: TJsonEncodeSettings; AIndent: QStringW): QStringW; var ABuilder: TQStringCatHelperW; begin @@ -2929,8 +2844,7 @@ procedure TQJson.ExchangeOrder(AIndex1, AIndex2: Integer); {$IF RTLVersion>=21} -function TQJson.FindIf(const ATag: Pointer; ANest: Boolean; - AFilter: TQJsonFilterEventA): TQJson; +function TQJson.FindIf(const ATag: Pointer; ANest: Boolean; AFilter: TQJsonFilterEventA): TQJson; function DoFind(AParent: TQJson): TQJson; var I: Integer; @@ -2972,8 +2886,7 @@ procedure TQJson.FileFromValue(AFileName: QStringW); end; end; -function TQJson.FindIf(const ATag: Pointer; ANest: Boolean; - AFilter: TQJsonFilterEvent): TQJson; +function TQJson.FindIf(const ATag: Pointer; ANest: Boolean; AFilter: TQJsonFilterEvent): TQJson; function DoFind(AParent: TQJson): TQJson; var I: Integer; @@ -3118,8 +3031,7 @@ function TQJson.ForcePath(APath: QStringW): TQJson; end; end; -procedure TQJson.ForEach(ACallback: TQJsonFilterEvent; ANest: Boolean; - const ATag: Pointer); +procedure TQJson.ForEach(ACallback: TQJsonFilterEvent; ANest: Boolean; const ATag: Pointer); var AContinue: Boolean; procedure DoEnum(AParent: TQJson); @@ -3147,8 +3059,7 @@ procedure TQJson.ForEach(ACallback: TQJsonFilterEvent; ANest: Boolean; end; {$IF RTLVersion>=21} -procedure TQJson.ForEach(ACallback: TQJsonFilterEventA; ANest: Boolean; - const ATag: Pointer); +procedure TQJson.ForEach(ACallback: TQJsonFilterEventA; ANest: Boolean; const ATag: Pointer); var AContinue: Boolean; procedure DoEnum(AParent: TQJson); @@ -3176,8 +3087,7 @@ procedure TQJson.ForEach(ACallback: TQJsonFilterEventA; ANest: Boolean; end; {$IFEND} -function TQJson.FormatParseError(ACode: Integer; AMsg: QStringW; ps, p: PQCharW) - : QStringW; +function TQJson.FormatParseError(ACode: Integer; AMsg: QStringW; ps, p: PQCharW): QStringW; var ACol, ARow: Integer; ALine: QStringW; @@ -3197,8 +3107,7 @@ function TQJson.FormatParseError(ACode: Integer; AMsg: QStringW; ps, p: PQCharW) end else if Length(ALine) >= 50 then pls := pe - 50; - ALine := StrDupX(pls, pe - pls) + SLineBreak + StringReplicateW('0', - (IntPtr(pl) - IntPtr(pls)) shr 1 - 1) + '^'; + ALine := StrDupX(pls, pe - pls) + SLineBreak + StringReplicateW('0', (IntPtr(pl) - IntPtr(pls)) shr 1 - 1) + '^'; end; begin @@ -3216,8 +3125,7 @@ function TQJson.FormatParseError(ACode: Integer; AMsg: QStringW; ps, p: PQCharW) SetLength(Result, 0); end; -function TQJson.FormatParseErrorEx(ACode: Integer; AMsg: QStringW; - ps, p: PQCharW): EJsonError; +function TQJson.FormatParseErrorEx(ACode: Integer; AMsg: QStringW; ps, p: PQCharW): EJsonError; var ACol, ARow: Integer; ALine: QStringW; @@ -3237,8 +3145,7 @@ function TQJson.FormatParseErrorEx(ACode: Integer; AMsg: QStringW; end else if Length(ALine) >= 50 then pls := pe - 50; - ALine := StrDupX(pls, pe - pls) + SLineBreak + StringReplicateW('0', - (IntPtr(pl) - IntPtr(pls)) shr 1 - 1) + '^'; + ALine := StrDupX(pls, pe - pls) + SLineBreak + StringReplicateW('0', (IntPtr(pl) - IntPtr(pls)) shr 1 - 1) + '^'; end; begin @@ -3250,8 +3157,7 @@ function TQJson.FormatParseErrorEx(ACode: Integer; AMsg: QStringW; begin ErrorLine; end; - Result := EJsonError.Create(Format(SJsonParseError, - [ARow, ACol, AMsg, ALine])); + Result := EJsonError.Create(Format(SJsonParseError, [ARow, ACol, AMsg, ALine])); Result.FRow := ARow; Result.FCol := ACol; end @@ -3387,58 +3293,44 @@ procedure TQJson.FromRtti(ASource: Pointer; AType: PTypeInfo); // Ǵӽṹ壬¼ԱǶֻ¼乫ԣ⴦TStringsTCollection case AFields[J].FieldType.TypeKind of tkInteger: - Add(AFields[J].Name).AsInteger := AFields[J].GetValue(ASource) - .AsInteger; + Add(AFields[J].Name).AsInteger := AFields[J].GetValue(ASource).AsInteger; {$IFNDEF NEXTGEN}tkString, tkLString, tkWString, {$ENDIF !NEXTGEN}tkUString: - Add(AFields[J].Name).AsString := - AFields[J].GetValue(ASource).AsString; + Add(AFields[J].Name).AsString := AFields[J].GetValue(ASource).AsString; tkEnumeration: begin - if GetTypeData(AFields[J].FieldType.Handle) - .BaseType^ = TypeInfo(Boolean) then - Add(AFields[J].Name).AsBoolean := AFields[J].GetValue(ASource) - .AsBoolean + if GetTypeData(AFields[J].FieldType.Handle).BaseType^ = TypeInfo(Boolean) then + Add(AFields[J].Name).AsBoolean := AFields[J].GetValue(ASource).AsBoolean else if JsonRttiEnumAsInt then - Add(AFields[J].Name).AsInteger := AFields[J].GetValue(ASource) - .AsOrdinal + Add(AFields[J].Name).AsInteger := AFields[J].GetValue(ASource).AsOrdinal else - Add(AFields[J].Name).AsString := - AFields[J].GetValue(ASource).ToString; + Add(AFields[J].Name).AsString := AFields[J].GetValue(ASource).ToString; end; tkSet: begin if JsonRttiEnumAsInt then - Add(AFields[J].Name).AsInt64 := - SetAsOrd(AFields[J].GetValue(ASource)) + Add(AFields[J].Name).AsInt64 := SetAsOrd(AFields[J].GetValue(ASource)) else - Add(AFields[J].Name).AsString := - AFields[J].GetValue(ASource).ToString; + Add(AFields[J].Name).AsString := AFields[J].GetValue(ASource).ToString; end; tkChar, tkWChar: - Add(AFields[J].Name).AsString := - AFields[J].GetValue(ASource).ToString; + Add(AFields[J].Name).AsString := AFields[J].GetValue(ASource).ToString; tkFloat: begin - if (AFields[J].FieldType.Handle = TypeInfo(TDateTime)) or - (AFields[J].FieldType.Handle = TypeInfo(TTime)) or + if (AFields[J].FieldType.Handle = TypeInfo(TDateTime)) or (AFields[J].FieldType.Handle = TypeInfo(TTime)) or (AFields[J].FieldType.Handle = TypeInfo(TDate)) then begin // жһֵǷһЧֵ - Add(AFields[J].Name).AsDateTime := AFields[J].GetValue(ASource) - .AsExtended + Add(AFields[J].Name).AsDateTime := AFields[J].GetValue(ASource).AsExtended end else - Add(AFields[J].Name).AsFloat := AFields[J].GetValue(ASource) - .AsExtended; + Add(AFields[J].Name).AsFloat := AFields[J].GetValue(ASource).AsExtended; end; tkInt64: - Add(AFields[J].Name).AsInt64 := - AFields[J].GetValue(ASource).AsInt64; + Add(AFields[J].Name).AsInt64 := AFields[J].GetValue(ASource).AsInt64; tkVariant: - Add(AFields[J].Name).AsVariant := AFields[J].GetValue(ASource) - .AsVariant; + Add(AFields[J].Name).AsVariant := AFields[J].GetValue(ASource).AsVariant; tkArray, tkDynArray: begin with Add(AFields[J].Name, jdtArray) do @@ -3459,20 +3351,15 @@ procedure TQJson.FromRtti(ASource: Pointer; AType: PTypeInfo); else if AObj is TCollection then AddCollection(AddArray(AFields[J].Name), AObj as TCollection) else // ͵Ķ󲻱 - Add(AFields[J].Name, jdtObject) - .FromRtti(AObj, AFields[J].FieldType.Handle); + Add(AFields[J].Name, jdtObject).FromRtti(AObj, AFields[J].FieldType.Handle); end; tkRecord: begin DataType := jdtObject; if AFields[J].FieldType.Handle = TypeInfo(TGuid) then - Add(AFields[J].Name).AsString := - GUIDToString - (PGuid(Pointer(IntPtr(ASource) + AFields[J].Offset))^) + Add(AFields[J].Name).AsString := GUIDToString(PGuid(Pointer(IntPtr(ASource) + AFields[J].Offset))^) else - Add(AFields[J].Name) - .FromRtti(Pointer(IntPtr(ASource) + AFields[J].Offset), - AFields[J].FieldType.Handle); + Add(AFields[J].Name).FromRtti(Pointer(IntPtr(ASource) + AFields[J].Offset), AFields[J].FieldType.Handle); end; end; end @@ -3504,9 +3391,8 @@ procedure TQJson.FromRtti(ASource: Pointer; AType: PTypeInfo); try for J := 0 to ACount - 1 do begin - if Assigned(APropList[J].GetProc) and Assigned(APropList[J].SetProc) - and (not(APropList[J].PropType^.Kind in [tkMethod, tkInterface, - tkClassRef, tkPointer, tkProcedure])) then + if Assigned(APropList[J].GetProc) and Assigned(APropList[J].SetProc) and + (not(APropList[J].PropType^.Kind in [tkMethod, tkInterface, tkClassRef, tkPointer, tkProcedure])) then begin {$IF RTLVersion>25} AName := APropList[J].NameFld.ToString; @@ -3530,8 +3416,7 @@ procedure TQJson.FromRtti(ASource: Pointer; AType: PTypeInfo); Add(AName).AsInt64 := GetOrdProp(AObj, APropList[J]); tkFloat: begin - if (APropList[J].PropType^ = TypeInfo(TDateTime)) or - (APropList[J].PropType^ = TypeInfo(TTime)) or + if (APropList[J].PropType^ = TypeInfo(TDateTime)) or (APropList[J].PropType^ = TypeInfo(TTime)) or (APropList[J].PropType^ = TypeInfo(TDate)) then begin // жһֵǷһЧֵ @@ -3544,8 +3429,7 @@ procedure TQJson.FromRtti(ASource: Pointer; AType: PTypeInfo); Add(AName).AsString := GetStrProp(AObj, APropList[J]); tkEnumeration: begin - if GetTypeData(APropList[J]^.PropType^) - ^.BaseType^ = TypeInfo(Boolean) then + if GetTypeData(APropList[J]^.PropType^)^.BaseType^ = TypeInfo(Boolean) then Add(AName).AsBoolean := GetOrdProp(AObj, APropList[J]) <> 0 else if JsonRttiEnumAsInt then Add(AName).AsInteger := GetOrdProp(AObj, APropList[J]) @@ -3657,11 +3541,22 @@ function TQJson.GetAsBase64Bytes: TBytes; Result := InternalGetAsBytes(DoDecodeAsBase64, teUtf8, False); end; +function TQJson.GetAsBcd: TBcd; +begin + if DataType = jdtBcd then + Result := PBcd(FValue)^ + else if DataType = jdtString then + Result := StrToBcd(FValue) + else if DataType = jdtFloat then + Result := AsFloat + else + Result := AsInt64 +end; + function TQJson.GetAsBoolean: Boolean; begin if not TryGetAsBoolean(Result) then - raise Exception.Create(Format(SBadConvert, [JsonTypeName[DataType], - 'Boolean'])); + raise Exception.Create(Format(SBadConvert, [JsonTypeName[DataType], 'Boolean'])); end; function TQJson.GetAsBytes: TBytes; @@ -3675,15 +3570,13 @@ function TQJson.GetAsBytes: TBytes; function TQJson.GetAsDateTime: TDateTime; begin if not TryGetAsDateTime(Result) then - raise Exception.Create(Format(SBadConvert, [JsonTypeName[DataType], - 'DateTime'])); + raise Exception.Create(Format(SBadConvert, [JsonTypeName[DataType], 'DateTime'])); end; function TQJson.GetAsFloat: Extended; begin if not TryGetAsFloat(Result) then - raise Exception.Create(Format(SBadConvert, [JsonTypeName[DataType], - 'Numeric'])) + raise Exception.Create(Format(SBadConvert, [JsonTypeName[DataType], 'Numeric'])) end; function TQJson.GetAsHexBytes: TBytes; @@ -3694,8 +3587,7 @@ function TQJson.GetAsHexBytes: TBytes; function TQJson.GetAsInt64: Int64; begin if not TryGetAsInt64(Result) then - raise Exception.Create(Format(SBadConvert, [JsonTypeName[DataType], - 'Numeric'])) + raise Exception.Create(Format(SBadConvert, [JsonTypeName[DataType], 'Numeric'])) end; function TQJson.GetAsInteger: Integer; @@ -3808,8 +3700,7 @@ function TQJson.GetIsDateTime: Boolean; if not Result then begin if DataType = jdtString then - Result := ParseDateTime(PQCharW(FValue), ATime) or - ParseJsonTime(PQCharW(FValue), ATime) or + Result := ParseDateTime(PQCharW(FValue), ATime) or ParseJsonTime(PQCharW(FValue), ATime) or ParseWebTime(PQCharW(FValue), ATime); end; end; @@ -3967,6 +3858,8 @@ function TQJson.GetValue: QStringW; Result := IntToStr(PInt64(FValue)^); jdtFloat: Result := FloatToStr(PExtended(FValue)^); + jdtBcd: + Result := BcdToStr(PBcd(FValue)^); jdtDateTime: ValueAsDateTime; jdtBoolean: @@ -4042,8 +3935,7 @@ function TQJson.IndexOfValue(const AValue: Variant; AStrict: Boolean): Integer; var T: TDateTime; begin - if ParseDateTime(PWideChar(S), T) or ParseJsonTime(PWideChar(S), T) or - ParseWebTime(PQCharW(FValue), T) then + if ParseDateTime(PWideChar(S), T) or ParseJsonTime(PWideChar(S), T) or ParseWebTime(PQCharW(FValue), T) then Result := SameValue(T, V) else Result := False; @@ -4066,8 +3958,7 @@ function TQJson.IndexOfValue(const AValue: Variant; AStrict: Boolean): Integer; if VarIsArray(V) then begin Result := (ANode.DataType in [jdtObject, jdtArray]) and - (ANode.Count = VarArrayHighBound(V, VarArrayDimCount(V)) - - VarArrayLowBound(V, VarArrayDimCount(V)) + 1); + (ANode.Count = VarArrayHighBound(V, VarArrayDimCount(V)) - VarArrayLowBound(V, VarArrayDimCount(V)) + 1); if Result then begin for J := 0 to ANode.Count - 1 do @@ -4088,8 +3979,7 @@ function TQJson.IndexOfValue(const AValue: Variant; AStrict: Boolean): Integer; case VarType(V) of varEmpty, varNull, varUnknown: Result := ANode.IsNull; - varSmallInt, varInteger, varByte, varShortInt, varWord, varLongWord, - varInt64{$IF RtlVersion>=26} + varSmallInt, varInteger, varByte, varShortInt, varWord, varLongWord, varInt64{$IF RtlVersion>=26} , varUInt64{$IFEND}: begin if ANode.DataType <> jdtString then @@ -4150,15 +4040,13 @@ function TQJson.IndexOfValue(const AValue: Variant; AStrict: Boolean): Integer; end; end; -function TQJson.Insert(AIndex: Integer; const AName, AValue: String; - ADataType: TQJsonDataType): TQJson; +function TQJson.Insert(AIndex: Integer; const AName, AValue: String; ADataType: TQJsonDataType): TQJson; begin Result := Insert(AIndex, AName); Result.FromType(AValue, ADataType); end; -function TQJson.Insert(AIndex: Integer; const AName: String; - ADataType: TQJsonDataType): TQJson; +function TQJson.Insert(AIndex: Integer; const AName: String; ADataType: TQJsonDataType): TQJson; begin Result := CreateJson; Insert(AIndex, Result); @@ -4171,8 +4059,7 @@ function TQJson.Insert(AIndex: Integer; const AName: String): TQJson; Result := Insert(AIndex, AName, jdtUnknown); end; -function TQJson.Insert(AIndex: Integer; const AName: String; - AValue: Extended): TQJson; +function TQJson.Insert(AIndex: Integer; const AName: String; AValue: Extended): TQJson; begin Result := Insert(AIndex, AName); Result.AsFloat := AValue; @@ -4197,15 +4084,13 @@ procedure TQJson.Insert(AIndex: Integer; AChild: TQJson); FItems.Insert(AIndex, AChild); end; -function TQJson.Insert(AIndex: Integer; const AName: String; - AValue: Boolean): TQJson; +function TQJson.Insert(AIndex: Integer; const AName: String; AValue: Boolean): TQJson; begin Result := Insert(AIndex, AName); Result.AsBoolean := AValue; end; -function TQJson.Insert(AIndex: Integer; const AName: String; - AValue: Int64): TQJson; +function TQJson.Insert(AIndex: Integer; const AName: String; AValue: Int64): TQJson; begin Result := Insert(AIndex, AName); Result.AsInt64 := AValue; @@ -4239,8 +4124,8 @@ function TQJson.IntByPath(APath: QStringW; ADefVal: Int64): Int64; Result := ADefVal; end; -function TQJson.InternalEncode(ABuilder: TQStringCatHelperW; - ASettings: TJsonEncodeSettings; const AIndent: QStringW): TQStringCatHelperW; +function TQJson.InternalEncode(ABuilder: TQStringCatHelperW; ASettings: TJsonEncodeSettings; const AIndent: QStringW) + : TQStringCatHelperW; procedure StrictJsonTime(ATime: TDateTime); var MS: Int64; // ʱϢ @@ -4316,12 +4201,9 @@ function TQJson.InternalEncode(ABuilder: TQStringCatHelperW; AChild: TQJson; begin if (jesWithComment in ASettings) and (Length(ANode.Comment) > 0) and - ((ANode.CommentStyle = jcsBeforeName) or - ((ANode.CommentStyle = jcsInherited) and (CommentStyle = jcsBeforeName))) - then + ((ANode.CommentStyle = jcsBeforeName) or ((ANode.CommentStyle = jcsInherited) and (CommentStyle = jcsBeforeName))) then AddComment(ANode.Comment); - if (ANode.Parent <> nil) and (ANode.Parent.DataType <> jdtArray) and - (ANode <> Self) then + if (ANode.Parent <> nil) and (ANode.Parent.DataType <> jdtArray) and (ANode <> Self) then begin if jesDoFormat in ASettings then ABuilder.Replicate(AIndent, ALevel); @@ -4426,9 +4308,7 @@ function TQJson.InternalEncode(ABuilder: TQStringCatHelperW; end; end; if (jesWithComment in ASettings) and (Length(ANode.Comment) > 0) and - ((ANode.CommentStyle = jcsAfterValue) or - ((ANode.CommentStyle = jcsInherited) and (CommentStyle = jcsAfterValue))) - then + ((ANode.CommentStyle = jcsAfterValue) or ((ANode.CommentStyle = jcsInherited) and (CommentStyle = jcsAfterValue))) then begin AddComment(ANode.Comment); if jesDoFormat in ASettings then @@ -4442,8 +4322,7 @@ function TQJson.InternalEncode(ABuilder: TQStringCatHelperW; DoEncode(Self, 0); end; -function TQJson.InternalGetAsBytes(AConverter: TQJsonDecodeBytesEvent; - AEncoding: TTextEncoding; AWriteBom: Boolean): TBytes; +function TQJson.InternalGetAsBytes(AConverter: TQJsonDecodeBytesEvent; AEncoding: TTextEncoding; AWriteBom: Boolean): TBytes; var I: Integer; AItem: TQJson; @@ -4523,8 +4402,7 @@ function TQJson.InternalGetAsBytes(AConverter: TQJsonDecodeBytesEvent; for I := 0 to Count - 1 do begin AItem := Items[I]; - if (AItem.DataType = jdtInteger) and (AItem.AsInteger >= 0) and - (AItem.AsInteger <= 255) then + if (AItem.DataType = jdtInteger) and (AItem.AsInteger >= 0) and (AItem.AsInteger <= 255) then Result[I] := AItem.AsInteger else raise Exception.CreateFmt(SConvertError, ['jdtArray', 'Bytes']); @@ -4534,9 +4412,8 @@ function TQJson.InternalGetAsBytes(AConverter: TQJsonDecodeBytesEvent; raise Exception.CreateFmt(SConvertError, [JsonTypeName[DataType], 'Bytes']); end; -procedure TQJson.InternalRttiFilter(ASender: TQJson; AObject: Pointer; - APropName: QStringW; APropType: PTypeInfo; var Accept: Boolean; - ATag: Pointer); +procedure TQJson.InternalRttiFilter(ASender: TQJson; AObject: Pointer; APropName: QStringW; APropType: PTypeInfo; + var Accept: Boolean; ATag: Pointer); var ATagData: PQJsonInternalTagData; procedure DoNameFilter; @@ -4547,8 +4424,7 @@ procedure TQJson.InternalRttiFilter(ASender: TQJson; AObject: Pointer; begin Accept := False; ps := StrIStrW(PQCharW(ATagData.AcceptNames), PQCharW(APropName)); - if (ps <> nil) and ((ps = PQCharW(ATagData.AcceptNames)) or (ps[-1] = ',') - or (ps[-1] = ';')) then + if (ps <> nil) and ((ps = PQCharW(ATagData.AcceptNames)) or (ps[-1] = ',') or (ps[-1] = ';')) then begin ps := ps + Length(APropName); Accept := (ps^ = ',') or (ps^ = ';') or (ps^ = #0); @@ -4558,8 +4434,7 @@ procedure TQJson.InternalRttiFilter(ASender: TQJson; AObject: Pointer; begin ps := StrIStrW(PQCharW(ATagData.IgnoreNames), PQCharW(APropName)); Accept := True; - if (ps <> nil) and ((ps = PQCharW(ATagData.IgnoreNames)) or (ps[-1] = ',') - or (ps[-1] = ';')) then + if (ps <> nil) and ((ps = PQCharW(ATagData.IgnoreNames)) or (ps[-1] = ',') or (ps[-1] = ';')) then begin ps := ps + Length(APropName); Accept := not((ps^ = ',') or (ps^ = ';') or (ps^ = #0)); @@ -4577,14 +4452,12 @@ procedure TQJson.InternalRttiFilter(ASender: TQJson; AObject: Pointer; {$IF RTLVersion>=21} if ATagData.TagType = ttAnonEvent then begin - ATagData.OnEvent(ASender, AObject, APropName, APropType, Accept, - ATagData.Tag); + ATagData.OnEvent(ASender, AObject, APropName, APropType, Accept, ATagData.Tag); end; {$IFEND >=2010} end; -procedure TQJson.InternalSetAsBytes(AConverter: TQJsonEncodeBytesEvent; - ABytes: TBytes); +procedure TQJson.InternalSetAsBytes(AConverter: TQJsonEncodeBytesEvent; ABytes: TBytes); var S: QStringW; begin @@ -4608,8 +4481,7 @@ function TQJson.Intersect(AJson: TQJson): TQJson; for J := 0 to H2 do begin AItem2 := AJson[J]; - if (AItem1.Name = AItem2.Name) and (AItem1.DataType = AItem2.DataType) - then + if (AItem1.Name = AItem2.Name) and (AItem1.DataType = AItem2.DataType) then begin if AItem1.DataType in [jdtArray, jdtObject] then begin @@ -4693,8 +4565,7 @@ function TQJson.ItemByName(AName: QStringW): TQJson; end; end; -function TQJson.ItemByName(const AName: QStringW; AList: TQJsonItemList; - ANest: Boolean): Integer; +function TQJson.ItemByName(const AName: QStringW; AList: TQJsonItemList; ANest: Boolean): Integer; var AHash: Cardinal; l: Integer; @@ -4752,8 +4623,7 @@ function TQJson.ItemByPath(APath: QStringW): TQJson; Result := nil; while Assigned(AParent) and (p^ <> #0) do begin - AName := JavaUnescape(DecodeTokenW(p, PathDelimiters, WideChar(0), - False), False); + AName := JavaUnescape(DecodeTokenW(p, PathDelimiters, WideChar(0), False), False); if Length(AName) > 0 then begin // ҵ飿 @@ -4768,8 +4638,7 @@ function TQJson.ItemByPath(APath: QStringW): TQJson; else begin SkipUntilW(ws, ArrayStart); - Result := AParent.ItemByName - (StrDupX(pn, (IntPtr(ws) - IntPtr(pn)) shr 1)); + Result := AParent.ItemByName(StrDupX(pn, (IntPtr(ws) - IntPtr(pn)) shr 1)); end; if Result <> nil then begin @@ -4823,8 +4692,7 @@ function TQJson.ItemByPath(APath: QStringW): TQJson; end; {$IFDEF ENABLE_REGEX} -function TQJson.ItemByRegex(const ARegex: QStringW; AList: TQJsonItemList; - ANest: Boolean): Integer; +function TQJson.ItemByRegex(const ARegex: QStringW; AList: TQJsonItemList; ANest: Boolean): Integer; var ANode: TQJson; APcre: TPerlRegEx; @@ -4871,8 +4739,7 @@ function TQJson.ItemByRegex(const ARegex: QStringW; AList: TQJsonItemList; end; end; -function TQJson.Match(const ARegex: QStringW; AMatches: TQJsonMatchSettings) - : IQJsonContainer; +function TQJson.Match(const ARegex: QStringW; AMatches: TQJsonMatchSettings): IQJsonContainer; var T: TQJsonContainer; begin @@ -4899,8 +4766,7 @@ class function TQJson.JsonCat(const S: QStringW; ADoEscape: Boolean): QStringW; end; end; -class function TQJson.JsonEscape(const S: QStringW; ADoEscape: Boolean) - : QStringW; +class function TQJson.JsonEscape(const S: QStringW; ADoEscape: Boolean): QStringW; begin Result := JsonCat(S, ADoEscape); end; @@ -4910,8 +4776,7 @@ class function TQJson.JsonUnescape(const S: QStringW): QStringW; Result := BuildJsonString(S); end; -procedure TQJson.LoadFromFile(const AFileName: String; - AEncoding: TTextEncoding); +procedure TQJson.LoadFromFile(const AFileName: String; AEncoding: TTextEncoding); var AStream: TFileStream; begin @@ -4996,10 +4861,7 @@ procedure TQJson.MoveTo(ANewParent: TQJson; AIndex: Integer); else begin if Parent = ANewParent then - begin - Parent.FItems.Move(ItemIndex,AIndex); Exit; - end; if IsParentOf(ANewParent) then raise Exception.Create(SCantMoveToChild); if ANewParent.DataType in [jdtArray, jdtObject] then @@ -5175,8 +5037,7 @@ procedure TQJson.ParseBlock(AStream: TStream; AEncoding: TTextEncoding); end; end; -function TQJson.ParseJsonPair(ABuilder: TQStringCatHelperW; - var p: PQCharW): Integer; +function TQJson.ParseJsonPair(ABuilder: TQStringCatHelperW; var p: PQCharW): Integer; const SpaceWithSemicolon: PWideChar = ': '#9#10#13#$3000; CommaWithSpace: PWideChar = ', '#9#10#13#$3000; @@ -5316,8 +5177,7 @@ function TQJson.ParseJsonTime(p: PQCharW; var ATime: TDateTime): Boolean; end; end; -function TQJson.ParseName(ABuilder: TQStringCatHelperW; var p: PQCharW) - : Integer; +function TQJson.ParseName(ABuilder: TQStringCatHelperW; var p: PQCharW): Integer; var AInQuoter: Boolean; AComment: QStringW; @@ -5504,8 +5364,7 @@ procedure TQJson.RevertOrder(ANest: Boolean); end; end; -procedure TQJson.SaveToFile(const AFileName: String; AEncoding: TTextEncoding; - AWriteBom, ADoFormat: Boolean); +procedure TQJson.SaveToFile(const AFileName: String; AEncoding: TTextEncoding; AWriteBom, ADoFormat: Boolean); var AStream: TMemoryStream; begin @@ -5518,8 +5377,7 @@ procedure TQJson.SaveToFile(const AFileName: String; AEncoding: TTextEncoding; end; end; -procedure TQJson.SaveToStream(AStream: TStream; AEncoding: TTextEncoding; - AWriteBom, ADoFormat: Boolean); +procedure TQJson.SaveToStream(AStream: TStream; AEncoding: TTextEncoding; AWriteBom, ADoFormat: Boolean); var S: QStringW; begin @@ -5572,6 +5430,12 @@ procedure TQJson.SetAsBase64Bytes(const Value: TBytes); InternalSetAsBytes(DoEncodeAsBase64, Value); end; +procedure TQJson.SetAsBcd(const Value: TBcd); +begin + DataType := jdtBcd; + PBcd(FValue)^ := Value; +end; + procedure TQJson.SetAsBoolean(const Value: Boolean); begin DataType := jdtBoolean; @@ -5680,8 +5544,7 @@ procedure TQJson.SetAsVariant(const Value: Variant); begin ArrayNeeded(jdtArray); Clear; - for I := VarArrayLowBound(Value, VarArrayDimCount(Value)) - to VarArrayHighBound(Value, VarArrayDimCount(Value)) do + for I := VarArrayLowBound(Value, VarArrayDimCount(Value)) to VarArrayHighBound(Value, VarArrayDimCount(Value)) do Add.AsVariant := Value[I]; end else @@ -5690,8 +5553,7 @@ procedure TQJson.SetAsVariant(const Value: Variant); case AType of varEmpty, varNull, varUnknown: ResetNull; - varSmallInt, varInteger, varByte, varShortInt, varWord, - varLongWord, varInt64: + varSmallInt, varInteger, varByte, varShortInt, varWord, varLongWord, varInt64: AsInt64 := Value; varSingle, varDouble, varCurrency: AsFloat := Value; @@ -5743,6 +5605,11 @@ procedure TQJson.SetDataType(const Value: TQJsonDataType); SetLength(FValue, SizeOf(Extended) shr 1); PExtended(FValue)^ := 0; end; + jdtBcd: + begin + SetLength(FValue, SizeOf(TBcd) shr 1); + PBcd(FValue)^ := 0; + end; jdtBoolean: begin SetLength(FValue, 1); @@ -5888,8 +5755,7 @@ procedure TQJson.SetValue(const Value: QStringW); end; end; -class function TQJson.SkipSpaceAndComment(var p: PQCharW; - var AComment: QStringW; lastvalidchar: QCharW = #0): Integer; +class function TQJson.SkipSpaceAndComment(var p: PQCharW; var AComment: QStringW; lastvalidchar: QCharW = #0): Integer; var ps: PQCharW; begin @@ -5919,8 +5785,7 @@ class function TQJson.SkipSpaceAndComment(var p: PQCharW; begin if (p[0] = '*') and (p[1] = '/') then begin - AComment := AComment + StrDupX(ps, (IntPtr(p) - IntPtr(ps)) shr 1) + - SLineBreak; + AComment := AComment + StrDupX(ps, (IntPtr(p) - IntPtr(ps)) shr 1) + SLineBreak; Inc(p, 2); SkipSpaceW(p); Break; @@ -5936,8 +5801,7 @@ class function TQJson.SkipSpaceAndComment(var p: PQCharW; end; end; end - else if ((p^ = CharObjectEnd) or (p^ = CharArrayEnd)) and - (lastvalidchar = CharComma) then + else if ((p^ = CharObjectEnd) or (p^ = CharArrayEnd)) and (lastvalidchar = CharComma) then begin Result := EParse_EndCharNeeded; Exit; @@ -5946,8 +5810,7 @@ class function TQJson.SkipSpaceAndComment(var p: PQCharW; SetLength(AComment, Length(AComment) - Length(SLineBreak)); end; -procedure TQJson.Sort(AByName, ANest: Boolean; AByType: TQJsonDataType; - AOnCompare: TListSortCompareEvent); +procedure TQJson.Sort(AByName, ANest: Boolean; AByType: TQJsonDataType; AOnCompare: TListSortCompareEvent); function DoCompare(Item1, Item2: Pointer): Integer; var AMethod: TMethod absolute AOnCompare; @@ -6092,8 +5955,7 @@ procedure TQJson.Sort(AByName, ANest: Boolean; AByType: TQJsonDataType; end; end; -procedure TQJson.Sort(AByName, ANest: Boolean; AByType: TQJsonDataType; - AOnCompare: TListSortCompare); +procedure TQJson.Sort(AByName, ANest: Boolean; AByType: TQJsonDataType; AOnCompare: TListSortCompare); var AEvent: TListSortCompareEvent; AMethod: TMethod absolute AEvent; @@ -6104,8 +5966,7 @@ procedure TQJson.Sort(AByName, ANest: Boolean; AByType: TQJsonDataType; end; {$IF RTLVersion>=21)} -procedure TQJson.Sort(AByName, ANest: Boolean; AByType: TQJsonDataType; - AOnCompare: TListSortCompareFunc); +procedure TQJson.Sort(AByName, ANest: Boolean; AByType: TQJsonDataType; AOnCompare: TListSortCompareFunc); var AEvent: TListSortCompareEvent; AMethod: TMethod absolute AEvent; @@ -6184,8 +6045,7 @@ function TQJson.Invoke(AInstance: TValue): TValue; begin if AParamItem.IsObject then // Ϣ begin - if AParamItem.HasChild('Type', AItemType) and - AParamItem.HasChild('Value', AItemValue) then + if AParamItem.HasChild('Type', AItemType) and AParamItem.HasChild('Value', AItemValue) then begin case TTypeKind(AItemType.AsInteger) of tkInteger: @@ -6249,14 +6109,12 @@ procedure TQJson.ToRtti(AInstance: TValue; AClearCollections: Boolean); if AInstance.IsEmpty then Exit; if AInstance.Kind = tkRecord then - ToRtti(AInstance.GetReferenceToRawData, AInstance.TypeInfo, - AClearCollections) + ToRtti(AInstance.GetReferenceToRawData, AInstance.TypeInfo, AClearCollections) else if AInstance.Kind = tkClass then ToRtti(AInstance.AsObject, AInstance.TypeInfo, AClearCollections) end; -procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; - AClearCollections: Boolean); +procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; AClearCollections: Boolean); procedure LoadCollection(AJson: TQJson; ACollection: TCollection); var @@ -6293,15 +6151,13 @@ procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; AFields[J].SetValue(ABaseAddr, AChild.AsInteger); {$IFNDEF NEXTGEN} tkString: - PShortString(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - ShortString(AChild.AsString); + PShortString(IntPtr(ABaseAddr) + AFields[J].Offset)^ := ShortString(AChild.AsString); {$ENDIF !NEXTGEN} tkUString{$IFNDEF NEXTGEN}, tkLString, tkWString{$ENDIF !NEXTGEN}: AFields[J].SetValue(ABaseAddr, AChild.AsString); tkEnumeration: begin - if GetTypeData(AFields[J].FieldType.Handle) - ^.BaseType^ = TypeInfo(Boolean) then + if GetTypeData(AFields[J].FieldType.Handle)^.BaseType^ = TypeInfo(Boolean) then AFields[J].SetValue(ABaseAddr, AChild.AsBoolean) else begin @@ -6309,62 +6165,50 @@ procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; otSByte: begin if AChild.DataType = jdtInteger then - PShortint(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - AChild.AsInteger + PShortint(IntPtr(ABaseAddr) + AFields[J].Offset)^ := AChild.AsInteger else PShortint(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - GetEnumValue(AFields[J].FieldType.Handle, - AChild.AsString); + GetEnumValue(AFields[J].FieldType.Handle, AChild.AsString); end; otUByte: begin if AChild.DataType = jdtInteger then - PByte(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - AChild.AsInteger + PByte(IntPtr(ABaseAddr) + AFields[J].Offset)^ := AChild.AsInteger else PByte(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - GetEnumValue(AFields[J].FieldType.Handle, - AChild.AsString); + GetEnumValue(AFields[J].FieldType.Handle, AChild.AsString); end; otSWord: begin if AChild.DataType = jdtInteger then - PSmallint(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - AChild.AsInteger + PSmallint(IntPtr(ABaseAddr) + AFields[J].Offset)^ := AChild.AsInteger else PSmallint(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - GetEnumValue(AFields[J].FieldType.Handle, - AChild.AsString); + GetEnumValue(AFields[J].FieldType.Handle, AChild.AsString); end; otUWord: begin if AChild.DataType = jdtInteger then - PWord(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - AChild.AsInteger + PWord(IntPtr(ABaseAddr) + AFields[J].Offset)^ := AChild.AsInteger else PWord(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - GetEnumValue(AFields[J].FieldType.Handle, - AChild.AsString); + GetEnumValue(AFields[J].FieldType.Handle, AChild.AsString); end; otSLong: begin if AChild.DataType = jdtInteger then - PInteger(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - AChild.AsInteger + PInteger(IntPtr(ABaseAddr) + AFields[J].Offset)^ := AChild.AsInteger else PInteger(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - GetEnumValue(AFields[J].FieldType.Handle, - AChild.AsString); + GetEnumValue(AFields[J].FieldType.Handle, AChild.AsString); end; otULong: begin if AChild.DataType = jdtInteger then - PCardinal(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - AChild.AsInteger + PCardinal(IntPtr(ABaseAddr) + AFields[J].Offset)^ := AChild.AsInteger else PCardinal(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - GetEnumValue(AFields[J].FieldType.Handle, - AChild.AsString); + GetEnumValue(AFields[J].FieldType.Handle, AChild.AsString); end; end; end; @@ -6375,70 +6219,57 @@ procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; otSByte: begin if AChild.DataType = jdtInteger then - PShortint(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - AChild.AsInteger + PShortint(IntPtr(ABaseAddr) + AFields[J].Offset)^ := AChild.AsInteger else PShortint(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - StringToSet(AFields[J].FieldType.Handle, - AChild.AsString); + StringToSet(AFields[J].FieldType.Handle, AChild.AsString); end; otUByte: begin if AChild.DataType = jdtInteger then - PByte(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - AChild.AsInteger + PByte(IntPtr(ABaseAddr) + AFields[J].Offset)^ := AChild.AsInteger else PByte(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - StringToSet(AFields[J].FieldType.Handle, - AChild.AsString); + StringToSet(AFields[J].FieldType.Handle, AChild.AsString); end; otSWord: begin if AChild.DataType = jdtInteger then - PSmallint(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - AChild.AsInteger + PSmallint(IntPtr(ABaseAddr) + AFields[J].Offset)^ := AChild.AsInteger else PSmallint(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - StringToSet(AFields[J].FieldType.Handle, - AChild.AsString); + StringToSet(AFields[J].FieldType.Handle, AChild.AsString); end; otUWord: begin if AChild.DataType = jdtInteger then - PWord(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - AChild.AsInteger + PWord(IntPtr(ABaseAddr) + AFields[J].Offset)^ := AChild.AsInteger else PWord(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - StringToSet(AFields[J].FieldType.Handle, - AChild.AsString); + StringToSet(AFields[J].FieldType.Handle, AChild.AsString); end; otSLong: begin if AChild.DataType = jdtInteger then - PInteger(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - AChild.AsInteger + PInteger(IntPtr(ABaseAddr) + AFields[J].Offset)^ := AChild.AsInteger else PInteger(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - StringToSet(AFields[J].FieldType.Handle, - AChild.AsString); + StringToSet(AFields[J].FieldType.Handle, AChild.AsString); end; otULong: begin if AChild.DataType = jdtInteger then - PCardinal(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - AChild.AsInteger + PCardinal(IntPtr(ABaseAddr) + AFields[J].Offset)^ := AChild.AsInteger else PCardinal(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - StringToSet(AFields[J].FieldType.Handle, - AChild.AsString); + StringToSet(AFields[J].FieldType.Handle, AChild.AsString); end; end; end; tkChar, tkWChar: AFields[J].SetValue(ABaseAddr, AChild.AsString); tkFloat: - if (AFields[J].FieldType.Handle = TypeInfo(TDateTime)) or - (AFields[J].FieldType.Handle = TypeInfo(TTime)) or + if (AFields[J].FieldType.Handle = TypeInfo(TDateTime)) or (AFields[J].FieldType.Handle = TypeInfo(TTime)) or (AFields[J].FieldType.Handle = TypeInfo(TDate)) then begin if AChild.IsDateTime then @@ -6451,49 +6282,37 @@ procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; begin case JsonIntToTimeStyle of tsDeny: - raise Exception.CreateFmt(SBadConvert, - [AChild.AsString, JsonTypeName[jdtDateTime]]); + raise Exception.CreateFmt(SBadConvert, [AChild.AsString, JsonTypeName[jdtDateTime]]); tsSecondsFrom1970: // Unix begin if (JsonTimezone >= -12) and (JsonTimezone <= 12) then - AFields[J].SetValue(ABaseAddr, - IncHour(UnixToDateTime(AChild.AsInt64), - JsonTimezone)) + AFields[J].SetValue(ABaseAddr, IncHour(UnixToDateTime(AChild.AsInt64), JsonTimezone)) else - AFields[J].SetValue(ABaseAddr, - UnixToDateTime(AChild.AsInt64)); + AFields[J].SetValue(ABaseAddr, UnixToDateTime(AChild.AsInt64)); end; tsSecondsFrom1899: begin if (JsonTimezone >= -12) and (JsonTimezone <= 12) then - AFields[J].SetValue(ABaseAddr, - IncHour(AChild.AsInt64 / 86400, JsonTimezone)) + AFields[J].SetValue(ABaseAddr, IncHour(AChild.AsInt64 / 86400, JsonTimezone)) else - AFields[J].SetValue(ABaseAddr, - AChild.AsInt64 / 86400); + AFields[J].SetValue(ABaseAddr, AChild.AsInt64 / 86400); end; tsMsFrom1970: begin if (JsonTimezone >= -12) and (JsonTimezone <= 12) then - AFields[J].SetValue(ABaseAddr, - IncHour(IncMilliSecond(UnixDateDelta, - AChild.AsInt64), JsonTimezone)) + AFields[J].SetValue(ABaseAddr, IncHour(IncMilliSecond(UnixDateDelta, AChild.AsInt64), JsonTimezone)) else - AFields[J].SetValue(ABaseAddr, - IncMilliSecond(UnixDateDelta, AChild.AsInt64)); + AFields[J].SetValue(ABaseAddr, IncMilliSecond(UnixDateDelta, AChild.AsInt64)); end; tsMsFrom1899: if (JsonTimezone >= -12) and (JsonTimezone <= 12) then - AFields[J].SetValue(ABaseAddr, - IncHour(AChild.AsInt64 / 86400000, JsonTimezone)) + AFields[J].SetValue(ABaseAddr, IncHour(AChild.AsInt64 / 86400000, JsonTimezone)) else - AFields[J].SetValue(ABaseAddr, - AChild.AsInt64 / 86400000); + AFields[J].SetValue(ABaseAddr, AChild.AsInt64 / 86400000); end; end else - raise Exception.CreateFmt(SBadConvert, - [AChild.AsString, JsonTypeName[AChild.DataType]]); + raise Exception.CreateFmt(SBadConvert, [AChild.AsString, JsonTypeName[AChild.DataType]]); end; end else @@ -6501,11 +6320,9 @@ procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; tkInt64: AFields[J].SetValue(ABaseAddr, AChild.AsInt64); tkVariant: - PVariant(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - AChild.AsVariant; + PVariant(IntPtr(ABaseAddr) + AFields[J].Offset)^ := AChild.AsVariant; tkArray, tkDynArray: - AChild.ToRtti(Pointer(IntPtr(ABaseAddr) + AFields[J].Offset), - AFields[J].FieldType.Handle); + AChild.ToRtti(Pointer(IntPtr(ABaseAddr) + AFields[J].Offset), AFields[J].FieldType.Handle); tkClass: begin AObj := AFields[J].GetValue(ABaseAddr).AsObject; @@ -6518,11 +6335,9 @@ procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; end; tkRecord: if AFields[J].FieldType.Handle = TypeInfo(TGuid) then - PGuid(IntPtr(ABaseAddr) + AFields[J].Offset)^ := - StringToGuid(AChild.AsString) + PGuid(IntPtr(ABaseAddr) + AFields[J].Offset)^ := StringToGuid(AChild.AsString) else - AChild.ToRtti(Pointer(IntPtr(ABaseAddr) + AFields[J].Offset), - AFields[J].FieldType.Handle); + AChild.ToRtti(Pointer(IntPtr(ABaseAddr) + AFields[J].Offset), AFields[J].FieldType.Handle); end; end; end; @@ -6566,8 +6381,7 @@ procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; tkRecord, tkArray, tkDynArray: // tkArray,tkDynArray͵û,tkRecord begin - AChild.ToRtti(Pointer(GetOrdProp(AObj, AProp)), - AProp.PropType^); + AChild.ToRtti(Pointer(GetOrdProp(AObj, AProp)), AProp.PropType^); end; tkInteger: begin @@ -6585,8 +6399,7 @@ procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; end; tkFloat: begin - if (AProp.PropType^ = TypeInfo(TDateTime)) or - (AProp.PropType^ = TypeInfo(TTime)) or + if (AProp.PropType^ = TypeInfo(TDateTime)) or (AProp.PropType^ = TypeInfo(TTime)) or (AProp.PropType^ = TypeInfo(TDate)) then SetFloatProp(AObj, AProp, AChild.AsDateTime) else @@ -6596,8 +6409,7 @@ procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; SetStrProp(AObj, AProp, AChild.AsString); tkEnumeration: begin - if GetTypeData(AProp.PropType^)^.BaseType^ = TypeInfo(Boolean) - then + if GetTypeData(AProp.PropType^)^.BaseType^ = TypeInfo(Boolean) then SetOrdProp(AObj, AProp, Integer(AChild.AsBoolean)) else if AChild.DataType = jdtInteger then SetOrdProp(AObj, AProp, AChild.AsInteger) @@ -6696,8 +6508,7 @@ procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; if AChild.DataType = jdtInteger then PShortint(pi)^ := AChild.AsInteger else - PShortint(pi)^ := GetEnumValue(ASubTypeInfo, - AChild.AsString); + PShortint(pi)^ := GetEnumValue(ASubTypeInfo, AChild.AsString); end; otUByte: begin @@ -6711,32 +6522,28 @@ procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; if AChild.DataType = jdtInteger then PSmallint(pi)^ := AChild.AsInteger else - PSmallint(pi)^ := GetEnumValue(ASubTypeInfo, - AChild.AsString); + PSmallint(pi)^ := GetEnumValue(ASubTypeInfo, AChild.AsString); end; otUWord: begin if AChild.DataType = jdtInteger then PWord(pi)^ := AChild.AsInteger else - PWord(pi)^ := GetEnumValue(ASubTypeInfo, - AChild.AsString); + PWord(pi)^ := GetEnumValue(ASubTypeInfo, AChild.AsString); end; otSLong: begin if AChild.DataType = jdtInteger then PInteger(pi)^ := AChild.AsInteger else - PInteger(pi)^ := GetEnumValue(ASubTypeInfo, - AChild.AsString); + PInteger(pi)^ := GetEnumValue(ASubTypeInfo, AChild.AsString); end; otULong: begin if AChild.DataType = jdtInteger then PCardinal(pi)^ := AChild.AsInteger else - PCardinal(pi)^ := GetEnumValue(ASubTypeInfo, - Items[I].AsString); + PCardinal(pi)^ := GetEnumValue(ASubTypeInfo, Items[I].AsString); end; end; end; @@ -6766,8 +6573,7 @@ procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; if AChild.DataType = jdtInteger then PShortint(pi)^ := AChild.AsInteger else - PShortint(pi)^ := StringToSet(ASubTypeInfo, - AChild.AsString); + PShortint(pi)^ := StringToSet(ASubTypeInfo, AChild.AsString); end; otUByte: begin @@ -6781,8 +6587,7 @@ procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; if AChild.DataType = jdtInteger then PSmallint(pi)^ := AChild.AsInteger else - PSmallint(pi)^ := StringToSet(ASubTypeInfo, - AChild.AsString); + PSmallint(pi)^ := StringToSet(ASubTypeInfo, AChild.AsString); end; otUWord: begin @@ -6796,16 +6601,14 @@ procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; if AChild.DataType = jdtInteger then PInteger(pi)^ := AChild.AsInteger else - PInteger(pi)^ := StringToSet(ASubTypeInfo, - AChild.AsString); + PInteger(pi)^ := StringToSet(ASubTypeInfo, AChild.AsString); end; otULong: begin if AChild.DataType = jdtInteger then PCardinal(pi)^ := AChild.AsInteger else - PCardinal(pi)^ := StringToSet(ASubTypeInfo, - Items[I].AsString); + PCardinal(pi)^ := StringToSet(ASubTypeInfo, Items[I].AsString); end; end; end; @@ -6943,8 +6746,7 @@ procedure TQJson.ToRtti(ADest: Pointer; AType: PTypeInfo; if AChild.DataType = jdtInteger then PCardinal(pi)^ := AChild.AsInteger else - PCardinal(pi)^ := - GetEnumValue(ASubType, Items[I].AsString); + PCardinal(pi)^ := GetEnumValue(ASubType, Items[I].AsString); end; end; end; @@ -7155,6 +6957,8 @@ function TQJson.TryGetAsBoolean(var AValue: Boolean): Boolean; AValue := not SameValue(AsFloat, 0, 5E-324) else if DataType = jdtInteger then AValue := AsInt64 <> 0 + else if DataType = jdtBcd then + AValue := AsBcd <> 0 else Result := False; end; @@ -7167,14 +6971,15 @@ function TQJson.TryGetAsDateTime(var AValue: TDateTime): Boolean; else if DataType = jdtString then begin if Length(FValue) > 0 then - Result := ParseDateTime(PWideChar(FValue), AValue) or - ParseJsonTime(PWideChar(FValue), AValue) or + Result := ParseDateTime(PWideChar(FValue), AValue) or ParseJsonTime(PWideChar(FValue), AValue) or ParseWebTime(PQCharW(FValue), AValue) else Result := False; end else if DataType = jdtInteger then AValue := AsInt64 + else if DataType=jdtBcd then + AValue:=BcdToDouble(AsBcd) else if DataType in [jdtNull, jdtUnknown] then AValue := 0 else @@ -7195,6 +7000,8 @@ function TQJson.TryGetAsFloat(var AValue: Extended): Boolean; Result := True; if DataType in [jdtFloat, jdtDateTime] then AValue := PExtended(FValue)^ + else if DataType = jdtBcd then + AValue := BcdToDouble(PBcd(FValue)^) else if DataType = jdtBoolean then AValue := Integer(AsBoolean) else if DataType = jdtString then @@ -7216,6 +7023,8 @@ function TQJson.TryGetAsInt64(var AValue: Int64): Boolean; AValue := PInt64(FValue)^ else if DataType in [jdtFloat, jdtDateTime] then AValue := Trunc(PExtended(FValue)^) + else if (DataType = jdtBcd) and (PBcd(FValue)^ >= MinInt64) and (PBcd(FValue)^ <= MaxInt64) then + AValue := StrToInt64(NameOfW(BcdToStr(PBcd(FValue)^), '.')) else if DataType = jdtBoolean then AValue := Integer(AsBoolean) else if DataType = jdtString then @@ -7235,16 +7044,37 @@ function TQJson.TryParse(const S: QStringW): Boolean; Result := TryParse(PQCharW(S), Length(S)); end; -function TQJson.TryParseValue(ABuilder: TQStringCatHelperW; - var p: PQCharW): Integer; +function TQJson.TryParseValue(ABuilder: TQStringCatHelperW; var p: PQCharW): Integer; var ANum: Extended; AComment: QStringW; AIsFloat: Boolean; const JsonEndChars: PWideChar = ',]}'; - MaxInt64: Int64 = 9223372036854775807; - MinInt64: Int64 = -9223372036854775808; + function ParseBcd: Boolean; + var + pl: PQCharW; + begin + pl := p; + if pl^ = '-' then + Inc(pl) + else if pl^ = '+' then + Inc(pl); + while pl^ <> #0 do + begin + if (pl^ >= '0') and (pl^ <= '9') then + Inc(pl) + else + Break; + end; + Result := CharInW(pl, JsonEndChars); + if Result then + begin + AsBcd := StrToBcd(StrDupX(p, pl - p)); + p := pl; + end; + end; + begin Result := 0; if p^ = '"' then @@ -7301,7 +7131,7 @@ function TQJson.TryParseValue(ABuilder: TQStringCatHelperW; end else if (p^ = '[') or (p^ = '{') then Result := ParseJsonPair(ABuilder, p) - else + else if not ParseBcd then Result := 2; end; @@ -7461,8 +7291,7 @@ procedure TQHashedJson.DoJsonNameChanged(AJson: TQJson); AItem := AList.Data; if AItem = AJson then begin - TQHashedJson(AJson.Parent).FHashTable.ChangeHash(AJson, - AJson.FNameHash, AHash); + TQHashedJson(AJson.Parent).FHashTable.ChangeHash(AJson, AJson.FNameHash, AHash); AJson.FNameHash := AHash; Break; end @@ -7625,8 +7454,7 @@ procedure TQJsonStreamHelper.BeginObject(const AName: QStringW); Push; end; -procedure TQJsonStreamHelper.BeginWrite(AStream: TStream; - AEncoding: TTextEncoding; ADoEscape, AWriteBom: Boolean); +procedure TQJsonStreamHelper.BeginWrite(AStream: TStream; AEncoding: TTextEncoding; ADoEscape, AWriteBom: Boolean); begin FStream := AStream; FEncoding := AEncoding; @@ -7684,8 +7512,7 @@ procedure TQJsonStreamHelper.EndWrite; const Utf16BEBom: Word = $FFFE; begin - ExchangeByteOrder(PQCharA(FStringHelper.Start), - FStringHelper.Position shl 1); + ExchangeByteOrder(PQCharA(FStringHelper.Start), FStringHelper.Position shl 1); if FWriteBom then FStream.Write(Utf16BEBom, 2); FStream.Write(FStringHelper.Start^, FStringHelper.Position shl 1); @@ -7710,8 +7537,7 @@ procedure TQJsonStreamHelper.EndWrite; FreeAndNil(FStringHelper); end; -procedure TQJsonStreamHelper.InternalWriteString(S: QStringW; - ADoAppend: Boolean); +procedure TQJsonStreamHelper.InternalWriteString(S: QStringW; ADoAppend: Boolean); begin FStringHelper.Cat(S); if ADoAppend then @@ -7882,8 +7708,7 @@ procedure TQJsonStreamHelper.Write(const AName, AValue: QStringW); Write(AValue); end; -procedure TQJsonStreamHelper.Write(const AName: QStringW; const p: PByte; - const l: Integer); +procedure TQJsonStreamHelper.Write(const AName: QStringW; const p: PByte; const l: Integer); begin WriteName(AName); Write(p, l); @@ -7901,8 +7726,7 @@ procedure TQJsonStreamHelper.Write(const AName: QStringW; AValue: TBytes); Write(AValue); end; -procedure TQJsonStreamHelper.WriteDateTime(const AName: QStringW; - AValue: TDateTime); +procedure TQJsonStreamHelper.WriteDateTime(const AName: QStringW; AValue: TDateTime); begin WriteName(AName); WriteDateTime(AValue); @@ -7910,8 +7734,7 @@ procedure TQJsonStreamHelper.WriteDateTime(const AName: QStringW; { TQJsonContainer } -function TQJsonContainer.ForEach(ACallback: TQJsonForEachCallback; - ATag: Pointer): IQJsonContainer; +function TQJsonContainer.ForEach(ACallback: TQJsonForEachCallback; ATag: Pointer): IQJsonContainer; var I: Integer; begin @@ -7944,8 +7767,7 @@ destructor TQJsonContainer.Destroy; end; {$IFDEF UNICODE} -function TQJsonContainer.ForEach(ACallback: TQJsonForEachCallbackA) - : IQJsonContainer; +function TQJsonContainer.ForEach(ACallback: TQJsonForEachCallbackA): IQJsonContainer; var I: Integer; begin @@ -7957,8 +7779,7 @@ function TQJsonContainer.ForEach(ACallback: TQJsonForEachCallbackA) end; end; -function TQJsonContainer.Match(const AFilter: TQJsonMatchFilterCallbackA; - ATag: Pointer): IQJsonContainer; +function TQJsonContainer.Match(const AFilter: TQJsonMatchFilterCallbackA; ATag: Pointer): IQJsonContainer; var I: Integer; T: TQJsonContainer; @@ -8001,8 +7822,7 @@ function TQJsonContainer.GetItems(const AIndex: Integer): TQJson; Result := FItems[AIndex]; end; -function TQJsonContainer.Match(const AFilter: TQJsonMatchFilterCallback; - ATag: Pointer): IQJsonContainer; +function TQJsonContainer.Match(const AFilter: TQJsonMatchFilterCallback; ATag: Pointer): IQJsonContainer; var I: Integer; T: TQJsonContainer; @@ -8024,8 +7844,7 @@ function TQJsonContainer.Match(const AFilter: TQJsonMatchFilterCallback; Result := Self; end; -function TQJsonContainer.Match(const AStart, AStop, AStep: Integer) - : IQJsonContainer; +function TQJsonContainer.Match(const AStart, AStop, AStep: Integer): IQJsonContainer; var I, c: Integer; T: TQJsonContainer; @@ -8057,8 +7876,7 @@ function TQJsonContainer.Match(const AStart, AStop, AStep: Integer) end; end; -function TQJsonContainer.Match(const AIndexes: array of Integer) - : IQJsonContainer; +function TQJsonContainer.Match(const AIndexes: array of Integer): IQJsonContainer; var I, c: Integer; T: TQJsonContainer; @@ -8073,8 +7891,7 @@ function TQJsonContainer.Match(const AIndexes: array of Integer) end; end; -function TQJsonContainer.Match(const ARegex: QStringW; - ASettings: TQJsonMatchSettings): IQJsonContainer; +function TQJsonContainer.Match(const ARegex: QStringW; ASettings: TQJsonMatchSettings): IQJsonContainer; var AReg: TPerlRegEx; T: TQJsonContainer; diff --git a/Source/qrbtree.pas b/Source/qrbtree.pas index 9856d5d..a343e6e 100644 --- a/Source/qrbtree.pas +++ b/Source/qrbtree.pas @@ -370,8 +370,6 @@ TQRBComparor = class implementation -uses qworker; - const RB_RED = 0; RB_BLACK = 1; diff --git a/Source/qstring.pas b/Source/qstring.pas index 294bfd7..be0ace9 100644 --- a/Source/qstring.pas +++ b/Source/qstring.pas @@ -255,7 +255,7 @@ interface , windows {$ENDIF} {$IFDEF POSIX} - , Posix.String_, Posix.SysTypes, Posix.Time + , Posix.String_, Posix.Time, Posix.SysTypes {$ENDIF} {$IFDEF ANDROID} , Androidapi.Log @@ -1580,17 +1580,6 @@ function FindSwitchValue(ASwitch: QStringW; ANameValueSperator: QCharW = ':') : QStringW; overload; function MonthFirstDay(ADate: TDateTime): TDateTime; -/// ϲַIJͬ -/// ʡ -/// -/// -/// -/// -/// ϸַ -/// ϲʱмؼͬһβǷм -/// -/// غϲĵַ ADetail ǰIJ֣Զϲ -/// function MergeAddr(const AProv, ACity, ACounty, ATownship, AVillage, ADetail: String; AIgnoreCityIfSameEnding: Boolean): String; @@ -6749,6 +6738,7 @@ function ParseInt(var S: PQCharW; var ANum: Int64): Integer; var ps: PQCharW; ANeg: Boolean; + ALastVal: Int64; begin ps := S; // 16ƿʼַ @@ -6783,15 +6773,17 @@ function ParseInt(var S: PQCharW; var ANum: Int64): Integer; end; end; ANum := 0; + ALastVal := 0; while (S^ >= '0') and (S^ <= '9') do begin ANum := ANum * 10 + Ord(S^) - Ord('0'); - if ANum < 0 then // + if (ANum div 10) <> ALastVal then // begin Result := 0; S := ps; Exit; end; + ALastVal := ANum; Inc(S); end; if ANeg then @@ -8673,21 +8665,17 @@ function GetTimeZone: Integer; {$IFDEF MSWindows} TimeZone: TTimeZoneInformation; {$ELSE} - tmLocal, tmUtc: PTM; - t1, t2: time_t; + tmLocal: TM; + t1: time_t; {$ENDIF} begin {$IFDEF MSWINDOWS} GetTimeZoneInformation(TimeZone); Result := -TimeZone.Bias; {$ELSE} - time_r(@t1); - t2 := t1; - tmLocal := localtime(@t1); - t1 := mktime(tm_local); - tmUtc := gmtime(@t2); - t2 := mktime(tm_utc); - Result := (t1 - t2) div 60; + t1 := 0; + localtime_r(t1, tmLocal); + Result := tmLocal.tm_gmtoff div 60 ; {$ENDIF} end; @@ -9262,7 +9250,7 @@ function TQStringCatHelperW.Cat(p: PQCharW; len: Integer; AQuoter: QCharW) Inc(ps); end; if AQuoter <> #0 then - NeedSize(-len-ACount-2) + NeedSize(-len - ACount - 2) else NeedSize(-len); if AQuoter <> #0 then