├── Examples └── comming_soon.txt ├── Tools └── JSONParserTest │ ├── JSONParserTest.exe │ ├── JSONParserTest.res │ ├── JSONParserTest.dpr │ ├── uMain.dfm │ ├── JSONParserTest.dproj │ └── uMain.pas ├── README.md ├── LICENSE └── Source └── JSON.VerySimple.pas /Examples/comming_soon.txt: -------------------------------------------------------------------------------- 1 | Comming soon ;) 2 | -------------------------------------------------------------------------------- /Tools/JSONParserTest/JSONParserTest.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gmnevton/JSON.VerySimple/HEAD/Tools/JSONParserTest/JSONParserTest.exe -------------------------------------------------------------------------------- /Tools/JSONParserTest/JSONParserTest.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gmnevton/JSON.VerySimple/HEAD/Tools/JSONParserTest/JSONParserTest.res -------------------------------------------------------------------------------- /Tools/JSONParserTest/JSONParserTest.dpr: -------------------------------------------------------------------------------- 1 | program JSONParserTest; 2 | 3 | uses 4 | FastMM4, 5 | Forms, 6 | uMain in 'uMain.pas' {Form1}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.MainFormOnTaskbar := True; 13 | Application.CreateForm(TForm1, Form1); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # JSON.VerySimple v1.6.0 2 | A lightweight, one-unit, cross-platform JSON reader/writer 3 | for Delphi 2010-XE10.3 by Grzegorz Molenda 4 | https://github.com/gmnevton/JSON.VerySimple 5 | 6 | (c) Copyrights 2016-2024 Grzegorz Molenda aka NevTon 7 | This unit is free and can be used for any needs. The introduction of 8 | any changes and the use of those changed library is permitted without 9 | limitations. Only requirement: 10 | This text must be present without changes in all modifications of library. 11 | 12 | * The contents of this file are used with permission, subject to the Mozilla Public License Version 1.1 (the "License"). 13 | * You may not use this file except in compliance with the License. 14 | * You may obtain a copy of the License at http: www.mozilla.org/MPL/MPL-1.1.html 15 | 16 | * Software distributed under the License is distributed on an "AS IS" basis, 17 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. 18 | * See the License for the specific language governing rights and limitations under the License. 19 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2016-2017 Grzegorz Molenda 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Tools/JSONParserTest/uMain.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'JSON Parser Test' 5 | ClientHeight = 663 6 | ClientWidth = 1027 7 | Color = clBtnFace 8 | Constraints.MinHeight = 400 9 | Constraints.MinWidth = 700 10 | Font.Charset = DEFAULT_CHARSET 11 | Font.Color = clWindowText 12 | Font.Height = -11 13 | Font.Name = 'Tahoma' 14 | Font.Style = [] 15 | KeyPreview = True 16 | OldCreateOrder = False 17 | OnCreate = FormCreate 18 | OnDestroy = FormDestroy 19 | PixelsPerInch = 96 20 | TextHeight = 13 21 | object SplitterEx1: TSplitterEx 22 | Left = 521 23 | Top = 43 24 | Width = 7 25 | Height = 620 26 | AssignedControl = Panel2 27 | AutoSnap = False 28 | DrawSpacer = True 29 | MinSize = 100 30 | ResizeStyle = rsUpdate 31 | ExplicitLeft = 321 32 | ExplicitTop = 89 33 | ExplicitHeight = 580 34 | end 35 | object Panel1: TPanel 36 | Left = 0 37 | Top = 0 38 | Width = 1027 39 | Height = 43 40 | Align = alTop 41 | BevelEdges = [beBottom] 42 | BevelKind = bkFlat 43 | BevelOuter = bvNone 44 | TabOrder = 0 45 | object Button1: TButton 46 | Left = 8 47 | Top = 8 48 | Width = 121 49 | Height = 25 50 | Caption = 'Load JSON file...' 51 | TabOrder = 0 52 | OnClick = Button1Click 53 | end 54 | object Button2: TButton 55 | Left = 144 56 | Top = 8 57 | Width = 121 58 | Height = 25 59 | Caption = 'Tree to JSON...' 60 | TabOrder = 1 61 | OnClick = Button2Click 62 | end 63 | object Button3: TButton 64 | Left = 280 65 | Top = 8 66 | Width = 121 67 | Height = 25 68 | Caption = 'Save JSON to file...' 69 | TabOrder = 2 70 | OnClick = Button3Click 71 | end 72 | object CheckBox1: TCheckBox 73 | Left = 424 74 | Top = 12 75 | Width = 97 76 | Height = 17 77 | Caption = 'Auto indent' 78 | Checked = True 79 | State = cbChecked 80 | TabOrder = 3 81 | OnClick = CheckBox1Click 82 | end 83 | object CheckBox2: TCheckBox 84 | Left = 528 85 | Top = 12 86 | Width = 97 87 | Height = 17 88 | Caption = 'Compact' 89 | TabOrder = 4 90 | OnClick = CheckBox2Click 91 | end 92 | object CheckBox3: TCheckBox 93 | Left = 631 94 | Top = 12 95 | Width = 97 96 | Height = 17 97 | Caption = 'Multiline strings' 98 | TabOrder = 5 99 | OnClick = CheckBox3Click 100 | end 101 | end 102 | object Panel2: TPanel 103 | Left = 0 104 | Top = 43 105 | Width = 521 106 | Height = 620 107 | Align = alLeft 108 | BevelOuter = bvNone 109 | TabOrder = 1 110 | object vstJSONTree: TVirtualStringTree 111 | Left = 0 112 | Top = 0 113 | Width = 521 114 | Height = 620 115 | Align = alClient 116 | BevelEdges = [beRight] 117 | BevelKind = bkFlat 118 | BorderStyle = bsNone 119 | Header.AutoSizeIndex = 0 120 | Header.Font.Charset = DEFAULT_CHARSET 121 | Header.Font.Color = clWindowText 122 | Header.Font.Height = -11 123 | Header.Font.Name = 'Tahoma' 124 | Header.Font.Style = [] 125 | Header.MainColumn = -1 126 | Header.Options = [hoDrag] 127 | TabOrder = 0 128 | TreeOptions.AutoOptions = [toAutoDropExpand, toAutoDeleteMovedNodes, toAutoChangeScale] 129 | TreeOptions.MiscOptions = [toToggleOnDblClick, toWheelPanning] 130 | TreeOptions.PaintOptions = [toShowButtons, toShowRoot, toShowTreeLines, toThemeAware, toUseBlendedImages] 131 | TreeOptions.SelectionOptions = [toExtendedFocus, toFullRowSelect] 132 | TreeOptions.StringOptions = [toShowStaticText] 133 | OnGetText = vstJSONTreeGetText 134 | OnPaintText = vstJSONTreePaintText 135 | OnGetNodeDataSize = vstJSONTreeGetNodeDataSize 136 | Columns = <> 137 | end 138 | end 139 | object Memo1: TMemo 140 | Left = 528 141 | Top = 43 142 | Width = 499 143 | Height = 620 144 | Align = alClient 145 | BevelEdges = [beLeft] 146 | BevelKind = bkFlat 147 | BorderStyle = bsNone 148 | ReadOnly = True 149 | ScrollBars = ssVertical 150 | TabOrder = 2 151 | end 152 | object OpenDialog1: TOpenDialog 153 | DefaultExt = '*.json' 154 | Filter = 'JSON files (*.json)|*.json|All files (*.*)|*.*' 155 | Options = [ofHideReadOnly, ofExtensionDifferent, ofPathMustExist, ofFileMustExist, ofNoTestFileCreate, ofEnableSizing] 156 | Left = 56 157 | Top = 64 158 | end 159 | object SaveDialog1: TSaveDialog 160 | DefaultExt = '*.json' 161 | Filter = 'JSON files (*.json)|*.json|All files (*.*)|*.*' 162 | Options = [ofOverwritePrompt, ofExtensionDifferent, ofPathMustExist, ofFileMustExist, ofCreatePrompt, ofEnableSizing, ofDontAddToRecent] 163 | Left = 136 164 | Top = 64 165 | end 166 | end 167 | -------------------------------------------------------------------------------- /Tools/JSONParserTest/JSONParserTest.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {5569B8BA-2758-4571-B867-1A808A7EC2BC} 4 | 12.0 5 | JSONParserTest.dpr 6 | Debug 7 | DCC32 8 | 9 | 10 | true 11 | 12 | 13 | true 14 | Base 15 | true 16 | 17 | 18 | true 19 | Base 20 | true 21 | 22 | 23 | false 24 | false 25 | false 26 | false 27 | false 28 | JSONParserTest.exe 29 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias) 30 | 00400000 31 | x86 32 | 33 | 34 | false 35 | RELEASE;$(DCC_Define) 36 | 0 37 | false 38 | 39 | 40 | 3 41 | DEBUG;$(DCC_Define) 42 | 43 | 44 | 45 | MainSource 46 | 47 | 48 |
Form1
49 | 50 | 51 | Base 52 | 53 | 54 | Cfg_1 55 | Base 56 | 57 | 58 | Cfg_2 59 | Base 60 | 61 | 62 | 63 | 64 | Delphi.Personality.12 65 | 66 | 67 | 68 | 69 | JSONParserTest.dpr 70 | 71 | 72 | False 73 | True 74 | False 75 | 76 | 77 | False 78 | False 79 | 1 80 | 0 81 | 0 82 | 0 83 | False 84 | False 85 | False 86 | False 87 | False 88 | 1045 89 | 1250 90 | 91 | 92 | 93 | 94 | 1.0.0.0 95 | 96 | 97 | 98 | 99 | 100 | 1.0.0.0 101 | 102 | 103 | 104 | Microsoft Office 2000 Sample Automation Server Wrapper Components 105 | Microsoft Office XP Sample Automation Server Wrapper Components 106 | 107 | 108 | 109 | 12 110 | 111 | 112 | -------------------------------------------------------------------------------- /Tools/JSONParserTest/uMain.pas: -------------------------------------------------------------------------------- 1 | unit uMain; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, SplitEx, VirtualTrees, ExtCtrls, JSON.VerySimple; 8 | 9 | type 10 | TJSONTreeNode = record 11 | JSONNode: TJSONNode; 12 | end; 13 | PJSONTreeNode = ^TJSONTreeNode; 14 | 15 | TForm1 = class(TForm) 16 | Panel1: TPanel; 17 | Panel2: TPanel; 18 | vstJSONTree: TVirtualStringTree; 19 | SplitterEx1: TSplitterEx; 20 | Memo1: TMemo; 21 | Button1: TButton; 22 | OpenDialog1: TOpenDialog; 23 | Button2: TButton; 24 | Button3: TButton; 25 | CheckBox1: TCheckBox; 26 | CheckBox2: TCheckBox; 27 | SaveDialog1: TSaveDialog; 28 | CheckBox3: TCheckBox; 29 | 30 | procedure FormCreate(Sender: TObject); 31 | procedure FormDestroy(Sender: TObject); 32 | procedure Button1Click(Sender: TObject); 33 | procedure vstJSONTreeGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); 34 | procedure vstJSONTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); 35 | procedure vstJSONTreePaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); 36 | procedure Button2Click(Sender: TObject); 37 | procedure Button3Click(Sender: TObject); 38 | procedure CheckBox1Click(Sender: TObject); 39 | procedure CheckBox2Click(Sender: TObject); 40 | procedure CheckBox3Click(Sender: TObject); 41 | private 42 | json: TJSONVerySimple; 43 | 44 | procedure MakeJSONTree(const AJSONTree: TJSONVerySimple); 45 | public 46 | end; 47 | 48 | var 49 | Form1: TForm1; 50 | 51 | implementation 52 | 53 | {$R *.dfm} 54 | 55 | procedure TForm1.FormCreate(Sender: TObject); 56 | begin 57 | json:=TJSONVerySimple.Create; 58 | json.NodeAutoIndent:=False; 59 | // json.Options:=json.Options + [joCompact]; 60 | // json.Options:=json.Options + [joCompactWithBreakes]; 61 | end; 62 | 63 | procedure TForm1.FormDestroy(Sender: TObject); 64 | begin 65 | json.Free; 66 | end; 67 | 68 | procedure TForm1.Button1Click(Sender: TObject); 69 | var 70 | i: Integer; 71 | begin 72 | if OpenDialog1.Execute then begin 73 | i:=Pos(' - ', Caption); 74 | if i > 0 then begin 75 | Caption:=Copy(Caption, 1, i - 1); 76 | end; 77 | Caption:=Caption + ' - ' + ExtractFileName(OpenDialog1.FileName); 78 | json.LoadFromFile(OpenDialog1.FileName); 79 | MakeJSONTree(json); 80 | end; 81 | end; 82 | 83 | procedure TForm1.Button2Click(Sender: TObject); 84 | begin 85 | json.NodeIndentStr := ' '; 86 | json.LineBreak := sLineBreak; 87 | json.NodeAutoIndent:=CheckBox1.Checked; 88 | if CheckBox2.Checked then 89 | json.Options:=json.Options + [joCompact] 90 | else 91 | json.Options:=json.Options - [joCompact]; 92 | Memo1.Lines.Text:=json.Text; 93 | end; 94 | 95 | procedure TForm1.Button3Click(Sender: TObject); 96 | begin 97 | json.NodeIndentStr := ' '; 98 | json.LineBreak := sLineBreak; 99 | if SaveDialog1.Execute then begin 100 | if json.ChildNodes.Count > 0 then 101 | json.SaveToFile(SaveDialog1.FileName); 102 | end; 103 | end; 104 | 105 | procedure TForm1.CheckBox1Click(Sender: TObject); 106 | begin 107 | if Memo1.Lines.Text <> '' then 108 | Button2Click(Button2); 109 | end; 110 | 111 | procedure TForm1.CheckBox2Click(Sender: TObject); 112 | begin 113 | if Memo1.Lines.Text <> '' then 114 | Button2Click(Button2); 115 | end; 116 | 117 | procedure TForm1.CheckBox3Click(Sender: TObject); 118 | begin 119 | json.MultilineStrings:=CheckBox3.Checked; 120 | end; 121 | 122 | procedure TForm1.MakeJSONTree(const AJSONTree: TJSONVerySimple); 123 | var 124 | TreeParent, TreeNode: PVirtualNode; 125 | 126 | procedure DoTree(const ANode: TJSONNode); 127 | var 128 | NodeData: PJSONTreeNode; 129 | Node: TJSONNode; 130 | begin 131 | if ANode <> Nil then begin 132 | TreeNode:=vstJSONTree.AddChild(TreeParent); 133 | NodeData:=vstJSONTree.GetNodeData(TreeNode); 134 | with NodeData^ do begin 135 | JSONNode:=ANode; 136 | end; 137 | 138 | TreeParent:=TreeNode; 139 | try 140 | if ANode.HasChildNodes then 141 | for Node in ANode.ChildNodes do 142 | DoTree(Node); 143 | finally 144 | TreeParent:=TreeParent.Parent; 145 | end; 146 | end; 147 | end; 148 | 149 | begin 150 | TreeParent:=Nil; 151 | vstJSONTree.BeginUpdate; 152 | try 153 | vstJSONTree.Clear; 154 | DoTree(AJSONTree.DocumentElement); 155 | vstJSONTree.FullExpand; 156 | finally 157 | vstJSONTree.EndUpdate; 158 | end; 159 | end; 160 | 161 | procedure TForm1.vstJSONTreeGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); 162 | begin 163 | NodeDataSize:=SizeOf(TJSONTreeNode); 164 | end; 165 | 166 | procedure TForm1.vstJSONTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); 167 | var 168 | NodeData: PJSONTreeNode; 169 | begin 170 | NodeData:=Sender.GetNodeData(Node); 171 | if TextType = ttNormal then begin 172 | CellText:=Format('[%d]', [NodeData.JSONNode.Index]); 173 | if NodeData.JSONNode.Name <> '' then 174 | CellText:=CellText + Format(' "%s"', [NodeData.JSONNode.Name]); 175 | end 176 | else begin 177 | case NodeData.JSONNode.NodeType of 178 | jtObject: CellText:=Format('Object {%d}', [NodeData.JSONNode.ChildNodes.Count]); 179 | jtArray : CellText:=Format('Array {%d}', [NodeData.JSONNode.ChildNodes.Count]); 180 | jtString: CellText:='[' + NodeData.JSONNode.Value + ']'; 181 | jtNumber: CellText:='{' + NodeData.JSONNode.Value + '}'; 182 | jtTrue: CellText:='True'; 183 | jtFalse: CellText:='False'; 184 | jtNull: CellText:='Null'; 185 | else 186 | CellText:=''; 187 | end; 188 | end; 189 | end; 190 | 191 | procedure TForm1.vstJSONTreePaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); 192 | var 193 | NodeData: PJSONTreeNode; 194 | begin 195 | NodeData:=Sender.GetNodeData(Node); 196 | if TextType = ttStatic then begin 197 | case NodeData.JSONNode.NodeType of 198 | jtObject, 199 | jtArray : TargetCanvas.Font.Color:=clLime; 200 | jtNumber : TargetCanvas.Font.Color:=clRed; 201 | jtTrue, 202 | jtFalse : TargetCanvas.Font.Color:=clWindowText; 203 | jtNull : TargetCanvas.Font.Color:=clGrayText; 204 | else 205 | TargetCanvas.Font.Color:=clBlue; 206 | end; 207 | end; 208 | end; 209 | 210 | end. 211 | -------------------------------------------------------------------------------- /Source/JSON.VerySimple.pas: -------------------------------------------------------------------------------- 1 | { JSON.VerySimple v1.6.0 - a lightweight, one-unit, cross-platform JSON reader/writer 2 | for Delphi 2010-XE10.3 by Grzegorz Molenda 3 | https://github.com/gmnevton/JSON.VerySimple 4 | 5 | (c) Copyrights 2016-2024 Grzegorz Molenda aka NevTon 6 | This unit is free and can be used for any needs. The introduction of 7 | any changes and the use of those changed library is permitted without 8 | limitations. Only requirement: 9 | This text must be present without changes in all modifications of library. 10 | 11 | * The contents of this file are used with permission, subject to * 12 | * the Mozilla Public License Version 1.1 (the "License"); you may * 13 | * not use this file except in compliance with the License. You may * 14 | * obtain a copy of the License at * 15 | * http: www.mozilla.org/MPL/MPL-1.1.html * 16 | * * 17 | * Software distributed under the License is distributed on an * 18 | * "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or * 19 | * implied. See the License for the specific language governing * 20 | * rights and limitations under the License. * 21 | } 22 | unit JSON.VerySimple; 23 | 24 | interface 25 | 26 | uses 27 | Classes, SysUtils, Generics.Defaults, Generics.Collections; 28 | 29 | const 30 | TJSONSpaces = #$20 + #$0D + #$0A + #9; 31 | 32 | type 33 | TJSONString = type String; 34 | TJSONVerySimple = class; 35 | TJSONNode = class; 36 | // TJSONNodeType = (jtObject, jtArray, jtString, jtNumber, jtTrue, jtFalse, jtNull); 37 | TJSONNodeType = (jtObject, jtArray, jtString, jtNumber, jtBoolean, jtNull); 38 | TJSONBooleanType = (btFalse, btTrue); 39 | TJSONNodeTypes = set of TJSONNodeType; 40 | TJSONRootType = (jrtObject, jrtArray); 41 | TJSONNodeSearchType = (jsRecursive); 42 | TJSONNodeSearchTypes = set of TJSONNodeSearchType; 43 | TJSONNodeList = class; 44 | TJSONOptions = set of (joNodeAutoIndent, joCompact, joCompactWithBreakes, joPreserveWhiteSpace, joCaseInsensitive, joWriteBOM, joMultilineStrings, joEscapingDisabled); 45 | TJSONExtractTextOptions = set of (jetDeleteToStopChar, jetDeleteWithStopChar, jetStopString); 46 | 47 | EJSONException = class(Exception); 48 | EJSONNodeException = class(EJSONException); 49 | EJSONParseException = class(EJSONException); 50 | EJSONPathException = class(EJSONException); 51 | 52 | TJSONNodeCallBack = reference to procedure(Node: TJSONNode; var Loop: Boolean); // now Result = False can break the loop 53 | 54 | {$IF CompilerVersion >= 24} 55 | TStreamReaderFillBuffer = procedure(var Encoding: TEncoding) of object; 56 | 57 | TJSONStreamReader = class(TStreamReader) 58 | protected 59 | FBufferedData: TStringBuilder; 60 | FNoDataInStream: PBoolean; 61 | FFillBuffer: TStreamReaderFillBuffer; 62 | /// Call to FillBuffer method of TStreamReader 63 | procedure FillBuffer; 64 | public 65 | /// Extend the TStreamReader with RTTI pointers 66 | constructor Create(Stream: TStream; Encoding: TEncoding; DetectBOM: Boolean = False; BufferSize: Integer = 4096); 67 | /// Assures the read buffer holds at least Value characters 68 | function PrepareBuffer(Value: Integer): Boolean; 69 | /// 70 | procedure SkipWhitespace; 71 | /// Returns fist char but does not removes it from the buffer 72 | function FirstChar: Char; 73 | /// Proceed with the next character(s) (value optional, default 1) 74 | procedure IncCharPos(Value: Integer = 1); virtual; 75 | /// Returns True if the first uppercased characters at the current position match Value 76 | function IsUppercaseText(const Value: TJSONString): Boolean; virtual; 77 | /// Extract text until chars found in StopChars 78 | function ReadText(const StopChars: TJSONString; Options: TJSONExtractTextOptions; const MultilineString: Boolean): TJSONString; virtual; 79 | end; 80 | {$IFEND} 81 | 82 | TJSONNode = class(TObject) 83 | private 84 | FName: TJSONString; 85 | FValue: TJSONString; 86 | FLevel: Cardinal; // node level in tree structure 87 | FIndex: Cardinal; // node index in nodes list structure 88 | FPrevSibling, // link to the node's previous sibling or nil if it is the first node 89 | FNextSibling: TJSONNode; // link to the node's next sibling or nil if it is the last node 90 | FNodeType: TJSONNodeType; 91 | 92 | function IsSame(const Value1, Value2: TJSONString): Boolean; 93 | procedure _SetNodeType(const Value: TJSONNodeType); 94 | /// Find a child node by its name in tree 95 | function FindNodeRecursive(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []; const SearchOptions: TJSONNodeSearchTypes = []): TJSONNode; overload; virtual; 96 | /// Find a child node by name and value in tree 97 | function FindNodeRecursive(const Name, Value: TJSONString; NodeTypes: TJSONNodeTypes = []; const SearchOptions: TJSONNodeSearchTypes = []): TJSONNode; overload; virtual; 98 | /// Return a list of child nodes with the given name and (optional) node types in tree 99 | // function FindNodesRecursive(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []): TJSONNodeList; virtual; 100 | protected 101 | [Weak] FDocument: TJSONVerySimple; 102 | procedure SetDocument(AValue: TJSONVerySimple); 103 | procedure SetName(AValue: TJSONString); 104 | // 105 | procedure SetValue(AValue: TJSONString); 106 | procedure SetValueAsBoolean(AValue: Boolean); 107 | procedure SetValueAsInteger(AValue: Integer); 108 | procedure SetValueAsInt64(AValue: Int64); 109 | procedure SetValueAsFloat(AValue: Double); 110 | procedure SetValueAsString(AValue: TJSONString); 111 | // 112 | function GetName: TJSONString; 113 | function GetNodeTypeAsString: String; virtual; 114 | // 115 | function GetValue: TJSONString; 116 | function GetValueAsBoolean: Boolean; 117 | function GetValueAsInteger: Integer; 118 | function GetValueAsInt64: Int64; 119 | function GetValueAsFloat: Double; 120 | function GetValueAsString: TJSONString; 121 | public 122 | /// List of child nodes, never NIL 123 | ChildNodes: TJSONNodeList; 124 | /// Parent node, may be NIL 125 | [Weak] ParentNode: TJSONNode; 126 | /// Creates a new JSON node 127 | constructor Create(ANodeType: TJSONNodeType); virtual; 128 | /// Removes the node from its parent and frees all of its childs 129 | destructor Destroy; override; 130 | /// Assigns an existing XML node to this 131 | procedure Assign(const Node: TJSONNode); virtual; 132 | /// Clears the attributes, the text and all of its child nodes (but not the name) 133 | procedure Clear; 134 | /// Is node empty 135 | function Empty: Boolean; virtual; 136 | /// Is node null 137 | function Null: Boolean; virtual; 138 | /// Find a child node by its name 139 | function FindNode(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []; const SearchOptions: TJSONNodeSearchTypes = []): TJSONNode; overload; virtual; 140 | /// Find a child node by name and attribute name 141 | function FindNode(const Name, Value: TJSONString; NodeTypes: TJSONNodeTypes = []; const SearchOptions: TJSONNodeSearchTypes = []): TJSONNode; overload; virtual; 142 | /// Return a list of child nodes with the given name and (optional) node types 143 | function FindNodes(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []): TJSONNodeList; virtual; 144 | /// Loops trough childnodes with given Name or if Name is empty loops trough all childnodes, can break loop if CallBack function Result is False 145 | procedure ScanNodes(Name: TJSONString; CallBack: TJSONNodeCallBack); 146 | /// Returns True if a child node with that name exits 147 | function HasChild(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []): Boolean; virtual; 148 | /// Add a child node with an optional NodeType (default: []) 149 | function AddChild(const AName: TJSONString; ANodeType: TJSONNodeType): TJSONNode; virtual; 150 | /// Removes a child node 151 | function RemoveChild(const Node: TJSONNode): Integer; virtual; 152 | /// Moves a child node 153 | function MoveChild(const FromNode, ToNode: TJSONNode): TJSONNode; virtual; 154 | /// Add a nodes tree from existing node 155 | procedure AddNodes(const RootNode: TJSONNode; const AddRootNode: Boolean = False); virtual; 156 | /// Insert a child node at a specific position with a NodeType (default: []) 157 | function InsertChild(const Name: TJSONString; Position: Integer; NodeType: TJSONNodeType): TJSONNode; virtual; 158 | /// Fluent interface for setting the text of the node 159 | function SetText(const AValue: TJSONString): TJSONNode; virtual; 160 | /// Returns first child or NIL if there aren't any child nodes 161 | function FirstChild: TJSONNode; virtual; 162 | /// Returns last child node or NIL if there aren't any child nodes 163 | function LastChild: TJSONNode; virtual; 164 | /// Returns previous sibling 165 | function PreviousSibling: TJSONNode; overload; virtual; 166 | /// Returns next sibling 167 | function NextSibling: TJSONNode; overload; virtual; 168 | /// Returns True if the node has at least one child node 169 | function HasChildNodes: Boolean; virtual; 170 | /// Fluent interface for setting the node type 171 | function SetNodeType(const Value: TJSONNodeType): TJSONNode; virtual; 172 | /// Name of the node 173 | property Name: TJSONString read GetName write SetName; 174 | /// Text value of the node 175 | property Value: TJSONString read GetValue write SetValue; 176 | /// Boolean value of the node 177 | property ValueAsBoolean: Boolean read GetValueAsBoolean write SetValueAsBoolean; 178 | /// Integer value of the node 179 | property ValueAsInteger: Integer read GetValueAsInteger write SetValueAsInteger; 180 | /// Int64 value of the node 181 | property ValueAsInt64: Int64 read GetValueAsInt64 write SetValueAsInt64; 182 | /// Float value of the node 183 | property ValueAsFloat: Double read GetValueAsFloat write SetValueAsFloat; 184 | /// String value of the node 185 | property ValueAsString: TJSONString read GetValueAsString write SetValueAsString; 186 | { 187 | /// Text value of the node 188 | property Value: TJSONString read GetValue write SetValue; 189 | /// Text value of the node 190 | property Value: TJSONString read GetValue write SetValue; 191 | } 192 | /// The JSON document of the node 193 | property Document: TJSONVerySimple read FDocument write SetDocument; 194 | /// The node name, same as property Name 195 | property NodeName: TJSONString read GetName write SetName; 196 | /// The node type, see TJSONNodeType 197 | property NodeType: TJSONNodeType read FNodeType write _SetNodeType; 198 | /// Text value of the node, same as property Value 199 | property NodeValue: TJSONString read GetValue write SetValue; 200 | /// The node Level in tree 201 | property Level: Cardinal read FLevel; 202 | /// The node Index in list 203 | property Index: Cardinal read FIndex; 204 | end; 205 | 206 | TJSONNodeList = class(TObjectList) 207 | private 208 | function IsSame(const Value1, Value2: TJSONString): Boolean; 209 | public 210 | /// The JSON document of the node list 211 | [Weak] Document: TJSONVerySimple; 212 | /// The parent node of the node list 213 | [Weak] Parent: TJSONNode; 214 | /// Adds a node and sets the parent of the node to the parent of the list 215 | function Add(Value: TJSONNode): Integer; overload; virtual; 216 | /// Adds a node and sets the parent of the node to the parent of the list 217 | function Add(Value: TJSONNode; ParentNode: TJSONNode): Integer; overload; virtual; 218 | /// Creates a new node of type NodeType (default []) and adds it to the list 219 | function Add(NodeType: TJSONNodeType): TJSONNode; overload; virtual; 220 | /// Add a child node with an optional NodeType (default: []) 221 | function Add(const Name: TJSONString; NodeType: TJSONNodeType): TJSONNode; overload; virtual; 222 | /// Add nodes from another list 223 | procedure Add(const List: TJSONNodeList); overload; virtual; 224 | /// Inserts a node at the given position 225 | function Insert(const Name: TJSONString; Position: Integer; NodeType: TJSONNodeType): TJSONNode; overload; virtual; 226 | /// Removes a node at the given position 227 | procedure Remove(Index: Integer); overload; virtual; 228 | /// Find a node by its name (case sensitive), returns NIL if no node is found 229 | function Find(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []): TJSONNode; overload; virtual; 230 | /// Same as Find(), returnsa a node by its name (case sensitive) 231 | function FindNode(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []): TJSONNode; virtual; 232 | /// Find a node that has the the given attribute, returns NIL if no node is found 233 | function Find(const Name, Value: TJSONString; NodeTypes: TJSONNodeTypes = []): TJSONNode; overload; virtual; 234 | /// Return a list of child nodes with the given name and (optional) node types 235 | function FindNodes(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []): TJSONNodeList; virtual; 236 | // Loops trough childnodes with given Name 237 | // procedure ScanNodes(const Name: TJSONString; CallBack: TJSONNodeCallBack); 238 | /// Returns True if the list contains a node with the given name 239 | function HasNode(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []): Boolean; virtual; 240 | /// Returns the first child node, same as .First 241 | function FirstChild: TJSONNode; virtual; 242 | /// Returns last child node or NIL if there aren't any child nodes 243 | function LastChild: TJSONNode; virtual; 244 | /// Returns previous sibling node 245 | function PreviousSibling(Node: TJSONNode): TJSONNode; virtual; 246 | /// Returns next sibling node 247 | function NextSibling(Node: TJSONNode): TJSONNode; virtual; 248 | /// Returns the node at the given position 249 | function Get(Index: Integer): TJSONNode; overload; virtual; 250 | /// Returns the node of the given Name or exception if none was found 251 | function Get(Name: TJSONString): TJSONNode; overload; virtual; 252 | /// Returns the node count of the given name 253 | function CountNames(const Name: TJSONString; var NodeList: TJSONNodeList): Integer; virtual; 254 | end; 255 | 256 | TJSONEscapeProcedure = reference to procedure (var TextLine: TJSONString); 257 | {$IF CompilerVersion < 24} 258 | TJSONReader = TStreamReader; 259 | {$ELSE} 260 | TJSONReader = TJSONStreamReader; 261 | {$IFEND} 262 | 263 | TJSONVerySimple = class(TObject) 264 | private 265 | FEncoding: TJSONString; 266 | FDivider: TJSONString; 267 | protected 268 | Root: TJSONNode; 269 | [Weak] FDocumentElement: TJSONNode; 270 | SkipIndent: Boolean; 271 | JSONEscapeProcedure: TJSONEscapeProcedure; 272 | procedure Parse(Reader: TJSONReader); virtual; 273 | procedure ParseObject(Reader: TJSONReader; var Parent: TJSONNode); 274 | procedure ParsePair(Reader: TJSONReader; var Parent: TJSONNode); 275 | procedure ParseValue(Reader: TJSONReader; var Parent: TJSONNode); 276 | procedure ParseArray(Reader: TJSONReader; var Parent: TJSONNode); 277 | procedure Walk(Writer: TStreamWriter; const PrefixNode: TJSONString; Node: TJSONNode); virtual; 278 | procedure SetText(const Value: TJSONString); virtual; 279 | function GetText: TJSONString; virtual; 280 | procedure SetEncoding(const Value: TJSONString); virtual; 281 | function GetEncoding: TJSONString; virtual; 282 | procedure Compose(Writer: TStreamWriter); virtual; 283 | function GetChildNodes: TJSONNodeList; virtual; 284 | function ExtractText(var Line: TJSONString; const StopChars: TJSONString; Options: TJSONExtractTextOptions): TJSONString; virtual; 285 | procedure SetDocumentElement(Value: TJSONNode); virtual; 286 | procedure SetNodeAutoIndent(const Value: Boolean); 287 | function GetNodeAutoIndent: Boolean; 288 | procedure SetPreserveWhitespace(const Value: Boolean); 289 | function GetPreserveWhitespace: Boolean; 290 | procedure SetMultilineStrings(const Value: Boolean); 291 | function GetMultilineStrings: Boolean; 292 | procedure SetEscapingDisabled(const Value: Boolean); 293 | function GetEscapingDisabled: Boolean; 294 | function IsSame(const Value1, Value2: TJSONString): Boolean; 295 | public 296 | /// Indent used for the JSON output 297 | NodeIndentStr: TJSONString; 298 | /// LineBreak used for the JSON output, default set to sLineBreak which is OS dependent 299 | LineBreak: TJSONString; 300 | /// Options for JSON output like indentation type 301 | Options: TJSONOptions; 302 | /// Creates a new JSON document parser 303 | constructor Create(const RootType: TJSONRootType = jrtObject); virtual; 304 | /// Destroys the JSON document parser 305 | destructor Destroy; override; 306 | /// Deletes all nodes 307 | procedure Clear; virtual; 308 | /// Is document empty 309 | function Empty: Boolean; virtual; 310 | /// Adds a new node to the document 311 | function AddChild(const Name: TJSONString; NodeType: TJSONNodeType): TJSONNode; virtual; 312 | /// Removes a child node 313 | function RemoveChild(const Node: TJSONNode): Integer; virtual; 314 | /// Moves a child node 315 | function MoveChild(const FromNode, ToNode: TJSONNode): TJSONNode; virtual; 316 | /// Creates a new node but doesn't adds it to the document nodes 317 | function CreateNode(const Name: TJSONString; NodeType: TJSONNodeType): TJSONNode; virtual; 318 | /// Select node using JSON Path 319 | function SelectNode(const JSONPath: String): TJSONNode; virtual; 320 | /// Selects nodes by evaluating JSONPath expression, allways returns a list that must be manually destroyed 321 | function SelectNodes(const JSONPath: String; RootNode: TJSONNode = Nil): TJSONNodeList; virtual; 322 | /// Escapes JSON control characters 323 | class function Escape(const Value: TJSONString; const Enabled: Boolean = True): TJSONString; virtual; 324 | /// Translates escaped characters back into JSON control characters 325 | class function Unescape(const Value: TJSONString; const Enabled: Boolean = True): TJSONString; virtual; 326 | /// Loads the JSON from a file 327 | function LoadFromFile(const FileName: String; BufferSize: Integer = 4096): TJSONVerySimple; virtual; 328 | /// Loads the JSON from a stream 329 | function LoadFromStream(const Stream: TStream; BufferSize: Integer = 4096): TJSONVerySimple; virtual; 330 | /// Saves the JSON to a file 331 | function SaveToFile(const FileName: String): TJSONVerySimple; overload; virtual; 332 | function SaveToFile(const FileName: String; const EscapeProcedure: TJSONEscapeProcedure): TJSONVerySimple; overload; virtual; 333 | /// Saves the JSON to a stream, the encoding is specified in the .Encoding property 334 | function SaveToStream(const Stream: TStream): TJSONVerySimple; virtual; 335 | /// A list of all root nodes of the document 336 | property ChildNodes: TJSONNodeList read GetChildNodes; 337 | /// Returns the first element node 338 | property DocumentElement: TJSONNode read FDocumentElement write SetDocumentElement; 339 | /// Specifies the encoding of the JSON file, anything else then 'utf-8' is considered as ANSI 340 | property Encoding: TJSONString read GetEncoding write SetEncoding; 341 | /// Set to True if all spaces and linebreaks should be included as a text node, same as doPreserve option 342 | property NodeAutoIndent: Boolean read GetNodeAutoIndent write SetNodeAutoIndent; 343 | /// Set to True if all spaces and linebreaks should be included as a text node, same as doPreserve option 344 | property PreserveWhitespace: Boolean read GetPreserveWhitespace write SetPreserveWhitespace; 345 | /// Set to True if all spaces and linebreaks should be included as a text node, same as doPreserve option 346 | property MultilineStrings: Boolean read GetMultilineStrings write SetMultilineStrings; 347 | /// Set to True if all special characters should be not be escaped when saving or reading 348 | property EscapingDisabled: Boolean read GetEscapingDisabled write SetEscapingDisabled; 349 | /// The JSON as a string representation 350 | property Text: TJSONString read GetText write SetText; 351 | /// The JSON as a string representation, same as .Text 352 | property JSON: TJSONString read GetText write SetText; 353 | end; 354 | 355 | function BooleanToNodeType(const ABoolean: Boolean): TJSONBooleanType; 356 | function BooleanToNodeValue(const ABoolean: Boolean): TJSONString; 357 | 358 | implementation 359 | 360 | uses 361 | // WideStrUtils, 362 | StrUtils, 363 | Rtti; 364 | 365 | type 366 | TStreamWriterHelper = class helper for TStreamWriter 367 | public 368 | constructor Create(Stream: TStream; Encoding: TEncoding; WritePreamble: Boolean = True; BufferSize: Integer = 1024); overload; 369 | constructor Create(Filename: string; Append: Boolean; Encoding: TEncoding; WritePreamble: Boolean = True; BufferSize: Integer = 1024); overload; 370 | end; 371 | 372 | { 373 | Simplified JSONPath expression evaluator. 374 | Based on JSONPath tutorial from: 375 | https://www.w3schools.com/js/js_json_intro.asp 376 | https://github.com/json-path/JsonPath 377 | https://goessner.net/articles/JsonPath/ 378 | https://gregsdennis.github.io/Manatee.Json/usage/path.html 379 | https://restfulapi.net/json-jsonpath/ 380 | 381 | 382 | Currently supported are: 383 | > Syntax elements: 384 | $ selects from the root node 385 | @ current node being processed by a filter predicate 386 | .. deep scan. available anywhere, a name is required 387 | . dot-notated child 388 | 389 | 390 | > Predicates: 391 | [n] selects the n-th subelement of the current element ('n' is a number, first subelement has index 1) 392 | [node='x'] selects all subelements named node containing text 'x' 393 | 394 | 395 | > Wildcards: 396 | * matches any element node or value 397 | 398 | 399 | > Location Path Expression: 400 | An absolute location path: 401 | $.step.step.... 402 | $.store.book[0].title 403 | 404 | 405 | Examples: 406 | $.store.book[*].author The authors of all books 407 | $..author All authors 408 | $.store.* All things, both books and bicycles 409 | $.store..price The price of everything 410 | $..book[2] The third book 411 | $..book[-2] The second to last book 412 | 413 | Not working at this time: 414 | $..book[0,1] The first two books 415 | $..book[:2] All books from index 0 (inclusive) until index 2 (exclusive) 416 | $..book[1:2] All books from index 1 (inclusive) until index 2 (exclusive) 417 | $..book[-2:] Last two books 418 | $..book[2:] Book number two from tail 419 | $..book[?(@.isbn)] All books with an ISBN number 420 | $.store.book[?(@.price < 10)] All books in store cheaper than 10 421 | $..book[?(@.price <= $['expensive'])] All books in store that are not "expensive" 422 | $..book[?(@.author =~ /.*REES/i)] All books matching regex (ignore case) 423 | $..* Give me every thing 424 | } 425 | TJSONPathSelectionFlag = (selScanTree); 426 | TJSONPathSelectionFlags = set of TJSONPathSelectionFlag; 427 | 428 | // Source - https://github.com/mremec/omnixml/blob/master/OmniXMLXPath.pas 429 | TJSONPathEvaluator = class 430 | private 431 | //FDocument: TJSONVerySimple; 432 | FExpression: String; 433 | FNodeDelimiter: Char; 434 | FExpressionPos: Integer; 435 | protected 436 | function GetPredicateIndex(const Predicate: String; out Index: Integer): Boolean; 437 | procedure GetChildNodes(List: TJSONNodeList; Node: TJSONNode; const Element: String; Recurse: Boolean); 438 | procedure EvaluateNode(List: TJSONNodeList; Node: TJSONNode; Element, Predicate: String; Flags: TJSONPathSelectionFlags; out BreakLoop: Boolean); 439 | procedure EvaluatePart(SrcList, DestList: TJSONNodeList; const Element, Predicate: String; Flags: TJSONPathSelectionFlags); 440 | procedure FilterByAttrib(SrcList, DestList: TJSONNodeList; const AttrName, AttrValue: String; const NotEQ: Boolean); 441 | procedure FilterByChild(SrcList, DestList: TJSONNodeList; const ChildName, ChildValue: String); 442 | procedure FilterByFunction(SrcList, DestList: TJSONNodeList; ChildName, ChildValue: String); 443 | procedure FilterNodes(SrcList, DestList: TJSONNodeList; Predicate: String; out BreakLoop: Boolean); 444 | protected 445 | function GetNextExpressionPart(var Element, Predicate: String; var Flags: TJSONPathSelectionFlags): Boolean; 446 | procedure SplitExpression(const Predicate: String; var left, op, right: String); 447 | public 448 | constructor Create; 449 | // 450 | function Evaluate(RootNode: TJSONNode; const Expression: String; const NodeDelimiter: Char = '.'): TJSONNodeList; 451 | property NodeDelimiter: Char read FNodeDelimiter write FNodeDelimiter; 452 | end; 453 | 454 | {$IF CompilerVersion < 24} 455 | TStreamReaderHelper = class helper for TStreamReader 456 | public 457 | /// Assures the read buffer holds at least Value characters 458 | function PrepareBuffer(Value: Integer): Boolean; 459 | /// 460 | procedure SkipWhitespace; 461 | /// Returns fist char but does not removes it from the buffer 462 | function FirstChar: Char; 463 | /// Proceed with the next character(s) (value optional, default 1) 464 | procedure IncCharPos(Value: Integer = 1); virtual; 465 | /// Returns True if the first uppercased characters at the current position match Value 466 | function IsUppercaseText(const Value: TJSONString): Boolean; virtual; 467 | /// Extract text until chars found in StopChars 468 | function ReadText(const StopChars: TJSONString; Options: TJSONExtractTextOptions; const MultilineString: Boolean): TJSONString; virtual; 469 | end; 470 | {$ELSE} 471 | TStreamReaderHelper = class helper for TStreamReader 472 | public 473 | procedure GetFillBuffer(var Method: TStreamReaderFillBuffer); 474 | end; 475 | {$IFEND} 476 | 477 | const 478 | {$IF CompilerVersion >= 24} // Delphi XE3+ can use Low(), High() and TEncoding.ANSI 479 | LowStr = Low(String); // Get string index base, may be 0 (NextGen compiler) or 1 (standard compiler) 480 | 481 | {$ELSE} // For any previous Delphi version overwrite High() function and use 1 as string index base 482 | LowStr = 1; // Use 1 as string index base 483 | 484 | function High(const Value: String): Integer; inline; 485 | begin 486 | Result := Length(Value); 487 | end; 488 | 489 | //Delphi XE3 added PosEx as an overloaded Pos function, so we need to wrap it in every other Delphi version 490 | function Pos(const SubStr, S: String; Offset: Integer): Integer; overload; Inline; 491 | begin 492 | Result := PosEx(SubStr, S, Offset); 493 | end; 494 | {$IFEND} 495 | 496 | {$IF CompilerVersion < 23} //Delphi XE2 added ANSI as Encoding, in every other Delphi version use TEncoding.Default 497 | type 498 | TEncodingHelper = class helper for TEncoding 499 | class function GetANSI: TEncoding; static; 500 | class property ANSI: TEncoding read GetANSI; 501 | end; 502 | 503 | class function TEncodingHelper.GetANSI: TEncoding; 504 | begin 505 | Result := TEncoding.Default; 506 | end; 507 | {$IFEND} 508 | 509 | resourcestring 510 | sRootTypeNotDefined = 'Root type not defined!'; 511 | sExpectedButFound = 'Expected %s, but %s found at ''%s''.'; 512 | sExpectedButNotFound = 'Expected %s, but nothing found!'; 513 | sExpectedNumberAsValue = 'Expected Null or Number as %svalue, but found ''%s'' !'; 514 | sExpectedBooleanAsValue = 'Expected True/False as %svalue, but found ''%s'' !'; 515 | sNodeNotFound = 'Node ''%s'' not found!'; 516 | sNodeValueError = 'Expected %s as node value, but ''%s'' was given !'; 517 | sNodeTypeError = 'Incompatible node type %s and setted value type %s !'; 518 | sNodeTypeConvertError = 'Conversion from node type %s to getted value type %s faulted !'; 519 | 520 | function IfThen(AValue: Boolean; const ATrue: TJSONString; AFalse: TJSONString = ''): TJSONString; overload; inline; 521 | begin 522 | if AValue then 523 | Result := ATrue 524 | else 525 | Result := AFalse; 526 | end; 527 | 528 | function BooleanToNodeType(const ABoolean: Boolean): TJSONBooleanType; 529 | begin 530 | if ABoolean then 531 | Result:=btTrue 532 | else 533 | Result:=btFalse; 534 | end; 535 | 536 | function BooleanToNodeValue(const ABoolean: Boolean): TJSONString; 537 | begin 538 | if ABoolean then 539 | Result:='true' 540 | else 541 | Result:='false'; 542 | end; 543 | 544 | { TVerySimpleJSON } 545 | 546 | function TJSONVerySimple.AddChild(const Name: TJSONString; NodeType: TJSONNodeType): TJSONNode; 547 | begin 548 | Result:=Nil; // satisfy compiler 549 | try 550 | Result:=Root.AddChild(Name, NodeType); 551 | except 552 | Result.Free; 553 | raise; 554 | end; 555 | // if (NodeType = jtObject) and not Assigned(FDocumentElement) then 556 | // FDocumentElement := Result; 557 | Result.Document := Self; 558 | end; 559 | 560 | function TJSONVerySimple.RemoveChild(const Node: TJSONNode): Integer; 561 | var 562 | wasRoot: Boolean; 563 | Child: TJSONNode; 564 | begin 565 | Result:=-1; 566 | if Node <> Nil then begin 567 | wasRoot:=(DocumentElement = Node); 568 | Node.Clear; 569 | Result:=Node.Index; 570 | Root.ChildNodes.Remove(Result); 571 | if wasRoot then begin 572 | if Root.ChildNodes.Count > 0 then begin 573 | for Child in Root.ChildNodes do begin 574 | if Child.NodeType = jtObject then begin 575 | FDocumentElement := Child; 576 | Exit; 577 | end; 578 | end; 579 | DocumentElement := Nil; 580 | end 581 | else 582 | FDocumentElement := Nil; 583 | end; 584 | // Node.Free; 585 | end; 586 | end; 587 | 588 | function TJSONVerySimple.MoveChild(const FromNode, ToNode: TJSONNode): TJSONNode; 589 | begin 590 | Result:=ToNode; 591 | if (ToNode <> Nil) and (FromNode <> Nil) then begin 592 | ToNode.AddNodes(FromNode, True); 593 | FromNode.ParentNode.RemoveChild(FromNode); 594 | end; 595 | end; 596 | 597 | procedure TJSONVerySimple.Clear; 598 | begin 599 | FDocumentElement := NIL; 600 | Root.Clear; 601 | FDocumentElement := Root; 602 | end; 603 | 604 | function TJSONVerySimple.Empty: Boolean; 605 | begin 606 | Result := (DocumentElement <> Nil) and (DocumentElement.HasChildNodes); 607 | end; 608 | 609 | constructor TJSONVerySimple.Create(const RootType: TJSONRootType = jrtObject); 610 | begin 611 | inherited Create; 612 | Root := TJSONNode.Create(jtObject); 613 | Root.Name:=''; 614 | Root.FLevel := 0; 615 | // Root.FIndex := 0; 616 | Root.NodeType := jtNull; 617 | if RootType = jrtObject then 618 | Root.NodeType := jtObject 619 | else if RootType = jrtArray then 620 | Root.NodeType := jtArray; 621 | Root.ParentNode := Root; 622 | Root.Document := Self; 623 | Encoding := 'utf-8'; 624 | NodeIndentStr := ' '; 625 | Options := [joNodeAutoIndent]; 626 | LineBreak := sLineBreak; 627 | JSONEscapeProcedure := Nil; 628 | FDocumentElement := Root; 629 | end; 630 | 631 | function TJSONVerySimple.CreateNode(const Name: TJSONString; NodeType: TJSONNodeType): TJSONNode; 632 | begin 633 | Result := TJSONNode.Create(NodeType); 634 | Result.Name := Name; 635 | Result.Document := Self; 636 | end; 637 | 638 | function TJSONVerySimple.SelectNode(const JSONPath: String): TJSONNode; 639 | var 640 | list: TJSONNodeList; 641 | begin 642 | Result:=Nil; 643 | try 644 | list:=SelectNodes(JSONPath, Root); 645 | try 646 | if list.Count > 0 then 647 | Result:=list.Get(0); 648 | finally 649 | list.Free; 650 | end; 651 | except 652 | end; 653 | end; 654 | 655 | function TJSONVerySimple.SelectNodes(const JSONPath: String; RootNode: TJSONNode = Nil): TJSONNodeList; 656 | var 657 | JPath: TJSONPathEvaluator; 658 | begin 659 | if RootNode = Nil then 660 | RootNode:=Self.Root; 661 | 662 | JPath:=TJSONPathEvaluator.Create; 663 | try 664 | Result:=JPath.Evaluate(RootNode, JSONPath); 665 | finally 666 | FreeAndNil(JPath); 667 | end; 668 | end; 669 | 670 | destructor TJSONVerySimple.Destroy; 671 | begin 672 | Root.ParentNode := NIL; 673 | Root.Clear; 674 | Root.Free; 675 | inherited; 676 | end; 677 | 678 | function TJSONVerySimple.GetChildNodes: TJSONNodeList; 679 | begin 680 | Result := Root.ChildNodes; 681 | end; 682 | 683 | function TJSONVerySimple.GetEncoding: TJSONString; 684 | begin 685 | Result := FEncoding; 686 | end; 687 | 688 | function TJSONVerySimple.GetNodeAutoIndent: Boolean; 689 | begin 690 | Result := joNodeAutoIndent in Options; 691 | end; 692 | 693 | function TJSONVerySimple.GetPreserveWhitespace: Boolean; 694 | begin 695 | Result := joPreserveWhitespace in Options; 696 | end; 697 | 698 | function TJSONVerySimple.GetMultilineStrings: Boolean; 699 | begin 700 | Result := joMultilineStrings in Options; 701 | end; 702 | 703 | function TJSONVerySimple.GetEscapingDisabled: Boolean; 704 | begin 705 | Result := joEscapingDisabled in Options; 706 | end; 707 | 708 | function TJSONVerySimple.IsSame(const Value1, Value2: TJSONString): Boolean; 709 | begin 710 | if joCaseInsensitive in Options then 711 | Result := (CompareText(Value1, Value2) = 0) 712 | else 713 | Result := (Value1 = Value2); 714 | end; 715 | 716 | function TJSONVerySimple.GetText: TJSONString; 717 | var 718 | Stream: TStringStream; 719 | begin 720 | if CompareText(Encoding, 'utf-8') = 0 then 721 | Stream := TStringStream.Create('', TEncoding.UTF8) 722 | else 723 | Stream := TStringStream.Create('', TEncoding.ANSI); 724 | try 725 | SaveToStream(Stream); 726 | Result := Stream.DataString; 727 | finally 728 | Stream.Free; 729 | end; 730 | end; 731 | 732 | procedure TJSONVerySimple.Compose(Writer: TStreamWriter); 733 | var 734 | Child: TJSONNode; 735 | begin 736 | FDivider:=' : '; 737 | if joCompact in Options then begin 738 | Writer.NewLine := ''; 739 | LineBreak := ''; 740 | FDivider:=':'; 741 | end 742 | else 743 | Writer.NewLine := LineBreak; 744 | 745 | SkipIndent := False; 746 | if Root.NodeType = jtObject then 747 | Writer.Write('{') 748 | else if Root.NodeType = jtArray then 749 | Writer.Write('[') 750 | else 751 | raise EJSONParseException.Create(sRootTypeNotDefined); 752 | if not (joCompact in Options) then 753 | Writer.Write(LineBreak); 754 | 755 | for Child in Root.ChildNodes do begin 756 | Walk(Writer, IfThen(GetNodeAutoIndent, NodeIndentStr), Child); 757 | if Child <> Root.ChildNodes.Last then 758 | Writer.Write(',' + LineBreak); 759 | end; 760 | 761 | if not (joCompact in Options) then 762 | Writer.Write(LineBreak); 763 | if Root.NodeType = jtObject then 764 | Writer.Write('}') 765 | else if Root.NodeType = jtArray then 766 | Writer.Write(']'); 767 | end; 768 | 769 | function TJSONVerySimple.LoadFromFile(const FileName: String; BufferSize: Integer = 4096): TJSONVerySimple; 770 | var 771 | Stream: TFileStream; 772 | begin 773 | Stream := TFileStream.Create(FileName, fmOpenRead + fmShareDenyWrite); 774 | try 775 | LoadFromStream(Stream, BufferSize); 776 | finally 777 | Stream.Free; 778 | end; 779 | Result := Self; 780 | end; 781 | 782 | function TJSONVerySimple.LoadFromStream(const Stream: TStream; BufferSize: Integer = 4096): TJSONVerySimple; 783 | var 784 | Reader: TJSONReader; 785 | begin 786 | if Encoding = '' then // none specified then use UTF8 with DetectBom 787 | Reader := TJSONReader.Create(Stream, TEncoding.UTF8, True, BufferSize) 788 | else if CompareText(Encoding, 'utf-8') = 0 then 789 | Reader := TJSONReader.Create(Stream, TEncoding.UTF8, False, BufferSize) 790 | else if CompareText(Encoding, 'windows-1250') = 0 then 791 | Reader := TJSONReader.Create(Stream, TEncoding.GetEncoding(1250), False, BufferSize) 792 | else 793 | Reader := TJSONReader.Create(Stream, TEncoding.ANSI, False, BufferSize); 794 | try 795 | Parse(Reader); 796 | finally 797 | Reader.Free; 798 | end; 799 | Result := Self; 800 | end; 801 | 802 | procedure TJSONVerySimple.Parse(Reader: TJSONReader); 803 | var 804 | Parent: TJSONNode; 805 | FirstChar: TJSONString; 806 | begin 807 | Clear; 808 | Parent := Root; 809 | 810 | while not Reader.EndOfStream do begin 811 | FirstChar := Reader.FirstChar; 812 | if FirstChar = '{' then begin // Parse object 813 | if (Parent = Root) and (Root.NodeType <> jtObject) then 814 | Root.NodeType:=jtObject; 815 | ParseObject(Reader, Parent); 816 | end 817 | else if FirstChar = '[' then begin // Parse array 818 | if (Parent = Root) and (Root.NodeType <> jtArray) then 819 | Root.NodeType:=jtArray; 820 | ParseArray(Reader, Parent); 821 | end 822 | else if FirstChar = ',' then begin // Next element 823 | Reader.IncCharPos; 824 | end 825 | else if FirstChar <> '' then begin // omit whitespace 826 | Reader.SkipWhitespace; 827 | end; 828 | end; 829 | 830 | FDocumentElement := Root; 831 | end; 832 | 833 | procedure TJSONVerySimple.ParseObject(Reader: TJSONReader; var Parent: TJSONNode); 834 | var 835 | FirstChar: TJSONString; 836 | Opened: Boolean; 837 | begin 838 | Opened:=True; 839 | Reader.IncCharPos; 840 | Reader.SkipWhitespace; 841 | while True do begin 842 | FirstChar := Reader.FirstChar; 843 | if FirstChar = '"' then begin // Parse pair 844 | ParsePair(Reader, Parent); 845 | end 846 | else if FirstChar = ',' then begin // Next element 847 | Reader.IncCharPos; 848 | Reader.SkipWhitespace; 849 | end 850 | else if FirstChar <> '' then begin // omit whitespace 851 | if FirstChar = '}' then begin // exit from object 852 | Opened:=False; 853 | Reader.IncCharPos; 854 | Reader.SkipWhitespace; 855 | Parent:=Parent.ParentNode; 856 | Break; 857 | end 858 | else if FirstChar <> '"' then 859 | raise EJSONParseException.CreateFmt(sExpectedButFound, ['pair', '''' + FirstChar + '''', Reader.ReadToEnd]) 860 | else begin 861 | Reader.IncCharPos; 862 | Reader.SkipWhitespace; 863 | end; 864 | end 865 | else 866 | raise EJSONParseException.CreateFmt(sExpectedButNotFound, ['pair']); 867 | 868 | if Reader.EndOfStream then 869 | Break; 870 | end; 871 | FirstChar := Reader.FirstChar; 872 | if (FirstChar <> ',') and ((FirstChar <> '}') and (FirstChar <> ']')) and not Reader.EndOfStream then 873 | raise EJSONParseException.CreateFmt(sExpectedButFound, [''',''', '''' + FirstChar + '''', Reader.ReadToEnd]); 874 | if (FirstChar = #0) and Reader.EndOfStream and Opened then 875 | raise EJSONParseException.CreateFmt(sExpectedButFound, ['''}''', 'end of stream', Reader.ReadToEnd]); 876 | end; 877 | 878 | procedure TJSONVerySimple.ParsePair(Reader: TJSONReader; var Parent: TJSONNode); 879 | var 880 | Node: TJSONNode; 881 | Quote, Check: Char; 882 | Line: TJSONString; 883 | nodeType: TJSONNodeType; 884 | booleanType: TJSONBooleanType; 885 | begin 886 | Reader.IncCharPos; 887 | // Reader.SkipWhitespace; 888 | Line:=''; 889 | while True do begin 890 | Line:=Line + Reader.ReadText('"', [jetDeleteWithStopChar, jetStopString], joMultilineStrings in Options); 891 | Reader.SkipWhitespace; 892 | Check := Reader.FirstChar; 893 | if Check = ':' then begin // set value 894 | Reader.IncCharPos; 895 | Break; 896 | end; 897 | if Reader.EndOfStream then 898 | Exit; 899 | end; 900 | Node := Parent.AddChild(Line, jtString); 901 | 902 | // Line:=Reader.ReadText(':', [jetDeleteWithStopChar, jetStopString], False); 903 | Reader.SkipWhitespace; 904 | Quote := Reader.FirstChar; 905 | if Quote = '"' then begin // set value 906 | Reader.IncCharPos; 907 | Line:=''; 908 | while True do begin 909 | Line:=Line + Reader.ReadText('"', [jetDeleteWithStopChar, jetStopString], joMultilineStrings in Options); 910 | Reader.SkipWhitespace; 911 | Check := Reader.FirstChar; 912 | if CharInSet(Check, [',', ']', '}']) and (Parent.NodeType in [jtObject, jtArray]) then begin // set value 913 | if Check = ',' then 914 | Reader.IncCharPos; 915 | Break; 916 | end; 917 | if Reader.EndOfStream then 918 | Exit; 919 | end; 920 | Node.Value:=Line; 921 | Reader.SkipWhitespace; 922 | end 923 | else if Quote = '{' then begin // new object 924 | Node.NodeType:=jtObject; 925 | Parent:=Node; 926 | ParseObject(Reader, Parent); 927 | end 928 | else if Quote = '[' then begin // new array 929 | Node.NodeType:=jtArray; 930 | Parent:=Node; 931 | ParseArray(Reader, Parent); 932 | end 933 | else if Quote <> '' then begin // set number / string / true / false / null 934 | nodeType:=jtNumber; 935 | if not CharInSet(Quote, ['-', '0'..'9']) then begin 936 | nodeType:=jtString; 937 | if CharInSet(Quote, ['t', 'T']) then begin 938 | // nodeType:=jtTrue 939 | nodeType:=jtBoolean; 940 | booleanType:=btTrue; 941 | end 942 | else if CharInSet(Quote, ['f', 'F']) then begin 943 | // nodeType:=jtFalse 944 | nodeType:=jtBoolean; 945 | booleanType:=btFalse; 946 | end 947 | else if CharInSet(Quote, ['n', 'N']) then 948 | nodeType:=jtNull; 949 | end; 950 | Reader.IncCharPos; 951 | Line:=Reader.ReadText(',]}'+TJSONSpaces, [jetDeleteToStopChar], False); 952 | Line:=Quote + Line; 953 | // checks 954 | if nodeType = jtString then 955 | raise EJSONParseException.CreateFmt(sExpectedNumberAsValue, ['pair ', Line]); 956 | if (nodeType = jtBoolean) and (((booleanType = btFalse) and (LowerCase(Line) <> 'false')) or ((booleanType = btTrue) and (LowerCase(Line) <> 'true'))) then 957 | raise EJSONParseException.CreateFmt(sExpectedBooleanAsValue, ['pair ', Line]); 958 | // 959 | Node.NodeType:=nodeType; 960 | // Node.Value:=Unescape(Quote + Line); 961 | Node.Value:=Line; 962 | Reader.SkipWhitespace; 963 | end; 964 | end; 965 | 966 | procedure TJSONVerySimple.ParseValue(Reader: TJSONReader; var Parent: TJSONNode); 967 | var 968 | Node: TJSONNode; 969 | Quote: Char; 970 | Line: TJSONString; 971 | nodeType: TJSONNodeType; 972 | booleanType: TJSONBooleanType; 973 | begin 974 | Quote := Reader.FirstChar; 975 | if Quote = '"' then begin // set string value 976 | Reader.IncCharPos; 977 | Node := Parent.AddChild('', jtString); 978 | Line:=Reader.ReadText(Quote, [jetDeleteWithStopChar, jetStopString], joMultilineStrings in Options); 979 | // Node.Value:=Unescape(Line); 980 | Node.Value:=Line; 981 | Reader.SkipWhitespace; 982 | end 983 | else if Quote = '{' then begin // set object value 984 | Node := Parent.AddChild('', jtObject); 985 | Parent:=Node; 986 | ParseObject(Reader, Parent); 987 | end 988 | else if Quote = '[' then begin // set array value 989 | Node := Parent.AddChild('', jtArray); 990 | Parent:=Node; 991 | ParseArray(Reader, Parent); 992 | end 993 | else if Quote <> '' then begin // set number / string / true / false / null 994 | nodeType:=jtNumber; 995 | if not CharInSet(Quote, ['-', '0'..'9']) then begin 996 | nodeType:=jtString; 997 | if CharInSet(Quote, ['t', 'T']) then begin 998 | // nodeType:=jtTrue 999 | nodeType:=jtBoolean; 1000 | booleanType:=btTrue; 1001 | end 1002 | else if CharInSet(Quote, ['f', 'F']) then begin 1003 | // nodeType:=jtFalse 1004 | nodeType:=jtBoolean; 1005 | booleanType:=btFalse; 1006 | end 1007 | else if CharInSet(Quote, ['n', 'N']) then 1008 | nodeType:=jtNull; 1009 | end; 1010 | Reader.IncCharPos; 1011 | Line:=Reader.ReadText(',]}'+TJSONSpaces, [jetDeleteToStopChar], False); 1012 | Line:=Quote + Line; 1013 | // checks 1014 | if nodeType = jtString then 1015 | raise EJSONParseException.CreateFmt(sExpectedNumberAsValue, ['', Line]); 1016 | if (nodeType = jtBoolean) and (((booleanType = btFalse) and (LowerCase(Line) <> 'false')) or ((booleanType = btTrue) and (LowerCase(Line) <> 'true'))) then 1017 | raise EJSONParseException.CreateFmt(sExpectedBooleanAsValue, ['pair ', Line]); 1018 | // 1019 | Node := Parent.AddChild('', nodeType); 1020 | // Node.Value:=Unescape(Quote + Line); 1021 | Node.Value:=Line; 1022 | Reader.SkipWhitespace; 1023 | end; 1024 | end; 1025 | 1026 | procedure TJSONVerySimple.ParseArray(Reader: TJSONReader; var Parent: TJSONNode); 1027 | var 1028 | FirstChar: TJSONString; 1029 | Node: TJSONNode; 1030 | Opened: Boolean; 1031 | begin 1032 | Opened:=True; 1033 | Reader.IncCharPos; 1034 | Reader.SkipWhitespace; 1035 | while True do begin 1036 | FirstChar := Reader.FirstChar; 1037 | if FirstChar = '{' then begin // Parse object 1038 | Node:=Parent.AddChild('', jtObject); 1039 | Parent:=Node; 1040 | ParseObject(Reader, Parent); 1041 | end 1042 | else if FirstChar = '[' then begin // Parse array 1043 | Node:=Parent.AddChild('', jtArray); 1044 | Parent:=Node; 1045 | ParseArray(Reader, Parent); 1046 | end 1047 | else if FirstChar = ',' then begin // Next element 1048 | Reader.IncCharPos; 1049 | Reader.SkipWhitespace; 1050 | end 1051 | else if FirstChar <> '' then begin // set value 1052 | if FirstChar = ']' then begin // exit from array 1053 | Opened:=False; 1054 | Reader.IncCharPos; 1055 | Reader.SkipWhitespace; 1056 | Parent:=Parent.ParentNode; 1057 | Break; 1058 | end; 1059 | // here may be string, number, object, array or other types 1060 | ParseValue(Reader, Parent); 1061 | end 1062 | else 1063 | raise EJSONParseException.CreateFmt(sExpectedButNotFound, ['value']); 1064 | 1065 | if Reader.EndOfStream then 1066 | Break; 1067 | end; 1068 | FirstChar := Reader.FirstChar; 1069 | if (FirstChar <> ',') and ((FirstChar <> '}') and (FirstChar <> ']')) and not Reader.EndOfStream then 1070 | raise EJSONParseException.CreateFmt(sExpectedButFound, [''',''', '''' + FirstChar + '''', Reader.ReadToEnd]); 1071 | if (FirstChar = #0) and Reader.EndOfStream and Opened then 1072 | raise EJSONParseException.CreateFmt(sExpectedButFound, [''']''', 'end of stream', Reader.ReadToEnd]); 1073 | end; 1074 | 1075 | function TJSONVerySimple.SaveToFile(const FileName: String): TJSONVerySimple; 1076 | var 1077 | Stream: TFileStream; 1078 | begin 1079 | Stream := TFileStream.Create(FileName, fmCreate); 1080 | try 1081 | SaveToStream(Stream); 1082 | finally 1083 | Stream.Free; 1084 | end; 1085 | Result := Self; 1086 | end; 1087 | 1088 | function TJSONVerySimple.SaveToFile(const FileName: String; const EscapeProcedure: TJSONEscapeProcedure): TJSONVerySimple; 1089 | begin 1090 | JSONEscapeProcedure:=EscapeProcedure; 1091 | try 1092 | Result := SaveToFile(FileName); 1093 | finally 1094 | JSONEscapeProcedure:=Nil; 1095 | end; 1096 | end; 1097 | 1098 | function TJSONVerySimple.SaveToStream(const Stream: TStream): TJSONVerySimple; 1099 | var 1100 | Writer: TStreamWriter; 1101 | begin 1102 | if CompareText(Self.Encoding, 'utf-8') = 0 then 1103 | Writer := TStreamWriter.Create(Stream, TEncoding.UTF8, (joWriteBOM in Options)) 1104 | else if CompareText(Encoding, 'windows-1250') = 0 then 1105 | Writer := TStreamWriter.Create(Stream, TEncoding.GetEncoding(1250), (joWriteBOM in Options)) 1106 | else 1107 | Writer := TStreamWriter.Create(Stream, TEncoding.ANSI, (joWriteBOM in Options)); 1108 | try 1109 | Compose(Writer); 1110 | finally 1111 | Writer.Free; 1112 | end; 1113 | Result := Self; 1114 | end; 1115 | 1116 | procedure TJSONVerySimple.SetDocumentElement(Value: TJSONNode); 1117 | begin 1118 | FDocumentElement := Value; 1119 | if Value.ParentNode = NIL then 1120 | Root.ChildNodes.Add(Value); 1121 | end; 1122 | 1123 | procedure TJSONVerySimple.SetEncoding(const Value: TJSONString); 1124 | begin 1125 | FEncoding:=Value; 1126 | end; 1127 | 1128 | procedure TJSONVerySimple.SetNodeAutoIndent(const Value: Boolean); 1129 | begin 1130 | if Value then 1131 | Options := Options + [joNodeAutoIndent] 1132 | else 1133 | Options := Options - [joNodeAutoIndent]; 1134 | end; 1135 | 1136 | procedure TJSONVerySimple.SetPreserveWhitespace(const Value: Boolean); 1137 | begin 1138 | if Value then 1139 | Options := Options + [joPreserveWhitespace] 1140 | else 1141 | Options := Options - [joPreserveWhitespace]; 1142 | end; 1143 | 1144 | procedure TJSONVerySimple.SetMultilineStrings(const Value: Boolean); 1145 | begin 1146 | if Value then 1147 | Options := Options + [joMultilineStrings] 1148 | else 1149 | Options := Options - [joMultilineStrings]; 1150 | end; 1151 | 1152 | procedure TJSONVerySimple.SetEscapingDisabled(const Value: Boolean); 1153 | begin 1154 | if Value then 1155 | Options := Options + [joEscapingDisabled] 1156 | else 1157 | Options := Options - [joEscapingDisabled]; 1158 | end; 1159 | 1160 | procedure TJSONVerySimple.SetText(const Value: TJSONString); 1161 | var 1162 | Stream: TStringStream; 1163 | begin 1164 | Stream := TStringStream.Create('', TEncoding.UTF8); 1165 | try 1166 | Stream.WriteString(Value); 1167 | Stream.Position := 0; 1168 | LoadFromStream(Stream); 1169 | finally 1170 | Stream.Free; 1171 | end; 1172 | end; 1173 | 1174 | procedure TJSONVerySimple.Walk(Writer: TStreamWriter; const PrefixNode: TJSONString; Node: TJSONNode); 1175 | var 1176 | Child: TJSONNode; 1177 | Line: TJSONString; 1178 | Indent: TJSONString; 1179 | begin 1180 | if (Node = Root.ChildNodes.First) or (SkipIndent) then begin 1181 | if joCompact in Options then 1182 | Line := '' 1183 | else 1184 | Line := PrefixNode; 1185 | SkipIndent := False; 1186 | end 1187 | else 1188 | Line := PrefixNode; 1189 | 1190 | case Node.NodeType of 1191 | jtObject: begin 1192 | Line:=Line + IfThen((Node.ParentNode <> Nil) and (Node.ParentNode.NodeType <> jtArray), '"' + Escape(Node.Name, not EscapingDisabled) + '"' + FDivider) + '{'; 1193 | if not (joCompact in Options) then 1194 | Line:=Line + LineBreak; 1195 | end; 1196 | jtArray: begin 1197 | Line:=Line + IfThen((Node.ParentNode <> Nil) and (Node.ParentNode.NodeType <> jtArray), '"' + Escape(Node.Name, not EscapingDisabled) + '"' + FDivider) + '['; 1198 | if not (joCompact in Options) then 1199 | Line:=Line + LineBreak; 1200 | end; 1201 | jtString: begin 1202 | Line := Line + IfThen((Node.ParentNode <> Nil) and (Node.ParentNode.NodeType <> jtArray), '"' + Escape(Node.Name, not EscapingDisabled) + '"' + FDivider) + '"' + Escape(Node.Value, not EscapingDisabled) + '"'; 1203 | end; 1204 | jtNumber: begin 1205 | Line := Line + IfThen((Node.ParentNode <> Nil) and (Node.ParentNode.NodeType <> jtArray), '"' + Escape(Node.Name, not EscapingDisabled) + '"' + FDivider) + Escape(Node.Value, not EscapingDisabled); 1206 | end; 1207 | // jtTrue: begin 1208 | // Line := Line + IfThen((Node.ParentNode <> Nil) and (Node.ParentNode.NodeType <> jtArray), '"' + Escape(Node.Name, not EscapingDisabled) + '"' + FDivider) + 'true'; 1209 | // end; 1210 | // jtFalse: begin 1211 | // Line := Line + IfThen((Node.ParentNode <> Nil) and (Node.ParentNode.NodeType <> jtArray), '"' + Escape(Node.Name, not EscapingDisabled) + '"' + FDivider) + 'false'; 1212 | // end; 1213 | jtBoolean: begin 1214 | if LowerCase(Node.Value) = 'true' then 1215 | Line := Line + IfThen((Node.ParentNode <> Nil) and (Node.ParentNode.NodeType <> jtArray), '"' + Escape(Node.Name, not EscapingDisabled) + '"' + FDivider) + 'true' 1216 | else 1217 | Line := Line + IfThen((Node.ParentNode <> Nil) and (Node.ParentNode.NodeType <> jtArray), '"' + Escape(Node.Name, not EscapingDisabled) + '"' + FDivider) + 'false'; 1218 | end; 1219 | jtNull: begin 1220 | Line := Line + IfThen((Node.ParentNode <> Nil) and (Node.ParentNode.NodeType <> jtArray), '"' + Escape(Node.Name, not EscapingDisabled) + '"' + FDivider) + 'null'; 1221 | end; 1222 | end; 1223 | 1224 | if Assigned(JSONEscapeProcedure) then 1225 | JSONEscapeProcedure(Line); 1226 | 1227 | // Writer.Write(WideCharToString(PWideChar(Line))); 1228 | Writer.Write(Line); 1229 | 1230 | // Set indent for child nodes 1231 | if (joCompact in Options) or (joCompactWithBreakes in Options) then 1232 | Indent := '' 1233 | else 1234 | Indent := PrefixNode; 1235 | 1236 | // Process child nodes 1237 | for Child in Node.ChildNodes do begin 1238 | Walk(Writer, Indent + IfThen(GetNodeAutoIndent, NodeIndentStr), Child); 1239 | if Child <> Node.ChildNodes.Last then 1240 | Writer.Write(',' + IfThen(not (joCompact in Options), LineBreak)); 1241 | end; 1242 | 1243 | case Node.NodeType of 1244 | jtObject: begin 1245 | if joCompact in Options then 1246 | Line:='}' 1247 | else 1248 | Line:=LineBreak + Indent + '}'; 1249 | SkipIndent:=True; 1250 | end; 1251 | jtArray: begin 1252 | if joCompact in Options then 1253 | Line:=']' 1254 | else 1255 | Line:=LineBreak + Indent + ']'; 1256 | SkipIndent:=True; 1257 | end; 1258 | else 1259 | Line:=''; 1260 | end; 1261 | 1262 | // If node has child nodes and last child node is not a text node then set indent for closing tag 1263 | if (Node.HasChildNodes) and (not SkipIndent) then 1264 | Indent := Line + ',' + LineBreak + PrefixNode 1265 | else 1266 | Indent := Line; 1267 | 1268 | if Indent <> '' then 1269 | Writer.Write(Indent); 1270 | end; 1271 | 1272 | class function TJSONVerySimple.Escape(const Value: TJSONString; const Enabled: Boolean = True): TJSONString; 1273 | var 1274 | sLen, sIndex: Integer; 1275 | begin 1276 | Result:=Value; 1277 | if not Enabled then 1278 | Exit; 1279 | // 1280 | sLen:=Length(Value); 1281 | sIndex := 1; 1282 | while sIndex <= sLen do begin 1283 | case Result[sIndex] of 1284 | '\': begin 1285 | Insert('\', Result, sIndex + 1); 1286 | Inc(sIndex, 1); 1287 | Inc(sLen, 1); 1288 | end; 1289 | #8: begin 1290 | Result[sIndex]:='\'; 1291 | Insert('b', Result, sIndex + 1); 1292 | Inc(sIndex, 1); 1293 | Inc(sLen, 1); 1294 | end; 1295 | #12: begin 1296 | Result[sIndex]:='\'; 1297 | Insert('f', Result, sIndex + 1); 1298 | Inc(sIndex, 1); 1299 | Inc(sLen, 1); 1300 | end; 1301 | #10: begin 1302 | Result[sIndex]:='\'; 1303 | Insert('n', Result, sIndex + 1); 1304 | Inc(sIndex, 1); 1305 | Inc(sLen, 1); 1306 | end; 1307 | #13: begin 1308 | Result[sIndex]:='\'; 1309 | Insert('r', Result, sIndex + 1); 1310 | Inc(sIndex, 1); 1311 | Inc(sLen, 1); 1312 | end; 1313 | #9: begin 1314 | Result[sIndex]:='\'; 1315 | Insert('t', Result, sIndex + 1); 1316 | Inc(sIndex, 1); 1317 | Inc(sLen, 1); 1318 | end; 1319 | '"': begin 1320 | Result[sIndex]:='\'; 1321 | Insert('"', Result, sIndex + 1); 1322 | Inc(sIndex, 1); 1323 | Inc(sLen, 1); 1324 | end; 1325 | '/': begin 1326 | Result[sIndex]:='\'; 1327 | Insert('/', Result, sIndex + 1); 1328 | Inc(sIndex, 1); 1329 | Inc(sLen, 1); 1330 | end; 1331 | end; 1332 | Inc(sIndex); 1333 | end; 1334 | end; 1335 | 1336 | class function TJSONVerySimple.Unescape(const Value: TJSONString; const Enabled: Boolean = True): TJSONString; 1337 | var 1338 | sLen, sIndex, iRes: Integer; 1339 | sTemp: TJSONString; 1340 | begin 1341 | Result:=Value; 1342 | if not Enabled then 1343 | Exit; 1344 | // 1345 | sLen:=Length(Value); 1346 | sIndex := 1; 1347 | while sIndex <= sLen do begin 1348 | case Result[sIndex] of 1349 | '\': begin 1350 | if sIndex + 1 <= sLen then begin 1351 | case Result[sIndex + 1] of 1352 | '\': begin 1353 | Delete(Result, sIndex, 1); 1354 | Dec(sLen, 1); 1355 | end; 1356 | '"': begin 1357 | Delete(Result, sIndex, 1); 1358 | Dec(sLen, 1); 1359 | end; 1360 | '/': begin 1361 | Delete(Result, sIndex, 1); 1362 | Dec(sLen, 1); 1363 | end; 1364 | 'b': begin 1365 | Delete(Result, sIndex, 1); 1366 | Result[sIndex]:=#8; 1367 | Dec(sLen, 1); 1368 | end; 1369 | 'f': begin 1370 | Delete(Result, sIndex, 1); 1371 | Result[sIndex]:=#12; 1372 | Dec(sLen, 1); 1373 | end; 1374 | 'n': begin 1375 | Delete(Result, sIndex, 1); 1376 | Result[sIndex]:=#10; 1377 | Dec(sLen, 1); 1378 | end; 1379 | 'r': begin 1380 | Delete(Result, sIndex, 1); 1381 | Result[sIndex]:=#13; 1382 | Dec(sLen, 1); 1383 | end; 1384 | 't': begin 1385 | Delete(Result, sIndex, 1); 1386 | Result[sIndex]:=#9; 1387 | Dec(sLen, 1); 1388 | end; 1389 | 'u': begin 1390 | Delete(Result, sIndex + 1, 1); 1391 | Dec(sLen, 1); 1392 | sTemp:=Copy(Result, sIndex + 1, 4); 1393 | try 1394 | Delete(Result, sIndex + 1, 4); 1395 | Dec(sLen, 4); 1396 | try 1397 | if not TryStrToInt('$' + sTemp, iRes) then 1398 | raise EJSONParseException.Create(Format('Invalid unicode \u%s', [sTemp])); 1399 | Result[sIndex]:=WideChar(iRes); 1400 | except 1401 | Dec(sLen, 1); 1402 | raise; 1403 | end; 1404 | finally 1405 | sTemp:=''; 1406 | end; 1407 | end; 1408 | end; 1409 | end; 1410 | end; 1411 | end; 1412 | Inc(sIndex); 1413 | end; 1414 | end; 1415 | 1416 | function TJSONVerySimple.ExtractText(var Line: TJSONString; const StopChars: TJSONString; Options: TJSONExtractTextOptions): TJSONString; 1417 | var 1418 | CharPos, FoundPos: Integer; 1419 | TestChar: Char; 1420 | begin 1421 | FoundPos := 0; 1422 | for TestChar in StopChars do begin 1423 | CharPos := Pos(TestChar, Line); 1424 | if (CharPos <> 0) and ((FoundPos = 0) or (CharPos < FoundPos)) then 1425 | FoundPos := CharPos; 1426 | end; 1427 | 1428 | if FoundPos <> 0 then begin 1429 | Dec(FoundPos); 1430 | Result := Copy(Line, 1, FoundPos); 1431 | if jetDeleteWithStopChar in Options then 1432 | Inc(FoundPos); 1433 | Delete(Line, 1, FoundPos); 1434 | end 1435 | else begin 1436 | Result := Line; 1437 | Line := ''; 1438 | end; 1439 | end; 1440 | 1441 | { TJSONNode } 1442 | 1443 | function TJSONNode.AddChild(const AName: TJSONString; ANodeType: TJSONNodeType): TJSONNode; 1444 | var 1445 | Last: TJSONNode; 1446 | begin 1447 | Last:=Nil; 1448 | try 1449 | if ChildNodes.Count > 0 then 1450 | Last:=ChildNodes.Last; 1451 | except 1452 | Last:=Nil; 1453 | end; 1454 | Result:=ChildNodes.Add(AName, ANodeType); 1455 | Result.FPrevSibling:=Nil; 1456 | Result.FNextSibling:=Nil; 1457 | if Last <> Nil then begin 1458 | Result.FPrevSibling:=Last; 1459 | Last.FNextSibling:=Result; 1460 | end; 1461 | end; 1462 | 1463 | function TJSONNode.RemoveChild(const Node: TJSONNode): Integer; 1464 | begin 1465 | Result:=Node.Index; 1466 | if Node.NextSibling <> Nil then 1467 | Node.NextSibling.FPrevSibling:=Node.PreviousSibling 1468 | else if Node.PreviousSibling <> Nil then // last node, so delete reference within previous node to this, which is about to be deleted 1469 | Node.PreviousSibling.FNextSibling:=Nil; 1470 | ChildNodes.Remove(Result); 1471 | end; 1472 | 1473 | function TJSONNode.MoveChild(const FromNode, ToNode: TJSONNode): TJSONNode; 1474 | begin 1475 | Result:=Nil; 1476 | if (ToNode <> Nil) and (FromNode <> Nil) then begin 1477 | ToNode.AddNodes(FromNode, True); 1478 | FromNode.ParentNode.RemoveChild(FromNode); 1479 | Result:=ToNode; 1480 | end; 1481 | end; 1482 | 1483 | procedure TJSONNode.AddNodes(const RootNode: TJSONNode; const AddRootNode: Boolean = False); 1484 | var 1485 | Child, Node: TJSONNode; 1486 | begin 1487 | Child:=Self; 1488 | if AddRootNode then begin 1489 | Child:=AddChild(RootNode.Name, RootNode.NodeType); 1490 | Child.Value:=RootNode.Value; 1491 | end; 1492 | for Node in RootNode.ChildNodes do // add all root node child nodes to child node 1493 | Child.AddNodes(Node, True); 1494 | end; 1495 | 1496 | procedure TJSONNode.Clear; 1497 | begin 1498 | Value := ''; 1499 | ChildNodes.Clear; 1500 | end; 1501 | 1502 | function TJSONNode.Empty: Boolean; 1503 | begin 1504 | Result := (not (NodeType in [jtObject, jtArray]) and (Length(NodeName) = 0) and (Length(NodeValue) = 0)) or 1505 | ((NodeType in [jtObject, jtArray]) and not HasChildNodes); 1506 | end; 1507 | 1508 | function TJSONNode.Null: Boolean; 1509 | begin 1510 | Result := (NodeType = jtNull) and (ValueAsString = 'null'); 1511 | end; 1512 | 1513 | constructor TJSONNode.Create(ANodeType: TJSONNodeType); 1514 | begin 1515 | ChildNodes := TJSONNodeList.Create; 1516 | ChildNodes.Parent := Self; 1517 | NodeType := ANodeType; 1518 | Name:=''; 1519 | Value:=''; 1520 | FLevel:=0; 1521 | FIndex:=0; 1522 | end; 1523 | 1524 | destructor TJSONNode.Destroy; 1525 | begin 1526 | Clear; 1527 | ChildNodes.Free; 1528 | inherited; 1529 | end; 1530 | 1531 | procedure TJSONNode.Assign(const Node: TJSONNode); 1532 | begin 1533 | NodeName :=Node.NodeName; 1534 | NodeType :=Node.NodeType; 1535 | NodeValue:=Node.NodeValue; 1536 | AddNodes(Node); 1537 | end; 1538 | 1539 | 1540 | function TJSONNode.IsSame(const Value1, Value2: TJSONString): Boolean; 1541 | begin 1542 | Result := ((Assigned(Document) and Document.IsSame(Value1, Value2)) or // use the documents text comparison 1543 | ((not Assigned(Document)) and (CompareText(Value1, Value2) = 0))); // or if not Assigned then compare names case sensitive 1544 | end; 1545 | 1546 | { 1547 | function RecursiveFindNode(ANode: IJSONNode; const SearchNodeName: TJSONString): IJSONNode; 1548 | var 1549 | I: Integer; 1550 | begin 1551 | if CompareText(ANode.NodeName, SearchNodeName) = 0 then 1552 | Result := ANode 1553 | else if not Assigned(ANode.ChildNodes) then 1554 | Result := nil 1555 | else begin 1556 | for I := 0 to ANode.ChildNodes.Count - 1 do 1557 | begin 1558 | Result := RecursiveFindNode(ANode.ChildNodes[I], SearchNodeName); 1559 | if Assigned(Result) then 1560 | Exit; 1561 | end; 1562 | end; 1563 | end; 1564 | } 1565 | 1566 | function TJSONNode.FindNodeRecursive(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []; const SearchOptions: TJSONNodeSearchTypes = []): TJSONNode; 1567 | var 1568 | Node: TJSONNode; 1569 | begin 1570 | Result:=Nil; 1571 | for Node in ChildNodes do begin 1572 | if ((NodeTypes = []) or (Node.NodeType in NodeTypes)) and IsSame(Node.Name, Name) then begin 1573 | Result:=Node; 1574 | Exit; 1575 | end; 1576 | if Node.HasChildNodes then begin 1577 | Result:=Node.FindNodeRecursive(Name, NodeTypes); 1578 | if Result <> Nil then 1579 | Exit; 1580 | end; 1581 | end; 1582 | end; 1583 | 1584 | function TJSONNode.FindNodeRecursive(const Name, Value: TJSONString; NodeTypes: TJSONNodeTypes = []; const SearchOptions: TJSONNodeSearchTypes = []): TJSONNode; 1585 | var 1586 | Node: TJSONNode; 1587 | begin 1588 | Result:=Nil; 1589 | for Node in ChildNodes do begin 1590 | if ((NodeTypes = []) or (Node.NodeType in NodeTypes)) and // if no type specified or node type in types 1591 | ((Name = '') or ((Name <> '') and IsSame(Node.Name, Name))) and IsSame(Node.Value, Value) then begin 1592 | Result:=Node; 1593 | Exit; 1594 | end; 1595 | if Node.HasChildNodes then begin 1596 | Result:=Node.FindNodeRecursive(Name, Value, NodeTypes); 1597 | if Result <> Nil then 1598 | Exit; 1599 | end; 1600 | end; 1601 | end; 1602 | 1603 | { 1604 | function TJSONNode.FindNodeRecursive(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []): TJSONNodeList; 1605 | begin 1606 | Result := ChildNodes.FindNodes(Name, NodeTypes); 1607 | end; 1608 | } 1609 | 1610 | function TJSONNode.FindNode(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []; const SearchOptions: TJSONNodeSearchTypes = []): TJSONNode; 1611 | begin 1612 | if ((NodeTypes = []) or (Self.NodeType in NodeTypes)) and IsSame(Self.Name, Name) then begin 1613 | Result := Self; 1614 | Exit; 1615 | end; 1616 | Result := ChildNodes.Find(Name, NodeTypes); 1617 | if (Result = Nil) and (jsRecursive in SearchOptions) then 1618 | Result:=FindNodeRecursive(Name, NodeTypes, SearchOptions); 1619 | end; 1620 | 1621 | function TJSONNode.FindNode(const Name, Value: TJSONString; NodeTypes: TJSONNodeTypes = []; const SearchOptions: TJSONNodeSearchTypes = []): TJSONNode; 1622 | begin 1623 | if ((NodeTypes = []) or (Self.NodeType in NodeTypes)) and 1624 | ((Name = '') or ((Name <> '') and IsSame(Self.Name, Name))) and 1625 | IsSame(Self.Value, Value) then begin 1626 | Result := Self; 1627 | Exit; 1628 | end; 1629 | Result := ChildNodes.Find(Name, Value, NodeTypes); 1630 | if (Result = Nil) and (jsRecursive in SearchOptions) then 1631 | Result:=FindNodeRecursive(Name, Value, NodeTypes, SearchOptions); 1632 | end; 1633 | 1634 | function TJSONNode.FindNodes(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []): TJSONNodeList; 1635 | begin 1636 | Result := ChildNodes.FindNodes(Name, NodeTypes); 1637 | end; 1638 | 1639 | procedure TJSONNode.ScanNodes(Name: TJSONString; CallBack: TJSONNodeCallBack); 1640 | var 1641 | Node: TJSONNode; 1642 | Loop: Boolean; 1643 | begin 1644 | Name := lowercase(Name); 1645 | Loop := True; 1646 | for Node in ChildNodes do 1647 | if (Name = '') or ((Name <> '') and (CompareText(Node.Name, Name) = 0)) then begin 1648 | CallBack(Node, Loop); 1649 | if not Loop then // break the loop if Result is False 1650 | Break; 1651 | end; 1652 | end; 1653 | 1654 | function TJSONNode.FirstChild: TJSONNode; 1655 | begin 1656 | if ChildNodes.Count > 0 then 1657 | Result := ChildNodes.First 1658 | else 1659 | Result := Nil; 1660 | end; 1661 | 1662 | function TJSONNode.HasChild(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []): Boolean; 1663 | begin 1664 | Result := ChildNodes.HasNode(Name, NodeTypes); 1665 | end; 1666 | 1667 | function TJSONNode.HasChildNodes: Boolean; 1668 | begin 1669 | Result := (ChildNodes.Count > 0); 1670 | end; 1671 | 1672 | function TJSONNode.InsertChild(const Name: TJSONString; Position: Integer; NodeType: TJSONNodeType): TJSONNode; 1673 | begin 1674 | Result := ChildNodes.Insert(Name, Position, NodeType); 1675 | if Assigned(Result) then 1676 | Result.ParentNode := Self; 1677 | end; 1678 | 1679 | function TJSONNode.LastChild: TJSONNode; 1680 | begin 1681 | if ChildNodes.Count > 0 then 1682 | Result := ChildNodes.Last 1683 | else 1684 | Result := NIL; 1685 | end; 1686 | 1687 | function TJSONNode.PreviousSibling: TJSONNode; 1688 | begin 1689 | Result:=FPrevSibling; 1690 | end; 1691 | 1692 | function TJSONNode.NextSibling: TJSONNode; 1693 | begin 1694 | Result:=FNextSibling; 1695 | end; 1696 | 1697 | procedure TJSONNode.SetDocument(AValue: TJSONVerySimple); 1698 | begin 1699 | FDocument := AValue; 1700 | ChildNodes.Document := AValue; 1701 | end; 1702 | 1703 | function TJSONNode.GetName: TJSONString; 1704 | begin 1705 | // Result:=TJSONVerySimple.Escape(FName); 1706 | Result:=FName; 1707 | end; 1708 | 1709 | function TJSONNode.GetNodeTypeAsString: String; 1710 | begin 1711 | Result := ''; 1712 | case FNodeType of 1713 | jtObject : Result:='Object'; 1714 | jtArray : Result:='Array'; 1715 | jtString : Result:='String'; 1716 | jtNumber : Result:='Number'; 1717 | jtBoolean: Result:='Boolean'; 1718 | jtNull : Result:='Null'; 1719 | end; 1720 | end; 1721 | 1722 | function TJSONNode.GetValue: TJSONString; 1723 | begin 1724 | // Result:=TJSONVerySimple.Escape(FValue); 1725 | Result:=FValue; 1726 | end; 1727 | 1728 | function TJSONNode.GetValueAsBoolean: Boolean; 1729 | begin 1730 | Result:=False; 1731 | if Self = Nil then 1732 | Exit; 1733 | // 1734 | if (FValue <> '') and (FValue <> '0') and (LowerCase(FValue) <> 'false') and (FValue <> '1') and (LowerCase(FValue) <> 'true') then 1735 | raise EJSONNodeException.CreateFmt(sNodeTypeConvertError, [GetNodeTypeAsString, 'Boolean (True/False)']); 1736 | // 1737 | if (FValue = '1') or (LowerCase(FValue) = 'true') then 1738 | Result:=True; 1739 | end; 1740 | 1741 | function TJSONNode.GetValueAsInteger: Integer; 1742 | var 1743 | number: Extended; 1744 | error: Integer; 1745 | begin 1746 | Result:=0; 1747 | if Self = Nil then 1748 | Exit; 1749 | // 1750 | Val(FValue, number, error); 1751 | if error <> 0 then 1752 | raise EJSONNodeException.CreateFmt(sNodeTypeConvertError, [GetNodeTypeAsString, 'Integer']); 1753 | // 1754 | Result:=Integer(Trunc(number)); 1755 | end; 1756 | 1757 | function TJSONNode.GetValueAsInt64: Int64; 1758 | var 1759 | number: Extended; 1760 | error: Integer; 1761 | begin 1762 | Result:=0; 1763 | if Self = Nil then 1764 | Exit; 1765 | // 1766 | Val(FValue, number, error); 1767 | if error <> 0 then 1768 | raise EJSONNodeException.CreateFmt(sNodeTypeConvertError, [GetNodeTypeAsString, 'Int64']); 1769 | // 1770 | Result:=Trunc(number); 1771 | end; 1772 | 1773 | function TJSONNode.GetValueAsFloat: Double; 1774 | var 1775 | // number: Extended; 1776 | number: Double; 1777 | error: Integer; 1778 | begin 1779 | Result:=0.0; 1780 | if Self = Nil then 1781 | Exit; 1782 | // 1783 | Val(FValue, number, error); 1784 | if error <> 0 then 1785 | raise EJSONNodeException.CreateFmt(sNodeTypeConvertError, [GetNodeTypeAsString, 'Double']); 1786 | // 1787 | Result:=number; 1788 | end; 1789 | 1790 | function TJSONNode.GetValueAsString: TJSONString; 1791 | var 1792 | number: Extended; 1793 | error: Integer; 1794 | begin 1795 | Result:=''; 1796 | if Self = Nil then 1797 | Exit; 1798 | // 1799 | case FNodeType of 1800 | jtObject, 1801 | jtArray : begin 1802 | // don't know what to do with this for now 1803 | end; 1804 | jtString: begin 1805 | Result:=TJSONVerySimple.Unescape(FValue); 1806 | Exit; 1807 | end; 1808 | jtNumber: begin 1809 | if FValue <> '' then begin 1810 | Val(FValue, number, error); 1811 | if error <> 0 then 1812 | raise EJSONNodeException.CreateFmt(sNodeTypeConvertError, ['Number', 'String']); 1813 | end; 1814 | end; 1815 | jtBoolean: begin 1816 | if (FValue <> '') and (LowerCase(FValue) <> 'false') and (LowerCase(FValue) <> 'true') then 1817 | raise EJSONNodeException.CreateFmt(sNodeValueError, ['Boolean (True/False)', FValue]) 1818 | else if FValue = '' then 1819 | Result:='false' 1820 | else 1821 | Result:=FValue; 1822 | end; 1823 | jtNull: begin 1824 | if (FValue <> '') and (LowerCase(FValue) <> 'null') then 1825 | raise EJSONNodeException.CreateFmt(sNodeValueError, ['Null', FValue]) 1826 | else if FValue = '' then 1827 | Result:='null' 1828 | else 1829 | Result:=FValue; 1830 | end; 1831 | end; 1832 | end; 1833 | 1834 | procedure TJSONNode.SetName(AValue: TJSONString); 1835 | begin 1836 | FName:=TJSONVerySimple.Unescape(AValue); 1837 | end; 1838 | 1839 | procedure TJSONNode.SetValue(AValue: TJSONString); 1840 | var 1841 | // temp: TJSONString; 1842 | number: Extended; 1843 | error: Integer; 1844 | begin 1845 | case FNodeType of 1846 | jtObject, 1847 | jtArray : begin 1848 | if AValue <> '' then 1849 | raise EJSONNodeException.CreateFmt(sNodeValueError, ['Nothing', AValue]); 1850 | end; 1851 | jtString: begin 1852 | FValue:=TJSONVerySimple.Unescape(AValue); 1853 | Exit; 1854 | end; 1855 | jtNumber: begin 1856 | if AValue <> '' then begin 1857 | Val(AValue, number, error); 1858 | if error <> 0 then 1859 | raise EJSONNodeException.CreateFmt(sNodeValueError, ['Number', AValue]); 1860 | end; 1861 | end; 1862 | jtBoolean: begin 1863 | if (AValue <> '') and (LowerCase(AValue) <> 'false') and (LowerCase(AValue) <> 'true') then 1864 | raise EJSONNodeException.CreateFmt(sNodeValueError, ['Boolean (True/False)', AValue]) 1865 | else if AValue = '' then 1866 | AValue:='false'; 1867 | end; 1868 | jtNull: begin 1869 | if (AValue <> '') and (LowerCase(AValue) <> 'null') then 1870 | raise EJSONNodeException.CreateFmt(sNodeValueError, ['Null', AValue]) 1871 | else if AValue = '' then 1872 | AValue:='null'; 1873 | end; 1874 | end; 1875 | FValue:=AValue; 1876 | end; 1877 | 1878 | procedure TJSONNode.SetValueAsBoolean(AValue: Boolean); 1879 | begin 1880 | if FNodeType <> jtBoolean then 1881 | raise EJSONNodeException.CreateFmt(sNodeTypeError, [GetNodeTypeAsString, 'Boolean (True/False)']); 1882 | // 1883 | NodeValue:=BooleanToNodeValue(AValue); 1884 | end; 1885 | 1886 | procedure TJSONNode.SetValueAsInteger(AValue: Integer); 1887 | begin 1888 | if (FNodeType <> jtNumber) and (FNodeType <> jtBoolean) then 1889 | raise EJSONNodeException.CreateFmt(sNodeTypeError, [GetNodeTypeAsString, 'Integer']); 1890 | if (FNodeType = jtBoolean) and not (AValue in [0, 1]) then 1891 | raise EJSONNodeException.CreateFmt(sNodeTypeError, [GetNodeTypeAsString, 'Integer']); 1892 | // 1893 | if FNodeType = jtBoolean then 1894 | SetValueAsBoolean(Boolean(AValue)) 1895 | else 1896 | NodeValue:=IntToStr(AValue); 1897 | end; 1898 | 1899 | procedure TJSONNode.SetValueAsInt64(AValue: Int64); 1900 | begin 1901 | if (FNodeType <> jtNumber) and (FNodeType <> jtBoolean) then 1902 | raise EJSONNodeException.CreateFmt(sNodeTypeError, [GetNodeTypeAsString, 'Integer']); 1903 | if (FNodeType = jtBoolean) and not (AValue in [0, 1]) then 1904 | raise EJSONNodeException.CreateFmt(sNodeTypeError, [GetNodeTypeAsString, 'Integer']); 1905 | // 1906 | if FNodeType = jtBoolean then 1907 | SetValueAsBoolean(Boolean(AValue)) 1908 | else 1909 | NodeValue:=IntToStr(AValue); 1910 | end; 1911 | 1912 | procedure TJSONNode.SetValueAsFloat(AValue: Double); 1913 | var 1914 | fs: TFormatSettings; 1915 | begin 1916 | if FNodeType <> jtNumber then 1917 | raise EJSONNodeException.CreateFmt(sNodeTypeError, [GetNodeTypeAsString, 'Double']); 1918 | // 1919 | {$IF CompilerVersion > 29} 1920 | fs:=TFormatSettings.Create; 1921 | {$ELSE} 1922 | GetLocaleFormatSettings(0, fs); 1923 | {$IFEND} 1924 | fs.CurrencyDecimals:=2; 1925 | fs.ThousandSeparator:=#0; 1926 | fs.DecimalSeparator:='.'; 1927 | NodeValue:=FloatToStr(AValue, fs); 1928 | end; 1929 | 1930 | procedure TJSONNode.SetValueAsString(AValue: TJSONString); 1931 | begin 1932 | if FNodeType <> jtString then 1933 | raise EJSONNodeException.CreateFmt(sNodeTypeError, [GetNodeTypeAsString, 'String']); 1934 | // 1935 | NodeValue:=AValue; 1936 | end; 1937 | 1938 | procedure TJSONNode._SetNodeType(const Value: TJSONNodeType); 1939 | begin 1940 | FNodeType := Value; 1941 | 1942 | if (Value = jtObject) or (Value = jtArray) or (Value = jtBoolean) then 1943 | NodeValue:='' 1944 | // else if Value = jtTrue then 1945 | // NodeValue:='true' 1946 | // else if Value = jtFalse then 1947 | // NodeValue:='false' 1948 | else if Value = jtNull then 1949 | NodeValue:='null'; 1950 | end; 1951 | 1952 | function TJSONNode.SetNodeType(const Value: TJSONNodeType): TJSONNode; 1953 | begin 1954 | _SetNodeType(Value); 1955 | Result := Self; 1956 | end; 1957 | 1958 | function TJSONNode.SetText(const AValue: TJSONString): TJSONNode; 1959 | begin 1960 | Value := AValue; 1961 | Result := Self; 1962 | end; 1963 | 1964 | { TJSONNodeList } 1965 | 1966 | function TJSONNodeList.Find(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []): TJSONNode; 1967 | var 1968 | Node: TJSONNode; 1969 | begin 1970 | Result := NIL; 1971 | for Node in Self do 1972 | if ((NodeTypes = []) or (Node.NodeType in NodeTypes)) and IsSame(Node.Name, Name) then begin 1973 | Result := Node; 1974 | Break; 1975 | end; 1976 | end; 1977 | 1978 | function TJSONNodeList.Add(Value: TJSONNode): Integer; 1979 | var 1980 | Index: Integer; 1981 | begin 1982 | Index:=-1; 1983 | try 1984 | if Count > 0 then 1985 | Index:=Last.Index; 1986 | except 1987 | Index:=-1; 1988 | end; 1989 | Result := inherited Add(Value); 1990 | Value.ParentNode := Parent; 1991 | Value.FLevel := Parent.Level + 1; 1992 | Value.FIndex := Index + 1; 1993 | end; 1994 | 1995 | function TJSONNodeList.Add(Value: TJSONNode; ParentNode: TJSONNode): Integer; 1996 | begin 1997 | Parent:=ParentNode; 1998 | Result:=Add(Value); 1999 | end; 2000 | 2001 | function TJSONNodeList.Add(NodeType: TJSONNodeType): TJSONNode; 2002 | begin 2003 | Result := TJSONNode.Create(NodeType); 2004 | try 2005 | Add(Result); 2006 | except 2007 | Result.Free; 2008 | raise; 2009 | end; 2010 | Result.Document := Document; 2011 | end; 2012 | 2013 | function TJSONNodeList.Add(const Name: TJSONString; NodeType: TJSONNodeType): TJSONNode; 2014 | begin 2015 | Result := Add(NodeType); 2016 | Result.Name := Name; 2017 | end; 2018 | 2019 | procedure TJSONNodeList.Add(const List: TJSONNodeList); 2020 | var 2021 | Node: TJSONNode; 2022 | begin 2023 | for Node in List do begin // add all items to list 2024 | Self.Add(Node, Node.ParentNode); 2025 | end; 2026 | end; 2027 | 2028 | function TJSONNodeList.CountNames(const Name: TJSONString; var NodeList: TJSONNodeList): Integer; 2029 | begin 2030 | NodeList:=FindNodes(Name, []); 2031 | Result:=NodeList.Count; 2032 | end; 2033 | 2034 | function TJSONNodeList.Find(const Name, Value: TJSONString; NodeTypes: TJSONNodeTypes = []): TJSONNode; 2035 | var 2036 | Node: TJSONNode; 2037 | begin 2038 | Result := NIL; 2039 | for Node in Self do 2040 | if ((NodeTypes = []) or (Node.NodeType in NodeTypes)) and // if no type specified or node type in types 2041 | ((Name = '') or ((Name <> '') and IsSame(Node.Name, Name))) and 2042 | IsSame(Node.Value, Value) then begin 2043 | Result := Node; 2044 | Break; 2045 | end; 2046 | end; 2047 | 2048 | function TJSONNodeList.FindNode(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []): TJSONNode; 2049 | begin 2050 | Result := Find(Name, NodeTypes); 2051 | end; 2052 | 2053 | function TJSONNodeList.FindNodes(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []): TJSONNodeList; 2054 | var 2055 | Node: TJSONNode; 2056 | begin 2057 | Result := TJSONNodeList.Create(False); 2058 | Result.Document := Document; 2059 | try 2060 | for Node in Self do 2061 | if ((NodeTypes = []) or (Node.NodeType in NodeTypes)) and IsSame(Node.Name, Name) then begin 2062 | Result.Parent := Node.ParentNode; 2063 | Result.Add(Node); 2064 | end; 2065 | Result.Parent := NIL; 2066 | except 2067 | Result.Free; 2068 | raise; 2069 | end; 2070 | end; 2071 | 2072 | function TJSONNodeList.FirstChild: TJSONNode; 2073 | begin 2074 | Result := First; 2075 | end; 2076 | 2077 | function TJSONNodeList.LastChild: TJSONNode; 2078 | begin 2079 | Result := Last; 2080 | end; 2081 | 2082 | function TJSONNodeList.Get(Index: Integer): TJSONNode; 2083 | begin 2084 | Result := Items[Index]; 2085 | end; 2086 | 2087 | function TJSONNodeList.Get(Name: TJSONString): TJSONNode; 2088 | begin 2089 | Result := Find(Name); 2090 | if Result = Nil then 2091 | raise EJSONException.CreateFmt(sNodeNotFound, [Name]); 2092 | end; 2093 | 2094 | function TJSONNodeList.HasNode(const Name: TJSONString; NodeTypes: TJSONNodeTypes = []): Boolean; 2095 | begin 2096 | Result := Assigned(Find(Name, NodeTypes)); 2097 | end; 2098 | 2099 | function TJSONNodeList.Insert(const Name: TJSONString; Position: Integer; NodeType: TJSONNodeType): TJSONNode; 2100 | var 2101 | Node, NodeBefore: TJSONNode; 2102 | Index: Integer; 2103 | begin 2104 | try 2105 | Node:=Get(Position); 2106 | except 2107 | Node:=Nil; 2108 | end; 2109 | Index:=0; 2110 | if Node <> Nil then 2111 | Index:=Node.Index; 2112 | Result := TJSONNode.Create(NodeType); 2113 | Result.Name := Name; 2114 | Result.FLevel := Parent.Level + 1; 2115 | Result.Document := Document; 2116 | try 2117 | Insert(Position, Result); 2118 | Result.FIndex := Index; 2119 | if Position > 0 then try 2120 | NodeBefore:=Get(Position - 1); 2121 | Result.FPrevSibling := NodeBefore; 2122 | NodeBefore.FNextSibling := Result; 2123 | except 2124 | // discard this 2125 | end; 2126 | if Node <> Nil then begin 2127 | Result.FNextSibling := Node; 2128 | Node.FPrevSibling := Result; 2129 | end; 2130 | // reindex nodes 2131 | while Node <> Nil do begin 2132 | Node.FIndex:=Index + 1; 2133 | Inc(Index); 2134 | Node:=Node.NextSibling; 2135 | end; 2136 | except 2137 | Result.Free; 2138 | raise; 2139 | end; 2140 | end; 2141 | 2142 | procedure TJSONNodeList.Remove(Index: Integer); 2143 | var 2144 | Node: TJSONNode; 2145 | begin 2146 | if Index >= 0 then begin 2147 | try 2148 | Node:=Get(Index); 2149 | except 2150 | Node:=Nil; 2151 | end; 2152 | if Node <> Nil then 2153 | Node:=Node.NextSibling; 2154 | Delete(Index); 2155 | // reindex nodes 2156 | while Node <> Nil do begin 2157 | Node.FIndex:=Index; 2158 | Inc(Index); 2159 | Node:=Node.NextSibling; 2160 | end; 2161 | end; 2162 | end; 2163 | 2164 | function TJSONNodeList.IsSame(const Value1, Value2: TJSONString): Boolean; 2165 | begin 2166 | Result := ((Assigned(Document) and Document.IsSame(Value1, Value2)) or // use the documents text comparison 2167 | ((not Assigned(Document)) and (Value1 = Value2))); // or if not Assigned then compare names case sensitive 2168 | end; 2169 | 2170 | function TJSONNodeList.PreviousSibling(Node: TJSONNode): TJSONNode; 2171 | begin 2172 | Result:=Node.PreviousSibling; 2173 | end; 2174 | 2175 | function TJSONNodeList.NextSibling(Node: TJSONNode): TJSONNode; 2176 | begin 2177 | Result:=Node.NextSibling; 2178 | end; 2179 | 2180 | { TStreamWriterHelper } 2181 | 2182 | constructor TStreamWriterHelper.Create(Stream: TStream; Encoding: TEncoding; WritePreamble: Boolean; BufferSize: Integer); 2183 | begin 2184 | Create(Stream, Encoding, BufferSize); 2185 | if not WritePreamble then begin 2186 | Self.BaseStream.Position:=0; 2187 | Self.BaseStream.Size:=0; 2188 | end; 2189 | end; 2190 | 2191 | constructor TStreamWriterHelper.Create(Filename: string; Append: Boolean; Encoding: TEncoding; WritePreamble: Boolean; 2192 | BufferSize: Integer); 2193 | begin 2194 | Create(Filename, Append, Encoding, BufferSize); 2195 | if not WritePreamble then begin 2196 | Self.BaseStream.Position:=0; 2197 | Self.BaseStream.Size:=0; 2198 | end; 2199 | end; 2200 | 2201 | { TJSONPathEvaluator } 2202 | 2203 | constructor TJSONPathEvaluator.Create; 2204 | begin 2205 | FExpression:=''; 2206 | FExpressionPos:=0; 2207 | FNodeDelimiter:='.'; 2208 | end; 2209 | 2210 | function TJSONPathEvaluator.GetPredicateIndex(const Predicate: String; out Index: Integer): Boolean; 2211 | var 2212 | code: Integer; 2213 | begin 2214 | Val(Predicate, Index, code); 2215 | Result:=(code = 0); // [n] 2216 | end; 2217 | 2218 | procedure TJSONPathEvaluator.GetChildNodes(List: TJSONNodeList; Node: TJSONNode; const Element: String; Recurse: Boolean); 2219 | var 2220 | matchAll: Boolean; 2221 | i: Integer; 2222 | nodeList: TJSONNodeList; 2223 | item: TObject; 2224 | child: TJSONNode; 2225 | begin 2226 | matchAll:=(Element = '*'); 2227 | nodeList:=Node.ChildNodes; 2228 | // 2229 | for i:=0 to nodeList.Count - 1 do begin 2230 | item:=nodeList.Items[i]; 2231 | if (matchAll or (TJSONNode(item).NodeName = Element)) then begin 2232 | List.Add(TJSONNode(item), TJSONNode(item).ParentNode); 2233 | end; 2234 | 2235 | if Recurse then 2236 | GetChildNodes(List, TJSONNode(item), Element, True); 2237 | end; 2238 | 2239 | // if recursion is on and we were iterating over attributes, we must also check child nodes 2240 | if Recurse then begin 2241 | for i:=0 to Node.ChildNodes.Count - 1 do begin 2242 | child:=Node.ChildNodes.Get(i); 2243 | GetChildNodes(List, child, Element, True); 2244 | end; 2245 | end; 2246 | end; 2247 | 2248 | procedure TJSONPathEvaluator.EvaluateNode(List: TJSONNodeList; Node: TJSONNode; Element, Predicate: String; Flags: TJSONPathSelectionFlags; out BreakLoop: Boolean); 2249 | var 2250 | temp_list: TJSONNodeList; 2251 | begin 2252 | if Element = '.' then 2253 | List.Add(Node, Node.ParentNode) 2254 | else if Element = '..' then begin 2255 | if Assigned(Node.ParentNode) then 2256 | List.Add(Node.ParentNode, Node.ParentNode.ParentNode); 2257 | end 2258 | else begin 2259 | temp_list:=TJSONNodeList.Create(False); 2260 | temp_list.Document:=List.Document; 2261 | try 2262 | if (Length(Element) > 0) and (Element[1] = '@') then begin 2263 | Delete(Element, 1, 1); 2264 | end; 2265 | if Length(Element) > 0 then 2266 | GetChildNodes(temp_list, Node, Element, selScanTree in Flags) 2267 | else 2268 | temp_list.Add(Node, Node.ParentNode); 2269 | 2270 | FilterNodes(temp_list, List, Predicate, BreakLoop); 2271 | finally 2272 | temp_list.Free; 2273 | end; 2274 | end; 2275 | end; 2276 | 2277 | procedure TJSONPathEvaluator.EvaluatePart(SrcList, DestList: TJSONNodeList; const Element, Predicate: String; Flags: TJSONPathSelectionFlags); 2278 | var 2279 | i: Integer; 2280 | BreakLoop: Boolean; 2281 | Node: TJSONNode; 2282 | begin 2283 | DestList.Clear; 2284 | BreakLoop:=False; 2285 | if (Length(Predicate) > 0) and GetPredicateIndex(Predicate, i) then begin // [n] 2286 | if (i > 0) and (i <= SrcList.Count) then begin 2287 | Node:=SrcList.Get(i - 1); 2288 | DestList.Add(Node, Node.ParentNode); 2289 | end 2290 | else 2291 | raise EJSONPathException.CreateFmt('Invalid predicate index [%s]', [Predicate]); 2292 | end 2293 | else begin 2294 | for i:=0 to SrcList.Count - 1 do begin 2295 | EvaluateNode(DestList, SrcList.Get(i), Element, Predicate, Flags, BreakLoop); 2296 | if BreakLoop then 2297 | Break; 2298 | end; 2299 | end; 2300 | end; 2301 | 2302 | procedure TJSONPathEvaluator.FilterByAttrib(SrcList, DestList: TJSONNodeList; const AttrName, AttrValue: String; const NotEQ: Boolean); 2303 | var 2304 | Node: TJSONNode; 2305 | i: Integer; 2306 | matchAnyValue: Boolean; 2307 | begin 2308 | matchAnyValue:=(AttrValue = '*'); 2309 | for i:=0 to SrcList.Count - 1 do begin 2310 | Node:=SrcList.Get(i); 2311 | if (Node <> Nil) and (matchAnyValue or ((Node.NodeValue = AttrValue) xor NotEQ)) then 2312 | DestList.Add(Node, Node.ParentNode); 2313 | end; 2314 | end; 2315 | 2316 | procedure TJSONPathEvaluator.FilterByChild(SrcList, DestList: TJSONNodeList; const ChildName, ChildValue: String); 2317 | 2318 | function GetTextChild(Node: TJSONNode): TJSONNode; 2319 | var 2320 | i: Integer; 2321 | begin 2322 | Result:=Nil; 2323 | if Node = Nil then 2324 | Exit; 2325 | for i:=0 to Node.ChildNodes.Count - 1 do begin 2326 | if Node.ChildNodes.Get(i).NodeType >= jtString then begin 2327 | Result:=Node.ChildNodes.Get(i); 2328 | Break; 2329 | end; 2330 | end; 2331 | end; 2332 | 2333 | var 2334 | Node: TJSONNode; 2335 | i: Integer; 2336 | matchAnyValue: Boolean; 2337 | begin 2338 | matchAnyValue:=(childValue = '*'); 2339 | for i:=0 to SrcList.Count - 1 do begin 2340 | Node:=SrcList.Get(i).FindNode(childName); 2341 | if Node <> Nil then begin 2342 | if matchAnyValue then 2343 | DestList.Add(Node, Node.ParentNode) 2344 | else begin 2345 | Node:=GetTextChild(Node); 2346 | if Assigned(Node) and (Node.NodeValue = ChildValue) then 2347 | DestList.Add(Node, Node.ParentNode); 2348 | end; 2349 | end; 2350 | end; 2351 | end; 2352 | 2353 | procedure TJSONPathEvaluator.FilterByFunction(SrcList, DestList: TJSONNodeList; ChildName, ChildValue: String); 2354 | var 2355 | Node: TJSONNode; 2356 | i: Integer; 2357 | code: Integer; 2358 | idx: Integer; 2359 | begin 2360 | Node:=Nil; 2361 | ChildName:=LowerCase(ChildName); 2362 | if ChildName = 'first()' then 2363 | Node:=SrcList.FirstChild 2364 | else if ChildName = 'last()' then 2365 | Node:=SrcList.LastChild; 2366 | 2367 | if Length(ChildValue) > 0 then begin // get index 2368 | if GetPredicateIndex(ChildValue, idx) then begin // [n] 2369 | i:=-1; 2370 | if Node <> Nil then begin 2371 | i:=Node.Index; 2372 | Inc(i, idx); 2373 | end; 2374 | 2375 | if (i < 0) or (i >= SrcList.Count) then 2376 | raise EJSONPathException.CreateFmt('Invalid predicate index [%s]', [ChildName + ChildValue]); 2377 | 2378 | Node:=Node.ParentNode.ChildNodes.Get(i); 2379 | end 2380 | else 2381 | raise EJSONPathException.CreateFmt('Unsupported predicate expression [%s]', [ChildName + ChildValue]); 2382 | end; 2383 | 2384 | if Node <> Nil then 2385 | DestList.Add(Node, Node.ParentNode); 2386 | end; 2387 | 2388 | procedure TJSONPathEvaluator.FilterNodes(SrcList, DestList: TJSONNodeList; Predicate: String; out BreakLoop: Boolean); 2389 | 2390 | procedure Error; 2391 | begin 2392 | raise EJSONPathException.CreateFmt('Unsupported operator [%s]', [Predicate]); 2393 | end; 2394 | 2395 | var 2396 | code: Integer; 2397 | idx: Integer; 2398 | left, op, right: String; 2399 | is_attrib: Boolean; 2400 | Node: TJSONNode; 2401 | begin 2402 | BreakLoop:=False; 2403 | if Length(Predicate) = 0 then 2404 | DestList.Add(SrcList) 2405 | else begin 2406 | if GetPredicateIndex(Predicate, idx) then begin 2407 | if (idx > 0) and (idx <= SrcList.Count) then begin 2408 | Node:=SrcList.Get(idx - 1); 2409 | DestList.Add(Node, Node.ParentNode); 2410 | BreakLoop:=True; 2411 | end 2412 | else 2413 | raise EJSONPathException.CreateFmt('Invalid predicate index [%s]', [Predicate]); 2414 | end 2415 | else if (Length(Predicate) > 0) then begin 2416 | is_attrib:=False; 2417 | SplitExpression(Predicate, left, op, right); 2418 | if Predicate[1] = '@' then begin 2419 | is_attrib:=True; 2420 | Delete(left, 1, 1); 2421 | end; 2422 | // 2423 | if not is_attrib then begin 2424 | if Pos('()', left) > 0 then // [internal function] 2425 | FilterByFunction(SrcList, DestList, left, op + right) 2426 | else if Length(op) = 0 then // [node] 2427 | FilterByChild(SrcList, DestList, left, '*') 2428 | else if (Length(op) > 0) and (op = '=') then // [node='test'] 2429 | FilterByChild(SrcList, DestList, left, right) 2430 | else 2431 | Error; 2432 | end 2433 | else begin 2434 | if Length(op) = 0 then // [@attrib] 2435 | FilterByAttrib(SrcList, DestList, left, '*', False) 2436 | else if (Length(op) > 0) and ((op = '=') or (op = '!=')) then // [@attrib='x'] 2437 | FilterByAttrib(SrcList, DestList, left, right, (op = '!=')) 2438 | else 2439 | Error; 2440 | end; 2441 | end; 2442 | end; 2443 | end; 2444 | 2445 | function TJSONPathEvaluator.GetNextExpressionPart(var Element, Predicate: String; var Flags: TJSONPathSelectionFlags): Boolean; 2446 | var 2447 | endElement: Integer; 2448 | pEndPredicate: Integer; 2449 | pPredicate: Integer; 2450 | begin 2451 | if FExpressionPos > Length(FExpression) then 2452 | Result:=False 2453 | else begin 2454 | Flags:=[]; 2455 | if FExpression[FExpressionPos] = FNodeDelimiter then begin 2456 | Inc(FExpressionPos); // initial '.' was already taken into account in Evaluate 2457 | if FExpression[FExpressionPos] = FNodeDelimiter then begin 2458 | Inc(FExpressionPos); 2459 | Include(Flags, selScanTree); 2460 | end; 2461 | end; 2462 | endElement:=PosEx(FNodeDelimiter, FExpression, FExpressionPos); 2463 | if endElement = 0 then 2464 | endElement:=Length(FExpression) + 1; 2465 | Element:=Copy(FExpression, FExpressionPos, endElement - FExpressionPos); 2466 | FExpressionPos:=endElement; 2467 | if Element = '' then 2468 | raise EJSONPathException.CreateFmt('Empty element at position %d', [FExpressionPos]); 2469 | pPredicate:=Pos('[', Element); 2470 | if pPredicate = 0 then begin 2471 | if Pos(']', Element) > 0 then 2472 | raise EJSONPathException.CreateFmt('Invalid syntax at position %d', [Pos(']', Element)]); 2473 | Predicate:=''; 2474 | end 2475 | else begin 2476 | if Element[Length(Element)] <> ']' then 2477 | raise EJSONPathException.CreateFmt('Invalid syntax at position %d', [FExpressionPos + Length(Element) - 1]); 2478 | pEndPredicate:=Pos(']', Element); 2479 | if pEndPredicate < Length(Element) then begin 2480 | //extract only the first filter 2481 | Dec(FExpressionPos, Length(Element) - pEndPredicate); 2482 | Element:=Copy(Element, 1, pEndPredicate); 2483 | end; 2484 | Predicate:=Copy(Element, pPredicate + 1, Length(Element) - pPredicate - 1); 2485 | Delete(Element, pPredicate, Length(Element)- pPredicate + 1); 2486 | end; 2487 | Result:=True; 2488 | end; 2489 | end; 2490 | 2491 | procedure TJSONPathEvaluator.SplitExpression(const Predicate: String; var left, op, right: String); 2492 | var 2493 | pOp, pOpLen: integer; 2494 | begin 2495 | pOp:=Pos('=', Predicate); 2496 | if pOp = 0 then begin 2497 | pOp:=Pos('-', Predicate); 2498 | if pOp = 0 then begin 2499 | pOp:=Pos('+', Predicate); 2500 | if pOp = 0 then begin 2501 | left:=Predicate; 2502 | op:=''; 2503 | right:=''; 2504 | Exit; 2505 | end; 2506 | end; 2507 | end; 2508 | 2509 | // split expression 2510 | pOpLen:=1; 2511 | if (pOp > 1) and (Predicate[pOp - 1] = '!') then begin // != operator ??? 2512 | Inc(pOpLen); 2513 | Dec(pOp); 2514 | end; 2515 | 2516 | left:=Trim(Copy(Predicate, 1, pOp - 1)); 2517 | op:=Copy(Predicate, pOp, pOpLen); 2518 | right:=Trim(Copy(Predicate, pOp + pOpLen, Length(Predicate))); 2519 | if ((right[1] = '''') and (right[Length(right)] = '''')) or ((right[1] = '"') and (right[Length(right)] = '"')) then 2520 | right:=Copy(right, 2, Length(right) - 2); 2521 | end; 2522 | 2523 | function TJSONPathEvaluator.Evaluate(RootNode: TJSONNode; const Expression: String; const NodeDelimiter: Char = '.'): TJSONNodeList; 2524 | var 2525 | element, predicate: String; 2526 | flags: TJSONPathSelectionFlags; 2527 | list: TJSONNodeList; 2528 | begin 2529 | Result:=TJSONNodeList.Create(False); 2530 | Result.Document:=RootNode.Document; 2531 | 2532 | FExpression := Expression; 2533 | FNodeDelimiter := NodeDelimiter; 2534 | FExpressionPos := 1; 2535 | 2536 | if Length(Expression) > 0 then begin 2537 | if FExpression[1] = '$' then 2538 | Delete(FExpression, 1, 1) 2539 | else 2540 | raise EJSONPathException.CreateFmt('Invalid syntax at position %d', [FExpressionPos]); 2541 | // 2542 | if FExpression[1] <> FNodeDelimiter then 2543 | Result.Add(RootNode, RootNode.ParentNode) 2544 | else if (RootNode.ParentNode <> Nil) and (RootNode.ParentNode = RootNode.Document.Root) then // already at root 2545 | Result.Add(RootNode, RootNode.ParentNode) 2546 | else 2547 | Result.Add(RootNode.Document.DocumentElement, RootNode.Document.DocumentElement.ParentNode); 2548 | // 2549 | while GetNextExpressionPart(element, predicate, flags) do begin 2550 | list:=Result; 2551 | Result:=TJSONNodeList.Create(False); 2552 | Result.Document:=list.Document; 2553 | try 2554 | EvaluatePart(list, Result, element, predicate, flags); 2555 | finally 2556 | list.Free; 2557 | end; 2558 | end; 2559 | end; 2560 | end; 2561 | 2562 | {$IF CompilerVersion < 24} 2563 | 2564 | { TStreamReaderHelper } 2565 | 2566 | function TStreamReaderHelper.PrepareBuffer(Value: Integer): Boolean; 2567 | begin 2568 | Result := False; 2569 | 2570 | if Self.FBufferedData = NIL then 2571 | Exit; 2572 | 2573 | if (Self.FBufferedData.Length < Value) and not Self.FNoDataInStream then 2574 | Self.FillBuffer(Self.FEncoding); 2575 | 2576 | Result := (Self.FBufferedData.Length >= Value); 2577 | end; 2578 | 2579 | //procedure TJSONVerySimple.SkipWhitespace(Reader: TJSONReader; Line: TJSONString); 2580 | procedure TStreamReaderHelper.SkipWhitespace; 2581 | var 2582 | SingleChar: Char; 2583 | begin 2584 | while True do begin 2585 | SingleChar:=Self.FirstChar; 2586 | if (SingleChar <> #0) and (AnsiStrScan(TJSONSpaces, SingleChar) = Nil) then 2587 | Break; 2588 | 2589 | Self.IncCharPos; 2590 | if Self.EndOfStream then // if no chars available then exit 2591 | Break; 2592 | end; 2593 | end; 2594 | 2595 | function TStreamReaderHelper.FirstChar: Char; 2596 | begin 2597 | if PrepareBuffer(1) then 2598 | Result := Self.FBufferedData.Chars[0] 2599 | else 2600 | Result := #0; 2601 | end; 2602 | 2603 | procedure TStreamReaderHelper.IncCharPos(Value: Integer); 2604 | begin 2605 | if PrepareBuffer(Value) then 2606 | Self.FBufferedData.Remove(0, Value); 2607 | end; 2608 | 2609 | function TStreamReaderHelper.IsUppercaseText(const Value: TJSONString): Boolean; 2610 | var 2611 | ValueLength: Integer; 2612 | Text: TJSONString; 2613 | begin 2614 | Result := False; 2615 | ValueLength := Length(Value); 2616 | 2617 | if PrepareBuffer(ValueLength) then begin 2618 | Text := UpperCase(Self.FBufferedData.ToString(0, ValueLength)); 2619 | if Text = UpperCase(Value) then begin 2620 | Self.FBufferedData.Remove(0, ValueLength); 2621 | Result := True; 2622 | end; 2623 | Text:=''; 2624 | end; 2625 | end; 2626 | 2627 | function TStreamReaderHelper.ReadText(const StopChars: TJSONString; Options: TJSONExtractTextOptions; const MultilineString: Boolean): TJSONString; 2628 | var 2629 | NewLineIndex: Integer; 2630 | PostNewLineIndex: Integer; 2631 | StopChar: Char; 2632 | Found, StopCharFound, NewLineFound: Boolean; 2633 | TempIndex: Integer; 2634 | StopCharLength: Integer; 2635 | begin 2636 | Result := ''; 2637 | if Self.FBufferedData = NIL then 2638 | Exit; 2639 | NewLineIndex := 0; 2640 | NewLineFound := False; 2641 | PostNewLineIndex := 0; 2642 | StopCharLength := Length(StopChars); 2643 | StopCharFound := False; 2644 | 2645 | while True do begin 2646 | // if we're searching for a string then assure the buffer is wide enough 2647 | if (jetStopString in Options) and (NewLineIndex + StopCharLength > Self.FBufferedData.Length) and not Self.FNoDataInStream then 2648 | Self.FillBuffer(Self.FEncoding); 2649 | 2650 | if NewLineIndex >= Self.FBufferedData.Length then begin 2651 | if Self.FNoDataInStream then begin 2652 | PostNewLineIndex := NewLineIndex; 2653 | Break; 2654 | end 2655 | else begin 2656 | Self.FillBuffer(Self.FEncoding); 2657 | if Self.FBufferedData.Length = 0 then 2658 | Break; 2659 | if NewLineIndex >= Self.FBufferedData.Length then 2660 | Break; 2661 | end; 2662 | end; 2663 | 2664 | if jetStopString in Options then begin 2665 | if NewLineIndex + StopCharLength - 1 < Self.FBufferedData.Length then begin 2666 | Found := True; 2667 | TempIndex := NewLineIndex; 2668 | 2669 | if not MultilineString and (StopCharLength = 1) and ((Self.FBufferedData[TempIndex] = #10) or (Self.FBufferedData[TempIndex] = #13)) and not NewLineFound then begin 2670 | NewLineFound:=True; 2671 | Break; 2672 | end; 2673 | 2674 | for StopChar in StopChars do 2675 | if Self.FBufferedData[TempIndex] <> StopChar then begin 2676 | Found := False; 2677 | Break; 2678 | end 2679 | else begin 2680 | if (TempIndex > 0) and ((Self.FBufferedData[TempIndex - 1] = '\') and (Self.FBufferedData[TempIndex - 0] = '"')) then begin 2681 | Found := False; 2682 | end 2683 | else if (TempIndex > 0) and (Self.FBufferedData[TempIndex - 1] = '\') then begin 2684 | if (TempIndex > 1) and (Self.FBufferedData[TempIndex - 2] = '\') then begin 2685 | Found := True; 2686 | Break; 2687 | end 2688 | else 2689 | Found := False; 2690 | end 2691 | else 2692 | Inc(TempIndex); 2693 | end; 2694 | 2695 | if Found then begin 2696 | StopCharFound := True; 2697 | if jetDeleteWithStopChar in Options then 2698 | PostNewLineIndex := NewLineIndex + StopCharLength 2699 | else 2700 | PostNewLineIndex := NewLineIndex; 2701 | Break; 2702 | end; 2703 | end 2704 | else 2705 | Break; 2706 | end 2707 | else begin 2708 | Found := False; 2709 | for StopChar in StopChars do 2710 | if Self.FBufferedData[NewLineIndex] = StopChar then begin 2711 | if jetDeleteToStopChar in Options then 2712 | PostNewLineIndex := NewLineIndex; 2713 | if jetDeleteWithStopChar in Options then 2714 | PostNewLineIndex := NewLineIndex + 1; 2715 | // else 2716 | // PostNewLineIndex := NewLineIndex; 2717 | Found := True; 2718 | Break; 2719 | end; 2720 | if Found then begin 2721 | StopCharFound := True; 2722 | Break; 2723 | end; 2724 | end; 2725 | 2726 | Inc(NewLineIndex); 2727 | end; 2728 | 2729 | if not StopCharFound and NewLineFound then 2730 | raise EJSONParseException.CreateFmt(sExpectedButFound, [StopChars, 'new line', Self.FBufferedData.ToString(0, NewLineIndex)]); 2731 | if not StopCharFound and not NewLineFound then 2732 | raise EJSONParseException.CreateFmt(sExpectedButFound, [StopChars, 'not', Self.FBufferedData.ToString]); 2733 | 2734 | if NewLineIndex > 0 then 2735 | Result := Self.FBufferedData.ToString(0, NewLineIndex); 2736 | Self.FBufferedData.Remove(0, PostNewLineIndex); 2737 | end; 2738 | 2739 | {$ELSE} 2740 | 2741 | { TJSONStreamReader } 2742 | 2743 | constructor TJSONStreamReader.Create(Stream: TStream; Encoding: TEncoding; DetectBOM: Boolean; BufferSize: Integer); 2744 | begin 2745 | inherited; 2746 | FBufferedData := TRttiContext.Create.GetType(TStreamReader).GetField('FBufferedData').GetValue(Self).AsObject as TStringBuilder; 2747 | FNoDataInStream := Pointer(NativeInt(Self) + TRttiContext.Create.GetType(TStreamReader).GetField('FNoDataInStream').Offset); 2748 | GetFillBuffer(FFillBuffer); 2749 | end; 2750 | 2751 | function TJSONStreamReader.PrepareBuffer(Value: Integer): Boolean; 2752 | begin 2753 | Result := False; 2754 | 2755 | if Self.FBufferedData = NIL then 2756 | Exit; 2757 | 2758 | if (Self.FBufferedData.Length < Value) and (not Self.FNoDataInStream^) then 2759 | Self.FillBuffer; 2760 | 2761 | Result := (Self.FBufferedData.Length >= Value); 2762 | end; 2763 | 2764 | procedure TJSONStreamReader.SkipWhitespace; 2765 | var 2766 | SingleChar: Char; 2767 | begin 2768 | while True do begin 2769 | SingleChar:=Self.FirstChar; 2770 | if (SingleChar <> #0) and (AnsiStrScan(TJSONSpaces, SingleChar) = Nil) then 2771 | Break; 2772 | 2773 | Self.IncCharPos; 2774 | if Self.EndOfStream then // if no chars available then exit 2775 | Break; 2776 | end; 2777 | end; 2778 | 2779 | function TJSONStreamReader.FirstChar: Char; 2780 | begin 2781 | if PrepareBuffer(1) then 2782 | Result := Self.FBufferedData.Chars[0] 2783 | else 2784 | Result := #0; 2785 | end; 2786 | 2787 | procedure TJSONStreamReader.IncCharPos(Value: Integer); 2788 | begin 2789 | if PrepareBuffer(Value) then 2790 | Self.FBufferedData.Remove(0, Value); 2791 | end; 2792 | 2793 | function TJSONStreamReader.IsUppercaseText(const Value: TJSONString): Boolean; 2794 | var 2795 | ValueLength: Integer; 2796 | Text: TJSONString; 2797 | begin 2798 | Result := False; 2799 | ValueLength := Length(Value); 2800 | 2801 | if PrepareBuffer(ValueLength) then begin 2802 | Text := UpperCase(Self.FBufferedData.ToString(0, ValueLength)); 2803 | if Text = UpperCase(Value) then begin 2804 | Self.FBufferedData.Remove(0, ValueLength); 2805 | Result := True; 2806 | end; 2807 | Text:=''; 2808 | end; 2809 | end; 2810 | 2811 | function TJSONStreamReader.ReadText(const StopChars: TJSONString; Options: TJSONExtractTextOptions; const MultilineString: Boolean): TJSONString; 2812 | var 2813 | NewLineIndex: Integer; 2814 | PostNewLineIndex: Integer; 2815 | StopChar: Char; 2816 | Found, StopCharFound, NewLineFound: Boolean; 2817 | TempIndex: Integer; 2818 | StopCharLength: Integer; 2819 | begin 2820 | Result := ''; 2821 | if Self.FBufferedData = NIL then 2822 | Exit; 2823 | NewLineIndex := 0; 2824 | NewLineFound := False; 2825 | PostNewLineIndex := 0; 2826 | StopCharLength := Length(StopChars); 2827 | StopCharFound := False; 2828 | 2829 | while True do begin 2830 | // if we're searching for a string then assure the buffer is wide enough 2831 | if (jetStopString in Options) and (NewLineIndex + StopCharLength > Self.FBufferedData.Length) and not Self.FNoDataInStream^ then 2832 | Self.FillBuffer; 2833 | 2834 | if NewLineIndex >= Self.FBufferedData.Length then begin 2835 | if Self.FNoDataInStream^ then begin 2836 | PostNewLineIndex := NewLineIndex; 2837 | Break; 2838 | end 2839 | else begin 2840 | Self.FillBuffer; 2841 | if Self.FBufferedData.Length = 0 then 2842 | Break; 2843 | if NewLineIndex >= Self.FBufferedData.Length then 2844 | Break; 2845 | end; 2846 | end; 2847 | 2848 | if jetStopString in Options then begin 2849 | if NewLineIndex + StopCharLength - 1 < Self.FBufferedData.Length then begin 2850 | Found := True; 2851 | TempIndex := NewLineIndex; 2852 | 2853 | if not MultilineString and (StopCharLength = 1) and ((Self.FBufferedData[TempIndex] = #10) or (Self.FBufferedData[TempIndex] = #13)) and not NewLineFound then begin 2854 | NewLineFound:=True; 2855 | Break; 2856 | end; 2857 | 2858 | for StopChar in StopChars do 2859 | if Self.FBufferedData[TempIndex] <> StopChar then begin 2860 | Found := False; 2861 | Break; 2862 | end 2863 | else begin 2864 | if (TempIndex > 0) and ((Self.FBufferedData[TempIndex - 1] = '\') and (Self.FBufferedData[TempIndex - 0] = '"')) then begin 2865 | Found := False; 2866 | end 2867 | else if (TempIndex > 0) and (Self.FBufferedData[TempIndex - 1] = '\') then begin 2868 | if (TempIndex > 1) and (Self.FBufferedData[TempIndex - 2] = '\') then begin 2869 | Found := True; 2870 | Break; 2871 | end 2872 | else 2873 | Found := False; 2874 | end 2875 | else 2876 | Inc(TempIndex); 2877 | end; 2878 | 2879 | if Found then begin 2880 | StopCharFound := True; 2881 | if jetDeleteWithStopChar in Options then 2882 | PostNewLineIndex := NewLineIndex + StopCharLength 2883 | else 2884 | PostNewLineIndex := NewLineIndex; 2885 | Break; 2886 | end; 2887 | end 2888 | else 2889 | Break; 2890 | end 2891 | else begin 2892 | Found := False; 2893 | for StopChar in StopChars do 2894 | if Self.FBufferedData[NewLineIndex] = StopChar then begin 2895 | if jetDeleteToStopChar in Options then 2896 | PostNewLineIndex := NewLineIndex; 2897 | if jetDeleteWithStopChar in Options then 2898 | PostNewLineIndex := NewLineIndex + 1; 2899 | // else 2900 | // PostNewLineIndex := NewLineIndex; 2901 | Found := True; 2902 | Break; 2903 | end; 2904 | if Found then begin 2905 | StopCharFound := True; 2906 | Break; 2907 | end; 2908 | end; 2909 | 2910 | Inc(NewLineIndex); 2911 | end; 2912 | 2913 | if not StopCharFound and NewLineFound then 2914 | raise EJSONParseException.CreateFmt(sExpectedButFound, [StopChars, 'new line', Self.FBufferedData.ToString(0, NewLineIndex)]); 2915 | if not StopCharFound and not NewLineFound then 2916 | raise EJSONParseException.CreateFmt(sExpectedButFound, [StopChars, 'not', Self.FBufferedData.ToString]); 2917 | 2918 | if NewLineIndex > 0 then 2919 | Result := Self.FBufferedData.ToString(0, NewLineIndex); 2920 | Self.FBufferedData.Remove(0, PostNewLineIndex); 2921 | end; 2922 | 2923 | procedure TJSONStreamReader.FillBuffer; 2924 | var 2925 | TempEncoding: TEncoding; 2926 | begin 2927 | TempEncoding := CurrentEncoding; 2928 | FFillBuffer(TempEncoding); 2929 | if TempEncoding <> CurrentEncoding then 2930 | TRttiContext.Create.GetType(TStreamReader).GetField('FEncoding').SetValue(Self, TempEncoding); 2931 | end; 2932 | 2933 | { TStreamReaderHelper } 2934 | 2935 | procedure TStreamReaderHelper.GetFillBuffer(var Method: TStreamReaderFillBuffer); 2936 | begin 2937 | TMethod(Method).Code := @TStreamReader.FillBuffer; 2938 | TMethod(Method).Data := Self; 2939 | end; 2940 | 2941 | {$IFEND} 2942 | 2943 | end. 2944 | --------------------------------------------------------------------------------