├── README.md ├── tests └── tests.lpr ├── LGPLv3 ├── GPLv3 └── jsontools.pas /README.md: -------------------------------------------------------------------------------- 1 | # JsonTools 2 | A small pascal based json parser in one unit with no dependencies. 3 | 4 | Please visit this [page](https://www.getlazarus.org/json/) for a complete guide on how to use this parser. 5 | -------------------------------------------------------------------------------- /tests/tests.lpr: -------------------------------------------------------------------------------- 1 | (********************************************************) 2 | (* *) 3 | (* Json Tools Pascal Unit Test *) 4 | (* *) 5 | (* http://www.getlazarus.org/json *) 6 | (* Released under the GPLv3 August 2019 *) 7 | (* *) 8 | (********************************************************) 9 | program Tests; 10 | 11 | {$mode delphi} 12 | 13 | uses 14 | JsonTools in '../jsontools.pas'; 15 | 16 | type 17 | TTest = function(out Msg: string): Boolean; 18 | 19 | function Test1(out Msg: string): Boolean; 20 | var 21 | N: TJsonNode; 22 | begin 23 | Msg := 'Test: Cannot add non object or array roots'; 24 | N := TJsonNode.Create; 25 | try 26 | N.Value := '"employee"'; 27 | Result := False; 28 | except 29 | Result := True; 30 | end; 31 | N.Free; 32 | end; 33 | 34 | function Test2(out Msg: string): Boolean; 35 | var 36 | N: TJsonNode; 37 | begin 38 | Msg := 'Test: Parse simple object'; 39 | N := TJsonNode.Create; 40 | try 41 | N.Value := '{ "name": "john" }'; 42 | Result := (N.Kind = nkObject) and (N.Count = 1) and (N.Child(0).Name = 'name') 43 | and (N.Child(0).Value = '"john"'); 44 | except 45 | Result := False; 46 | end; 47 | N.Free; 48 | end; 49 | 50 | function Test3(out Msg: string): Boolean; 51 | var 52 | N: TJsonNode; 53 | begin 54 | Msg := 'Test: Parse array'; 55 | N := TJsonNode.Create; 56 | try 57 | N.Value := '[ "john", 32, [ { "pi": 314e-2 } ] ]'; 58 | Result := (N.Kind = nkArray) and (N.Count = 3)and (N.Child(1).Value = '32') 59 | and (N.Child(2).Child(0).Child(0).Value = '314e-2'); 60 | except 61 | Result := False; 62 | end; 63 | N.Free; 64 | end; 65 | 66 | function Test4(out Msg: string): Boolean; 67 | var 68 | N: TJsonNode; 69 | begin 70 | Msg := 'Test: Find item'; 71 | N := TJsonNode.Create; 72 | try 73 | N.Value := '[ "john", 32, [ { "pi": 314e-2 } ] ]'; 74 | Result := N.Find('/2/0/pi').Value = '314e-2'; 75 | Result := Result and (N.Find('2/0/pi').Value = '314e-2'); 76 | except 77 | Result := False; 78 | end; 79 | N.Free; 80 | end; 81 | 82 | function Test5(out Msg: string): Boolean; 83 | var 84 | N: TJsonNode; 85 | begin 86 | Msg := 'Test: Parse various kinds'; 87 | N := TJsonNode.Create; 88 | try 89 | N.Value := 90 | ' { '#10+ 91 | ' "object_or_array" : "object",'#10+ 92 | ' "empty" : false , '#10+ 93 | ' "parse_time_nanoseconds" : 19608 ,'#10+ 94 | ' "validate" : true,'#10+ 95 | ' "size": 1'#10+ 96 | '}'; 97 | Result := (N.Find('object_or_array').Value = '"object"') 98 | and (N.Child('empty').Value = 'false') 99 | and (N.Child('parse_time_nanoseconds').AsNumber = 19608) 100 | and (N.Child('validate').AsBoolean) 101 | and (N.Find('size').AsNumber = 1) 102 | and (N.Child('validate').AsNumber = 0) 103 | and (N.Find('size').AsBoolean = False); 104 | except 105 | Result := False; 106 | end; 107 | N.Free; 108 | end; 109 | 110 | function Test6(out Msg: string): Boolean; 111 | var 112 | N: TJsonNode; 113 | begin 114 | Msg := 'Test: Dynamic creation'; 115 | N := TJsonNode.Create; 116 | try 117 | N.Add('name', 'john'); 118 | N := N.Add('address', nkObject); 119 | N.Add('street', '123 Skippy Lane'); 120 | N.Add('city', 'Fairfield'); 121 | N.Add('city', 'Los Angeles'); 122 | N.Add('state', 'CA'); 123 | N.Add('zip', nkNull); 124 | Result := (N.Root.Count = 2) 125 | and (N.Find('/address/city').Value = '"Los Angeles"') 126 | and (N.Find('/address').Count = 4) 127 | and (N.Child(3).Value = 'null'); 128 | except 129 | Result := False; 130 | end; 131 | N.Root.Free; 132 | end; 133 | 134 | function Test7(out Msg: string): Boolean; 135 | var 136 | N: TJsonNode; 137 | S: string; 138 | begin 139 | Msg := 'Test: Dynamic creation'; 140 | N := TJsonNode.Create; 141 | try 142 | N.Value := '{ "name" : "Alice Brown",'+ 143 | ' "sku" : "54321",'+ 144 | ' "valued" : true,'+ 145 | ' "dates" : [1, true, "true", [[[]]]],'+ 146 | ' "price" : 199.95,'+ 147 | ' "shipTo" : { "name" : "Bob Brown",'+ 148 | ' "address" : "456 Oak Lane",'+ 149 | ' "city" : "Pretendville",'+ 150 | ' "state" : "HI",'+ 151 | ' "zip" : "98999" },'+ 152 | ' "billTo" : { "name" : "Alice Brown",'+ 153 | ' "address" : "456 Oak > Lane",'+ 154 | ' "city" : "Pretendville",'+ 155 | ' "state" : "HI",'+ 156 | ' "zip" : "98999",'+ 157 | '"notes": null}' + 158 | '}'; 159 | S := N.AsJson; 160 | N.Parse(S); 161 | Result := True; 162 | except 163 | Result := False; 164 | end; 165 | N.Root.Free; 166 | end; 167 | 168 | procedure Check(Test: TTest; var Passed, Failed: Integer); 169 | var 170 | S: string; 171 | begin 172 | if Test(S) then 173 | begin 174 | Inc(Passed); 175 | WriteLn(S, ' - PASS'); 176 | end 177 | else 178 | begin 179 | Inc(Failed); 180 | WriteLn(S, ' - FAIL'); 181 | end; 182 | end; 183 | 184 | procedure RunTests; 185 | var 186 | Passed, Failed: Integer; 187 | begin 188 | Passed := 0; 189 | Failed := 0; 190 | Check(Test1, Passed, Failed); 191 | Check(Test2, Passed, Failed); 192 | Check(Test3, Passed, Failed); 193 | Check(Test4, Passed, Failed); 194 | Check(Test5, Passed, Failed); 195 | Check(Test6, Passed, Failed); 196 | Check(Test7, Passed, Failed); 197 | if Failed > 0 then 198 | WriteLn(Failed, ' tests FAILED') 199 | else 200 | WriteLn('All tests PASSED'); 201 | end; 202 | 203 | begin 204 | RunTests; 205 | end. 206 | 207 | -------------------------------------------------------------------------------- /LGPLv3: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | 9 | This version of the GNU Lesser General Public License incorporates 10 | the terms and conditions of version 3 of the GNU General Public 11 | License, supplemented by the additional permissions listed below. 12 | 13 | 0. Additional Definitions. 14 | 15 | As used herein, "this License" refers to version 3 of the GNU Lesser 16 | General Public License, and the "GNU GPL" refers to version 3 of the GNU 17 | General Public License. 18 | 19 | "The Library" refers to a covered work governed by this License, 20 | other than an Application or a Combined Work as defined below. 21 | 22 | An "Application" is any work that makes use of an interface provided 23 | by the Library, but which is not otherwise based on the Library. 24 | Defining a subclass of a class defined by the Library is deemed a mode 25 | of using an interface provided by the Library. 26 | 27 | A "Combined Work" is a work produced by combining or linking an 28 | Application with the Library. The particular version of the Library 29 | with which the Combined Work was made is also called the "Linked 30 | Version". 31 | 32 | The "Minimal Corresponding Source" for a Combined Work means the 33 | Corresponding Source for the Combined Work, excluding any source code 34 | for portions of the Combined Work that, considered in isolation, are 35 | based on the Application, and not on the Linked Version. 36 | 37 | The "Corresponding Application Code" for a Combined Work means the 38 | object code and/or source code for the Application, including any data 39 | and utility programs needed for reproducing the Combined Work from the 40 | Application, but excluding the System Libraries of the Combined Work. 41 | 42 | 1. Exception to Section 3 of the GNU GPL. 43 | 44 | You may convey a covered work under sections 3 and 4 of this License 45 | without being bound by section 3 of the GNU GPL. 46 | 47 | 2. Conveying Modified Versions. 48 | 49 | If you modify a copy of the Library, and, in your modifications, a 50 | facility refers to a function or data to be supplied by an Application 51 | that uses the facility (other than as an argument passed when the 52 | facility is invoked), then you may convey a copy of the modified 53 | version: 54 | 55 | a) under this License, provided that you make a good faith effort to 56 | ensure that, in the event an Application does not supply the 57 | function or data, the facility still operates, and performs 58 | whatever part of its purpose remains meaningful, or 59 | 60 | b) under the GNU GPL, with none of the additional permissions of 61 | this License applicable to that copy. 62 | 63 | 3. Object Code Incorporating Material from Library Header Files. 64 | 65 | The object code form of an Application may incorporate material from 66 | a header file that is part of the Library. You may convey such object 67 | code under terms of your choice, provided that, if the incorporated 68 | material is not limited to numerical parameters, data structure 69 | layouts and accessors, or small macros, inline functions and templates 70 | (ten or fewer lines in length), you do both of the following: 71 | 72 | a) Give prominent notice with each copy of the object code that the 73 | Library is used in it and that the Library and its use are 74 | covered by this License. 75 | 76 | b) Accompany the object code with a copy of the GNU GPL and this license 77 | document. 78 | 79 | 4. Combined Works. 80 | 81 | You may convey a Combined Work under terms of your choice that, 82 | taken together, effectively do not restrict modification of the 83 | portions of the Library contained in the Combined Work and reverse 84 | engineering for debugging such modifications, if you also do each of 85 | the following: 86 | 87 | a) Give prominent notice with each copy of the Combined Work that 88 | the Library is used in it and that the Library and its use are 89 | covered by this License. 90 | 91 | b) Accompany the Combined Work with a copy of the GNU GPL and this license 92 | document. 93 | 94 | c) For a Combined Work that displays copyright notices during 95 | execution, include the copyright notice for the Library among 96 | these notices, as well as a reference directing the user to the 97 | copies of the GNU GPL and this license document. 98 | 99 | d) Do one of the following: 100 | 101 | 0) Convey the Minimal Corresponding Source under the terms of this 102 | License, and the Corresponding Application Code in a form 103 | suitable for, and under terms that permit, the user to 104 | recombine or relink the Application with a modified version of 105 | the Linked Version to produce a modified Combined Work, in the 106 | manner specified by section 6 of the GNU GPL for conveying 107 | Corresponding Source. 108 | 109 | 1) Use a suitable shared library mechanism for linking with the 110 | Library. A suitable mechanism is one that (a) uses at run time 111 | a copy of the Library already present on the user's computer 112 | system, and (b) will operate properly with a modified version 113 | of the Library that is interface-compatible with the Linked 114 | Version. 115 | 116 | e) Provide Installation Information, but only if you would otherwise 117 | be required to provide such information under section 6 of the 118 | GNU GPL, and only to the extent that such information is 119 | necessary to install and execute a modified version of the 120 | Combined Work produced by recombining or relinking the 121 | Application with a modified version of the Linked Version. (If 122 | you use option 4d0, the Installation Information must accompany 123 | the Minimal Corresponding Source and Corresponding Application 124 | Code. If you use option 4d1, you must provide the Installation 125 | Information in the manner specified by section 6 of the GNU GPL 126 | for conveying Corresponding Source.) 127 | 128 | 5. Combined Libraries. 129 | 130 | You may place library facilities that are a work based on the 131 | Library side by side in a single library together with other library 132 | facilities that are not Applications and are not covered by this 133 | License, and convey such a combined library under terms of your 134 | choice, if you do both of the following: 135 | 136 | a) Accompany the combined library with a copy of the same work based 137 | on the Library, uncombined with any other library facilities, 138 | conveyed under the terms of this License. 139 | 140 | b) Give prominent notice with the combined library that part of it 141 | is a work based on the Library, and explaining where to find the 142 | accompanying uncombined form of the same work. 143 | 144 | 6. Revised Versions of the GNU Lesser General Public License. 145 | 146 | The Free Software Foundation may publish revised and/or new versions 147 | of the GNU Lesser General Public License from time to time. Such new 148 | versions will be similar in spirit to the present version, but may 149 | differ in detail to address new problems or concerns. 150 | 151 | Each version is given a distinguishing version number. If the 152 | Library as you received it specifies that a certain numbered version 153 | of the GNU Lesser General Public License "or any later version" 154 | applies to it, you have the option of following the terms and 155 | conditions either of that published version or of any later version 156 | published by the Free Software Foundation. If the Library as you 157 | received it does not specify a version number of the GNU Lesser 158 | General Public License, you may choose any version of the GNU Lesser 159 | General Public License ever published by the Free Software Foundation. 160 | 161 | If the Library as you received it specifies that a proxy can decide 162 | whether future versions of the GNU Lesser General Public License shall 163 | apply, that proxy's public statement of acceptance of any version is 164 | permanent authorization for you to choose that version for the 165 | Library. 166 | -------------------------------------------------------------------------------- /GPLv3: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /jsontools.pas: -------------------------------------------------------------------------------- 1 | (********************************************************) 2 | (* *) 3 | (* Json Tools Pascal Unit *) 4 | (* A small json parser with no dependencies *) 5 | (* *) 6 | (* http://www.getlazarus.org/json *) 7 | (* Dual licence GPLv3 LGPLv3 released August 2019 *) 8 | (* *) 9 | (********************************************************) 10 | unit JsonTools; 11 | 12 | {$mode delphi} 13 | 14 | interface 15 | 16 | uses 17 | Classes, SysUtils; 18 | 19 | { EJsonException is the exception type used by TJsonNode. It is thrown 20 | during parse if the string is invalid json or if an attempt is made to 21 | access a non collection by name or index. } 22 | 23 | type 24 | EJsonException = class(Exception); 25 | 26 | { TJsonNodeKind is 1 of 6 possible values described below } 27 | 28 | TJsonNodeKind = ( 29 | { Object such as { } 30 | nkObject, 31 | { Array such as [ ] } 32 | nkArray, 33 | { The literal values true or false } 34 | nkBool, 35 | { The literal value null } 36 | nkNull, 37 | { A number value such as 123, 1.23e2, or -1.5 } 38 | nkNumber, 39 | { A string such as "hello\nworld!" } 40 | nkString); 41 | 42 | TJsonNode = class; 43 | 44 | { TJsonNodeEnumerator is used to enumerate 'for ... in' statements } 45 | 46 | TJsonNodeEnumerator = record 47 | private 48 | FNode: TJsonNode; 49 | FIndex: Integer; 50 | public 51 | procedure Init(Node: TJsonNode); 52 | function GetCurrent: TJsonNode; 53 | function MoveNext: Boolean; 54 | property Current: TJsonNode read GetCurrent; 55 | end; 56 | 57 | { TJsonNode is the class used to parse, build, and navigate a json document. 58 | You should only create and free the root node of your document. The root 59 | node will manage the lifetime of all children through methods such as Add, 60 | Delete, and Clear. 61 | 62 | When you create a TJsonNode node it will have no parent and is considered to 63 | be the root node. The root node must be either an array or an object. Attempts 64 | to convert a root to anything other than array or object will raise an 65 | exception. 66 | 67 | Note: The parser supports unicode by converting unicode characters escaped as 68 | values such as \u20AC. If your json string has an escaped unicode character it 69 | will be unescaped when converted to a pascal string. 70 | 71 | See also: 72 | 73 | JsonStringDecode to convert a JSON string to a normal string 74 | JsonStringEncode to convert a normal string to a JSON string } 75 | 76 | TJsonNode = class 77 | private 78 | FStack: Integer; 79 | FParent: TJsonNode; 80 | FName: string; 81 | FKind: TJsonNodeKind; 82 | FValue: string; 83 | FList: TList; 84 | procedure ParseObject(Node: TJsonNode; var C: PChar); 85 | procedure ParseArray(Node: TJsonNode; var C: PChar); 86 | procedure Error(const Msg: string = ''); 87 | function Format(const Indent: string): string; 88 | function FormatCompact: string; 89 | function Add(Kind: TJsonNodeKind; const Name, Value: string): TJsonNode; overload; 90 | function GetRoot: TJsonNode; 91 | procedure SetKind(Value: TJsonNodeKind); 92 | function GetName: string; 93 | procedure SetName(const Value: string); 94 | function GetValue: string; 95 | function GetCount: Integer; 96 | function GetAsJson: string; 97 | function GetAsArray: TJsonNode; 98 | function GetAsObject: TJsonNode; 99 | function GetAsNull: TJsonNode; 100 | function GetAsBoolean: Boolean; 101 | procedure SetAsBoolean(Value: Boolean); 102 | function GetAsString: string; 103 | procedure SetAsString(const Value: string); 104 | function GetAsNumber: Double; 105 | procedure SetAsNumber(Value: Double); 106 | public 107 | { A parent node owns all children. Only destroy a node if it has no parent. 108 | To destroy a child node use Delete or Clear methods instead. } 109 | destructor Destroy; override; 110 | { GetEnumerator adds 'for ... in' statement support } 111 | function GetEnumerator: TJsonNodeEnumerator; 112 | { Loading and saving methods } 113 | procedure LoadFromStream(Stream: TStream); 114 | procedure SaveToStream(Stream: TStream); 115 | procedure LoadFromFile(const FileName: string); 116 | procedure SaveToFile(const FileName: string); 117 | { Convert a json string into a value or a collection of nodes. If the 118 | current node is root then the json must be an array or object. } 119 | procedure Parse(const Json: string); 120 | { The same as Parse, but returns true if no exception is caught } 121 | function TryParse(const Json: string): Boolean; 122 | { Add a child node by node kind. If the current node is an array then the 123 | name parameter will be discarded. If the current node is not an array or 124 | object the Add methods will convert the node to an object and discard 125 | its current value. 126 | 127 | Note: If the current node is an object then adding an existing name will 128 | overwrite the matching child node instead of adding. } 129 | function Add(const Name: string; K: TJsonNodeKind = nkObject): TJsonNode; overload; 130 | function Add(const Name: string; B: Boolean): TJsonNode; overload; 131 | function Add(const Name: string; const N: Double): TJsonNode; overload; 132 | function Add(const Name: string; const S: string): TJsonNode; overload; 133 | { Convert to an array and add an item } 134 | function Add: TJsonNode; overload; 135 | { Delete a child node by index or name } 136 | procedure Delete(Index: Integer); overload; 137 | procedure Delete(const Name: string); overload; 138 | { Remove all child nodes } 139 | procedure Clear; 140 | { Get a child node by index. EJsonException is raised if node is not an 141 | array or object or if the index is out of bounds. 142 | 143 | See also: Count } 144 | function Child(Index: Integer): TJsonNode; overload; 145 | { Get a child node by name. If no node is found nil will be returned. } 146 | function Child(const Name: string): TJsonNode; overload; 147 | { Search for a node using a path string and return true if exists } 148 | function Exists(const Path: string): Boolean; 149 | { Search for a node using a path string } 150 | function Find(const Path: string): TJsonNode; overload; 151 | { Search for a node using a path string and return true if exists } 152 | function Find(const Path: string; out Node: TJsonNode): Boolean; overload; 153 | { Force a series of nodes to exist and return the end node } 154 | function Force(const Path: string): TJsonNode; 155 | { Format the node and all its children as json } 156 | function ToString: string; override; 157 | { Root node is read only. A node the root when it has no parent. } 158 | property Root: TJsonNode read GetRoot; 159 | { Parent node is read only } 160 | property Parent: TJsonNode read FParent; 161 | { Kind can also be changed using the As methods. 162 | 163 | Note: Changes to Kind cause Value to be reset to a default value. } 164 | property Kind: TJsonNodeKind read FKind write SetKind; 165 | { Name is unique within the scope } 166 | property Name: string read GetName write SetName; 167 | { Value of the node in json e.g. '[]', '"hello\nworld!"', 'true', or '1.23e2' } 168 | property Value: string read GetValue write Parse; 169 | { The number of child nodes. If node is not an object or array this 170 | property will return 0. } 171 | property Count: Integer read GetCount; 172 | { AsJson is the more efficient version of Value. Text returned from AsJson 173 | is the most compact representation of the node in json form. 174 | 175 | Note: If you are writing a services to transmit or receive json data then 176 | use AsJson. If you want friendly human readable text use Value. } 177 | property AsJson: string read GetAsJson write Parse; 178 | { Convert the node to an array } 179 | property AsArray: TJsonNode read GetAsArray; 180 | { Convert the node to an object } 181 | property AsObject: TJsonNode read GetAsObject; 182 | { Convert the node to null } 183 | property AsNull: TJsonNode read GetAsNull; 184 | { Convert the node to a bool } 185 | property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean; 186 | { Convert the node to a string } 187 | property AsString: string read GetAsString write SetAsString; 188 | { Convert the node to a number } 189 | property AsNumber: Double read GetAsNumber write SetAsNumber; 190 | end; 191 | 192 | { JsonValidate tests if a string contains a valid json format } 193 | function JsonValidate(const Json: string): Boolean; 194 | { JsonNumberValidate tests if a string contains a valid json formatted number } 195 | function JsonNumberValidate(const N: string): Boolean; 196 | { JsonStringValidate tests if a string contains a valid json formatted string } 197 | function JsonStringValidate(const S: string): Boolean; 198 | { JsonStringEncode converts a pascal string to a json string } 199 | function JsonStringEncode(const S: string): string; 200 | { JsonStringEncode converts a json string to a pascal string } 201 | function JsonStringDecode(const S: string): string; 202 | { JsonToXml converts a json string to xml } 203 | function JsonToXml(const S: string): string; 204 | 205 | implementation 206 | 207 | resourcestring 208 | SNodeNotCollection = 'Node is not a container'; 209 | SRootNodeKind = 'Root node must be an array or object'; 210 | SIndexOutOfBounds = 'Index out of bounds'; 211 | SParsingError = 'Error while parsing text'; 212 | 213 | type 214 | TJsonTokenKind = (tkEnd, tkError, tkObjectOpen, tkObjectClose, tkArrayOpen, 215 | tkArrayClose, tkColon, tkComma, tkNull, tkFalse, tkTrue, tkString, tkNumber); 216 | 217 | TJsonToken = record 218 | Head: PChar; 219 | Tail: PChar; 220 | Kind: TJsonTokenKind; 221 | function Value: string; 222 | end; 223 | 224 | const 225 | Hex = ['0'..'9', 'A'..'F', 'a'..'f']; 226 | 227 | function TJsonToken.Value: string; 228 | begin 229 | case Kind of 230 | tkEnd: Result := #0; 231 | tkError: Result := #0; 232 | tkObjectOpen: Result := '{'; 233 | tkObjectClose: Result := '}'; 234 | tkArrayOpen: Result := '['; 235 | tkArrayClose: Result := ']'; 236 | tkColon: Result := ':'; 237 | tkComma: Result := ','; 238 | tkNull: Result := 'null'; 239 | tkFalse: Result := 'false'; 240 | tkTrue: Result := 'true'; 241 | else 242 | SetString(Result, Head, Tail - Head); 243 | end; 244 | end; 245 | 246 | function NextToken(var C: PChar; out T: TJsonToken): Boolean; 247 | begin 248 | if C^ > #0 then 249 | if C^ <= ' ' then 250 | repeat 251 | Inc(C); 252 | if C^ = #0 then 253 | Break; 254 | until C^ > ' '; 255 | T.Head := C; 256 | T.Tail := C; 257 | T.Kind := tkEnd; 258 | if C^ = #0 then 259 | Exit(False); 260 | if C^ = '{' then 261 | begin 262 | Inc(C); 263 | T.Tail := C; 264 | T.Kind := tkObjectOpen; 265 | Exit(True); 266 | end; 267 | if C^ = '}' then 268 | begin 269 | Inc(C); 270 | T.Tail := C; 271 | T.Kind := tkObjectClose; 272 | Exit(True); 273 | end; 274 | if C^ = '[' then 275 | begin 276 | Inc(C); 277 | T.Tail := C; 278 | T.Kind := tkArrayOpen; 279 | Exit(True); 280 | end; 281 | if C^ = ']' then 282 | begin 283 | Inc(C); 284 | T.Tail := C; 285 | T.Kind := tkArrayClose; 286 | Exit(True); 287 | end; 288 | if C^ = ':' then 289 | begin 290 | Inc(C); 291 | T.Tail := C; 292 | T.Kind := tkColon; 293 | Exit(True); 294 | end; 295 | if C^ = ',' then 296 | begin 297 | Inc(C); 298 | T.Tail := C; 299 | T.Kind := tkComma; 300 | Exit(True); 301 | end; 302 | if (C[0] = 'n') and (C[1] = 'u') and (C[2] = 'l') and (C[3] = 'l') then 303 | begin 304 | Inc(C, 4); 305 | T.Tail := C; 306 | T.Kind := tkNull; 307 | Exit(True); 308 | end; 309 | if (C[0] = 'f') and (C[1] = 'a') and (C[2] = 'l') and (C[3] = 's') and (C[4] = 'e') then 310 | begin 311 | Inc(C, 5); 312 | T.Tail := C; 313 | T.Kind := tkFalse; 314 | Exit(True); 315 | end; 316 | if (C[0] = 't') and (C[1] = 'r') and (C[2] = 'u') and (C[3] = 'e') then 317 | begin 318 | Inc(C, 4); 319 | T.Tail := C; 320 | T.Kind := tkTrue; 321 | Exit(True); 322 | end; 323 | if C^ = '"' then 324 | begin 325 | repeat 326 | Inc(C); 327 | if C^ = '\' then 328 | begin 329 | Inc(C); 330 | if C^ < ' ' then 331 | begin 332 | T.Tail := C; 333 | T.Kind := tkError; 334 | Exit(False); 335 | end; 336 | if C^ = 'u' then 337 | if not ((C[1] in Hex) and (C[2] in Hex) and (C[3] in Hex) and (C[4] in Hex)) then 338 | begin 339 | T.Tail := C; 340 | T.Kind := tkError; 341 | Exit(False); 342 | end; 343 | end 344 | else if C^ = '"' then 345 | begin 346 | Inc(C); 347 | T.Tail := C; 348 | T.Kind := tkString; 349 | Exit(True); 350 | end; 351 | until C^ in [#0, #10, #13]; 352 | T.Tail := C; 353 | T.Kind := tkError; 354 | Exit(False); 355 | end; 356 | if C^ in ['-', '0'..'9'] then 357 | begin 358 | if C^ = '-' then 359 | Inc(C); 360 | if C^ in ['0'..'9'] then 361 | begin 362 | while C^ in ['0'..'9'] do 363 | Inc(C); 364 | if C^ = '.' then 365 | begin 366 | Inc(C); 367 | if C^ in ['0'..'9'] then 368 | begin 369 | while C^ in ['0'..'9'] do 370 | Inc(C); 371 | end 372 | else 373 | begin 374 | T.Tail := C; 375 | T.Kind := tkError; 376 | Exit(False); 377 | end; 378 | end; 379 | if C^ in ['E', 'e'] then 380 | begin 381 | Inc(C); 382 | if C^ = '+' then 383 | Inc(C) 384 | else if C^ = '-' then 385 | Inc(C); 386 | if C^ in ['0'..'9'] then 387 | begin 388 | while C^ in ['0'..'9'] do 389 | Inc(C); 390 | end 391 | else 392 | begin 393 | T.Tail := C; 394 | T.Kind := tkError; 395 | Exit(False); 396 | end; 397 | end; 398 | T.Tail := C; 399 | T.Kind := tkNumber; 400 | Exit(True); 401 | end; 402 | end; 403 | T.Kind := tkError; 404 | Result := False; 405 | end; 406 | 407 | { TJsonNodeEnumerator } 408 | 409 | procedure TJsonNodeEnumerator.Init(Node: TJsonNode); 410 | begin 411 | FNode := Node; 412 | FIndex := -1; 413 | end; 414 | 415 | function TJsonNodeEnumerator.GetCurrent: TJsonNode; 416 | begin 417 | if FNode.FList = nil then 418 | Result := nil 419 | else if FIndex < 0 then 420 | Result := nil 421 | else if FIndex < FNode.FList.Count then 422 | Result := TJsonNode(FNode.FList[FIndex]) 423 | else 424 | Result := nil; 425 | end; 426 | 427 | function TJsonNodeEnumerator.MoveNext: Boolean; 428 | begin 429 | Inc(FIndex); 430 | if FNode.FList = nil then 431 | Result := False 432 | else 433 | Result := FIndex < FNode.FList.Count; 434 | end; 435 | 436 | { TJsonNode } 437 | 438 | destructor TJsonNode.Destroy; 439 | begin 440 | Clear; 441 | inherited Destroy; 442 | end; 443 | 444 | function TJsonNode.GetEnumerator: TJsonNodeEnumerator; 445 | begin 446 | Result.Init(Self); 447 | end; 448 | 449 | procedure TJsonNode.LoadFromStream(Stream: TStream); 450 | var 451 | S: string; 452 | I: Int64; 453 | begin 454 | I := Stream.Size - Stream.Position; 455 | S := ''; 456 | SetLength(S, I); 457 | Stream.Read(PChar(S)^, I); 458 | Parse(S); 459 | end; 460 | 461 | procedure TJsonNode.SaveToStream(Stream: TStream); 462 | var 463 | S: string; 464 | I: Int64; 465 | begin 466 | S := Value; 467 | I := Length(S); 468 | Stream.Write(PChar(S)^, I); 469 | end; 470 | 471 | procedure TJsonNode.LoadFromFile(const FileName: string); 472 | var 473 | F: TFileStream; 474 | begin 475 | F := TFileStream.Create(FileName, fmOpenRead); 476 | try 477 | LoadFromStream(F); 478 | finally 479 | F.Free; 480 | end; 481 | end; 482 | 483 | procedure TJsonNode.SaveToFile(const FileName: string); 484 | var 485 | F: TFileStream; 486 | begin 487 | F := TFileStream.Create(FileName, fmCreate); 488 | try 489 | SaveToStream(F); 490 | finally 491 | F.Free; 492 | end; 493 | end; 494 | 495 | const 496 | MaxStack = 1000; 497 | 498 | procedure TJsonNode.ParseObject(Node: TJsonNode; var C: PChar); 499 | var 500 | T: TJsonToken; 501 | N: string; 502 | begin 503 | Inc(FStack); 504 | if FStack > MaxStack then 505 | Error; 506 | while NextToken(C, T) do 507 | begin 508 | case T.Kind of 509 | tkString: N := JsonStringDecode(T.Value); 510 | tkObjectClose: 511 | begin 512 | Dec(FStack); 513 | Exit; 514 | end 515 | else 516 | Error; 517 | end; 518 | NextToken(C, T); 519 | if T.Kind <> tkColon then 520 | Error; 521 | NextToken(C, T); 522 | case T.Kind of 523 | tkObjectOpen: ParseObject(Node.Add(nkObject, N, ''), C); 524 | tkArrayOpen: ParseArray(Node.Add(nkArray, N, ''), C); 525 | tkNull: Node.Add(nkNull, N, 'null'); 526 | tkFalse: Node.Add(nkBool, N, 'false'); 527 | tkTrue: Node.Add(nkBool, N, 'true'); 528 | tkString: Node.Add(nkString, N, T.Value); 529 | tkNumber: Node.Add(nkNumber, N, T.Value); 530 | else 531 | Error; 532 | end; 533 | NextToken(C, T); 534 | if T.Kind = tkComma then 535 | Continue; 536 | if T.Kind = tkObjectClose then 537 | begin 538 | Dec(FStack); 539 | Exit; 540 | end; 541 | Error; 542 | end; 543 | Error; 544 | end; 545 | 546 | procedure TJsonNode.ParseArray(Node: TJsonNode; var C: PChar); 547 | var 548 | T: TJsonToken; 549 | begin 550 | Inc(FStack); 551 | if FStack > MaxStack then 552 | Error; 553 | while NextToken(C, T) do 554 | begin 555 | case T.Kind of 556 | tkObjectOpen: ParseObject(Node.Add(nkObject, '', ''), C); 557 | tkArrayOpen: ParseArray(Node.Add(nkArray, '', ''), C); 558 | tkNull: Node.Add(nkNull, '', 'null'); 559 | tkFalse: Node.Add(nkBool, '', 'false'); 560 | tkTrue: Node.Add(nkBool, '', 'true'); 561 | tkString: Node.Add(nkString, '', T.Value); 562 | tkNumber: Node.Add(nkNumber, '', T.Value); 563 | tkArrayClose: 564 | begin 565 | Dec(FStack); 566 | Exit; 567 | end 568 | else 569 | Error; 570 | end; 571 | NextToken(C, T); 572 | if T.Kind = tkComma then 573 | Continue; 574 | if T.Kind = tkArrayClose then 575 | begin 576 | Dec(FStack); 577 | Exit; 578 | end; 579 | Error; 580 | end; 581 | Error; 582 | end; 583 | 584 | procedure TJsonNode.Parse(const Json: string); 585 | var 586 | C: PChar; 587 | T: TJsonToken; 588 | begin 589 | Clear; 590 | C := PChar(Json); 591 | if FParent = nil then 592 | begin 593 | if NextToken(C, T) and (T.Kind in [tkObjectOpen, tkArrayOpen]) then 594 | begin 595 | try 596 | if T.Kind = tkObjectOpen then 597 | begin 598 | FKind := nkObject; 599 | ParseObject(Self, C); 600 | end 601 | else 602 | begin 603 | FKind := nkArray; 604 | ParseArray(Self, C); 605 | end; 606 | NextToken(C, T); 607 | if T.Kind <> tkEnd then 608 | Error; 609 | except 610 | Clear; 611 | raise; 612 | end; 613 | end 614 | else 615 | Error(SRootNodeKind); 616 | end 617 | else 618 | begin 619 | NextToken(C, T); 620 | case T.Kind of 621 | tkObjectOpen: 622 | begin 623 | FKind := nkObject; 624 | ParseObject(Self, C); 625 | end; 626 | tkArrayOpen: 627 | begin 628 | FKind := nkArray; 629 | ParseArray(Self, C); 630 | end; 631 | tkNull: 632 | begin 633 | FKind := nkNull; 634 | FValue := 'null'; 635 | end; 636 | tkFalse: 637 | begin 638 | FKind := nkBool; 639 | FValue := 'false'; 640 | end; 641 | tkTrue: 642 | begin 643 | FKind := nkBool; 644 | FValue := 'true'; 645 | end; 646 | tkString: 647 | begin 648 | FKind := nkString; 649 | FValue := T.Value; 650 | end; 651 | tkNumber: 652 | begin 653 | FKind := nkNumber; 654 | FValue := T.Value; 655 | end; 656 | else 657 | Error; 658 | end; 659 | NextToken(C, T); 660 | if T.Kind <> tkEnd then 661 | begin 662 | Clear; 663 | Error; 664 | end; 665 | end; 666 | end; 667 | 668 | function TJsonNode.TryParse(const Json: string): Boolean; 669 | begin 670 | try 671 | Parse(Json); 672 | Result := True; 673 | except 674 | Result := False; 675 | end; 676 | end; 677 | 678 | procedure TJsonNode.Error(const Msg: string = ''); 679 | begin 680 | FStack := 0; 681 | if Msg = '' then 682 | raise EJsonException.Create(SParsingError) 683 | else 684 | raise EJsonException.Create(Msg); 685 | end; 686 | 687 | function TJsonNode.GetRoot: TJsonNode; 688 | begin 689 | Result := Self; 690 | while Result.FParent <> nil do 691 | Result := Result.FParent; 692 | end; 693 | 694 | procedure TJsonNode.SetKind(Value: TJsonNodeKind); 695 | begin 696 | if Value = FKind then Exit; 697 | case Value of 698 | nkObject: AsObject; 699 | nkArray: AsArray; 700 | nkBool: AsBoolean; 701 | nkNull: AsNull; 702 | nkNumber: AsNumber; 703 | nkString: AsString; 704 | end; 705 | end; 706 | 707 | function TJsonNode.GetName: string; 708 | begin 709 | if FParent = nil then 710 | Exit('0'); 711 | if FParent.FKind = nkArray then 712 | Result := IntToStr(FParent.FList.IndexOf(Self)) 713 | else 714 | Result := FName; 715 | end; 716 | 717 | procedure TJsonNode.SetName(const Value: string); 718 | var 719 | N: TJsonNode; 720 | begin 721 | if FParent = nil then 722 | Exit; 723 | if FParent.FKind = nkArray then 724 | Exit; 725 | N := FParent.Child(Value); 726 | if N = Self then 727 | Exit; 728 | FParent.FList.Remove(N); 729 | FName := Value; 730 | end; 731 | 732 | function TJsonNode.GetValue: string; 733 | begin 734 | if FKind in [nkObject, nkArray] then 735 | Result := Format('') 736 | else 737 | Result := FValue; 738 | end; 739 | 740 | function TJsonNode.GetAsJson: string; 741 | begin 742 | if FKind in [nkObject, nkArray] then 743 | Result := FormatCompact 744 | else 745 | Result := FValue; 746 | end; 747 | 748 | function TJsonNode.GetAsArray: TJsonNode; 749 | begin 750 | if FKind <> nkArray then 751 | begin 752 | Clear; 753 | FKind := nkArray; 754 | FValue := ''; 755 | end; 756 | Result := Self; 757 | end; 758 | 759 | function TJsonNode.GetAsObject: TJsonNode; 760 | begin 761 | if FKind <> nkObject then 762 | begin 763 | Clear; 764 | FKind := nkObject; 765 | FValue := ''; 766 | end; 767 | Result := Self; 768 | end; 769 | 770 | function TJsonNode.GetAsNull: TJsonNode; 771 | begin 772 | if FParent = nil then 773 | Error(SRootNodeKind); 774 | if FKind <> nkNull then 775 | begin 776 | Clear; 777 | FKind := nkNull; 778 | FValue := 'null'; 779 | end; 780 | Result := Self; 781 | end; 782 | 783 | function TJsonNode.GetAsBoolean: Boolean; 784 | begin 785 | if FParent = nil then 786 | Error(SRootNodeKind); 787 | if FKind <> nkBool then 788 | begin 789 | Clear; 790 | FKind := nkBool; 791 | FValue := 'false'; 792 | Exit(False); 793 | end; 794 | Result := FValue = 'true'; 795 | end; 796 | 797 | procedure TJsonNode.SetAsBoolean(Value: Boolean); 798 | begin 799 | if FParent = nil then 800 | Error(SRootNodeKind); 801 | if FKind <> nkBool then 802 | begin 803 | Clear; 804 | FKind := nkBool; 805 | end; 806 | if Value then 807 | FValue := 'true' 808 | else 809 | FValue := 'false'; 810 | end; 811 | 812 | function TJsonNode.GetAsString: string; 813 | begin 814 | if FParent = nil then 815 | Error(SRootNodeKind); 816 | if FKind <> nkString then 817 | begin 818 | Clear; 819 | FKind := nkString; 820 | FValue := '""'; 821 | Exit(''); 822 | end; 823 | Result := JsonStringDecode(FValue); 824 | end; 825 | 826 | procedure TJsonNode.SetAsString(const Value: string); 827 | begin 828 | if FParent = nil then 829 | Error(SRootNodeKind); 830 | if FKind <> nkString then 831 | begin 832 | Clear; 833 | FKind := nkString; 834 | end; 835 | FValue := JsonStringEncode(Value); 836 | end; 837 | 838 | function TJsonNode.GetAsNumber: Double; 839 | begin 840 | if FParent = nil then 841 | Error(SRootNodeKind); 842 | if FKind <> nkNumber then 843 | begin 844 | Clear; 845 | FKind := nkNumber; 846 | FValue := '0'; 847 | Exit(0); 848 | end; 849 | Result := StrToFloatDef(FValue, 0); 850 | end; 851 | 852 | procedure TJsonNode.SetAsNumber(Value: Double); 853 | begin 854 | if FParent = nil then 855 | Error(SRootNodeKind); 856 | if FKind <> nkNumber then 857 | begin 858 | Clear; 859 | FKind := nkNumber; 860 | end; 861 | FValue := FloatToStr(Value); 862 | end; 863 | 864 | function TJsonNode.Add: TJsonNode; 865 | begin 866 | Result := AsArray.Add(''); 867 | end; 868 | 869 | function TJsonNode.Add(Kind: TJsonNodeKind; const Name, Value: string): TJsonNode; 870 | var 871 | S: string; 872 | begin 873 | if not (FKind in [nkArray, nkObject]) then 874 | if Name = '' then 875 | AsArray 876 | else 877 | AsObject; 878 | if FKind in [nkArray, nkObject] then 879 | begin 880 | if FList = nil then 881 | FList := TList.Create; 882 | if FKind = nkArray then 883 | S := IntToStr(FList.Count) 884 | else 885 | S := Name; 886 | Result := Child(S); 887 | if Result = nil then 888 | begin 889 | Result := TJsonNode.Create; 890 | Result.FName := S; 891 | FList.Add(Result); 892 | end; 893 | if Kind = nkNull then 894 | Result.FValue := 'null' 895 | else if Kind in [nkBool, nkString, nkNumber] then 896 | Result.FValue := Value 897 | else 898 | begin 899 | Result.FValue := ''; 900 | Result.Clear; 901 | end; 902 | Result.FParent := Self; 903 | Result.FKind := Kind; 904 | end 905 | else 906 | Error(SNodeNotCollection); 907 | end; 908 | 909 | function TJsonNode.Add(const Name: string; K: TJsonNodeKind = nkObject): TJsonNode; overload; 910 | begin 911 | case K of 912 | nkObject, nkArray: Result := Add(K, Name, ''); 913 | nkNull: Result := Add(K, Name, 'null'); 914 | nkBool: Result := Add(K, Name, 'false'); 915 | nkNumber: Result := Add(K, Name, '0'); 916 | nkString: Result := Add(K, Name, '""'); 917 | end; 918 | end; 919 | 920 | function TJsonNode.Add(const Name: string; B: Boolean): TJsonNode; overload; 921 | const 922 | Bools: array[Boolean] of string = ('false', 'true'); 923 | begin 924 | Result := Add(nkBool, Name, Bools[B]); 925 | end; 926 | 927 | function TJsonNode.Add(const Name: string; const N: Double): TJsonNode; overload; 928 | begin 929 | Result := Add(nkNumber, Name, FloatToStr(N)); 930 | end; 931 | 932 | function TJsonNode.Add(const Name: string; const S: string): TJsonNode; overload; 933 | begin 934 | Result := Add(nkString, Name, JsonStringEncode(S)); 935 | end; 936 | 937 | procedure TJsonNode.Delete(Index: Integer); 938 | var 939 | N: TJsonNode; 940 | begin 941 | N := Child(Index); 942 | if N <> nil then 943 | begin 944 | N.Free; 945 | FList.Delete(Index); 946 | if FList.Count = 0 then 947 | begin 948 | FList.Free; 949 | FList := nil; 950 | end; 951 | end; 952 | end; 953 | 954 | procedure TJsonNode.Delete(const Name: string); 955 | var 956 | N: TJsonNode; 957 | begin 958 | N := Child(Name); 959 | if N <> nil then 960 | begin 961 | N.Free; 962 | FList.Remove(N); 963 | if FList.Count = 0 then 964 | begin 965 | FList.Free; 966 | FList := nil; 967 | end; 968 | end; 969 | end; 970 | 971 | procedure TJsonNode.Clear; 972 | var 973 | I: Integer; 974 | begin 975 | if FList <> nil then 976 | begin 977 | for I := 0 to FList.Count - 1 do 978 | TObject(FList[I]).Free; 979 | FList.Free; 980 | FList := nil; 981 | end; 982 | end; 983 | 984 | function TJsonNode.Child(Index: Integer): TJsonNode; 985 | begin 986 | if FKind in [nkArray, nkObject] then 987 | begin 988 | if FList = nil then 989 | Error(SIndexOutOfBounds); 990 | if (Index < 0) or (Index > FList.Count - 1) then 991 | Error(SIndexOutOfBounds); 992 | Result := TJsonNode(FList[Index]); 993 | end 994 | else 995 | Error(SNodeNotCollection); 996 | end; 997 | 998 | function TJsonNode.Child(const Name: string): TJsonNode; 999 | var 1000 | N: TJsonNode; 1001 | I: Integer; 1002 | begin 1003 | Result := nil; 1004 | if (FList <> nil) and (FKind in [nkArray, nkObject]) then 1005 | if FKind = nkArray then 1006 | begin 1007 | I := StrToIntDef(Name, -1); 1008 | if (I > -1) and (I < FList.Count) then 1009 | Exit(TJsonNode(FList[I])); 1010 | end 1011 | else for I := 0 to FList.Count - 1 do 1012 | begin 1013 | N := TJsonNode(FList[I]); 1014 | if N.FName = Name then 1015 | Exit(N); 1016 | end; 1017 | end; 1018 | 1019 | function TJsonNode.Exists(const Path: string): Boolean; 1020 | begin 1021 | Result := Find(Path) <> nil; 1022 | end; 1023 | 1024 | function TJsonNode.Find(const Path: string): TJsonNode; 1025 | var 1026 | N: TJsonNode; 1027 | A, B: PChar; 1028 | S: string; 1029 | begin 1030 | Result := nil; 1031 | if Path = '' then 1032 | Exit(Child('')); 1033 | if Path[1] = '/' then 1034 | begin 1035 | N := Self; 1036 | while N.Parent <> nil do 1037 | N := N.Parent; 1038 | end 1039 | else 1040 | N := Self; 1041 | A := PChar(Path); 1042 | if A^ = '/' then 1043 | begin 1044 | Inc(A); 1045 | if A^ = #0 then 1046 | Exit(N); 1047 | end; 1048 | if A^ = #0 then 1049 | Exit(N.Child('')); 1050 | B := A; 1051 | while B^ > #0 do 1052 | begin 1053 | if B^ = '/' then 1054 | begin 1055 | SetString(S, A, B - A); 1056 | N := N.Child(S); 1057 | if N = nil then 1058 | Exit(nil); 1059 | A := B + 1; 1060 | B := A; 1061 | end 1062 | else 1063 | begin 1064 | Inc(B); 1065 | if B^ = #0 then 1066 | begin 1067 | SetString(S, A, B - A); 1068 | N := N.Child(S); 1069 | end; 1070 | end; 1071 | end; 1072 | Result := N; 1073 | end; 1074 | 1075 | function TJsonNode.Find(const Path: string; out Node: TJsonNode): Boolean; 1076 | begin 1077 | Node := Find(Path); 1078 | Result := Node <> nil; 1079 | end; 1080 | 1081 | function TJsonNode.Force(const Path: string): TJsonNode; 1082 | var 1083 | N: TJsonNode; 1084 | A, B: PChar; 1085 | S: string; 1086 | ChildNode: TJsonNode; 1087 | begin 1088 | Result := nil; 1089 | // AsObject; 1090 | if Path = '' then 1091 | begin 1092 | N := Child(''); 1093 | if N = nil then 1094 | N := Add(''); 1095 | Exit(N); 1096 | end; 1097 | if Path[1] = '/' then 1098 | begin 1099 | N := Self; 1100 | while N.Parent <> nil do 1101 | N := N.Parent; 1102 | end 1103 | else 1104 | N := Self; 1105 | A := PChar(Path); 1106 | if A^ = '/' then 1107 | begin 1108 | Inc(A); 1109 | if A^ = #0 then 1110 | Exit(N); 1111 | end; 1112 | if A^ = #0 then 1113 | begin 1114 | N := Child(''); 1115 | if N = nil then 1116 | N := Add(''); 1117 | Exit(N); 1118 | end; 1119 | B := A; 1120 | while B^ > #0 do 1121 | begin 1122 | if B^ = '/' then 1123 | begin 1124 | SetString(S, A, B - A); 1125 | ChildNode = N.Child(S); 1126 | if ChildNode = nil then 1127 | N := N.Add(S) 1128 | else 1129 | N := ChildNode; 1130 | A := B + 1; 1131 | B := A; 1132 | end 1133 | else 1134 | begin 1135 | Inc(B); 1136 | if B^ = #0 then 1137 | begin 1138 | SetString(S, A, B - A); 1139 | ChildNode := N.Child(S); 1140 | if ChildNode = nil then 1141 | N := N.Add(S) 1142 | else 1143 | N := ChildNode; 1144 | end; 1145 | end; 1146 | end; 1147 | Result := N; 1148 | end; 1149 | 1150 | function TJsonNode.Format(const Indent: string): string; 1151 | 1152 | function EnumNodes: string; 1153 | var 1154 | I, J: Integer; 1155 | S: string; 1156 | begin 1157 | if (FList = nil) or (FList.Count = 0) then 1158 | Exit(' '); 1159 | Result := #10; 1160 | J := FList.Count - 1; 1161 | S := Indent + #9; 1162 | for I := 0 to J do 1163 | begin 1164 | Result := Result + TJsonNode(FList[I]).Format(S); 1165 | if I < J then 1166 | Result := Result + ','#10 1167 | else 1168 | Result := Result + #10 + Indent; 1169 | end; 1170 | end; 1171 | 1172 | var 1173 | Prefix: string; 1174 | begin 1175 | Result := ''; 1176 | if (FParent <> nil) and (FParent.FKind = nkObject) then 1177 | Prefix := JsonStringEncode(FName) + ': ' 1178 | else 1179 | Prefix := ''; 1180 | case FKind of 1181 | nkObject: Result := Indent + Prefix +'{' + EnumNodes + '}'; 1182 | nkArray: Result := Indent + Prefix + '[' + EnumNodes + ']'; 1183 | else 1184 | Result := Indent + Prefix + FValue; 1185 | end; 1186 | end; 1187 | 1188 | function TJsonNode.FormatCompact: string; 1189 | 1190 | function EnumNodes: string; 1191 | var 1192 | I, J: Integer; 1193 | begin 1194 | Result := ''; 1195 | if (FList = nil) or (FList.Count = 0) then 1196 | Exit; 1197 | J := FList.Count - 1; 1198 | for I := 0 to J do 1199 | begin 1200 | Result := Result + TJsonNode(FList[I]).FormatCompact; 1201 | if I < J then 1202 | Result := Result + ','; 1203 | end; 1204 | end; 1205 | 1206 | var 1207 | Prefix: string; 1208 | begin 1209 | Result := ''; 1210 | if (FParent <> nil) and (FParent.FKind = nkObject) then 1211 | Prefix := JsonStringEncode(FName) + ':' 1212 | else 1213 | Prefix := ''; 1214 | case FKind of 1215 | nkObject: Result := Prefix + '{' + EnumNodes + '}'; 1216 | nkArray: Result := Prefix + '[' + EnumNodes + ']'; 1217 | else 1218 | Result := Prefix + FValue; 1219 | end; 1220 | end; 1221 | 1222 | function TJsonNode.ToString: string; 1223 | begin 1224 | Result := Format(''); 1225 | end; 1226 | 1227 | function TJsonNode.GetCount: Integer; 1228 | begin 1229 | if FList <> nil then 1230 | Result := FList.Count 1231 | else 1232 | Result := 0; 1233 | end; 1234 | 1235 | { Json helper routines } 1236 | 1237 | function JsonValidate(const Json: string): Boolean; 1238 | var 1239 | N: TJsonNode; 1240 | begin 1241 | N := TJsonNode.Create; 1242 | try 1243 | Result := N.TryParse(Json); 1244 | finally 1245 | N.Free; 1246 | end; 1247 | end; 1248 | 1249 | function JsonNumberValidate(const N: string): Boolean; 1250 | var 1251 | C: PChar; 1252 | T: TJsonToken; 1253 | begin 1254 | C := PChar(N); 1255 | Result := NextToken(C, T) and (T.Kind = tkNumber) and (T.Value = N); 1256 | end; 1257 | 1258 | function JsonStringValidate(const S: string): Boolean; 1259 | var 1260 | C: PChar; 1261 | T: TJsonToken; 1262 | begin 1263 | C := PChar(S); 1264 | Result := NextToken(C, T) and (T.Kind = tkString) and (T.Value = S); 1265 | end; 1266 | 1267 | { Convert a pascal string to a json string } 1268 | 1269 | function JsonStringEncode(const S: string): string; 1270 | 1271 | function Len(C: PChar): Integer; 1272 | var 1273 | I: Integer; 1274 | begin 1275 | I := 0; 1276 | while C^ > #0 do 1277 | begin 1278 | if C^ < ' ' then 1279 | if C^ in [#8..#13] then 1280 | Inc(I, 2) 1281 | else 1282 | Inc(I, 6) 1283 | else if C^ in ['"', '\'] then 1284 | Inc(I, 2) 1285 | else 1286 | Inc(I); 1287 | Inc(C); 1288 | end; 1289 | Result := I + 2; 1290 | end; 1291 | 1292 | const 1293 | EscapeChars: PChar = '01234567btnvfr'; 1294 | HexChars: PChar = '0123456789ABCDEF'; 1295 | var 1296 | C: PChar; 1297 | R: string; 1298 | I: Integer; 1299 | begin 1300 | if S = '' then 1301 | Exit('""'); 1302 | C := PChar(S); 1303 | R := ''; 1304 | SetLength(R, Len(C)); 1305 | R[1] := '"'; 1306 | I := 2; 1307 | while C^ > #0 do 1308 | begin 1309 | if C^ < ' ' then 1310 | begin 1311 | R[I] := '\'; 1312 | Inc(I); 1313 | if C^ in [#8..#13] then 1314 | R[I] := EscapeChars[Ord(C^)] 1315 | else 1316 | begin 1317 | R[I] := 'u'; 1318 | R[I + 1] := '0'; 1319 | R[I + 2] := '0'; 1320 | R[I + 3] := HexChars[Ord(C^) div $10]; 1321 | R[I + 4] := HexChars[Ord(C^) mod $10]; 1322 | Inc(I, 4); 1323 | end; 1324 | end 1325 | else if C^ in ['"', '\'] then 1326 | begin 1327 | R[I] := '\'; 1328 | Inc(I); 1329 | R[I] := C^; 1330 | end 1331 | else 1332 | R[I] := C^; 1333 | Inc(I); 1334 | Inc(C); 1335 | end; 1336 | R[Length(R)] := '"'; 1337 | Result := R; 1338 | end; 1339 | 1340 | { Convert a json string to a pascal string } 1341 | 1342 | function UnicodeToString(C: LongWord): string; inline; 1343 | begin 1344 | if C = 0 then 1345 | Result := #0 1346 | else if C < $80 then 1347 | Result := Chr(C) 1348 | else if C < $800 then 1349 | Result := Chr((C shr $6) + $C0) + Chr((C and $3F) + $80) 1350 | else if C < $10000 then 1351 | Result := Chr((C shr $C) + $E0) + Chr(((C shr $6) and 1352 | $3F) + $80) + Chr((C and $3F) + $80) 1353 | else if C < $200000 then 1354 | Result := Chr((C shr $12) + $F0) + Chr(((C shr $C) and 1355 | $3F) + $80) + Chr(((C shr $6) and $3F) + $80) + 1356 | Chr((C and $3F) + $80) 1357 | else 1358 | Result := ''; 1359 | end; 1360 | 1361 | function UnicodeToSize(C: LongWord): Integer; inline; 1362 | begin 1363 | if C = 0 then 1364 | Result := 1 1365 | else if C < $80 then 1366 | Result := 1 1367 | else if C < $800 then 1368 | Result := 2 1369 | else if C < $10000 then 1370 | Result := 3 1371 | else if C < $200000 then 1372 | Result := 4 1373 | else 1374 | Result := 0; 1375 | end; 1376 | 1377 | function HexToByte(C: Char): Byte; inline; 1378 | const 1379 | Zero = Ord('0'); 1380 | UpA = Ord('A'); 1381 | LoA = Ord('a'); 1382 | begin 1383 | if C < 'A' then 1384 | Result := Ord(C) - Zero 1385 | else if C < 'a' then 1386 | Result := Ord(C) - UpA + 10 1387 | else 1388 | Result := Ord(C) - LoA + 10; 1389 | end; 1390 | 1391 | function HexToInt(A, B, C, D: Char): Integer; inline; 1392 | begin 1393 | Result := HexToByte(A) shl 12 or HexToByte(B) shl 8 or HexToByte(C) shl 4 or 1394 | HexToByte(D); 1395 | end; 1396 | 1397 | function JsonStringDecode(const S: string): string; 1398 | 1399 | function Len(C: PChar): Integer; 1400 | var 1401 | I, J: Integer; 1402 | begin 1403 | if C^ <> '"' then 1404 | Exit(0); 1405 | Inc(C); 1406 | I := 0; 1407 | while C^ <> '"' do 1408 | begin 1409 | if C^ = #0 then 1410 | Exit(0); 1411 | if C^ = '\' then 1412 | begin 1413 | Inc(C); 1414 | if C^ = 'u' then 1415 | begin 1416 | if (C[1] in Hex) and (C[2] in Hex) and (C[3] in Hex) and (C[4] in Hex) then 1417 | begin 1418 | J := UnicodeToSize(HexToInt(C[1], C[2], C[3], C[4])); 1419 | if J = 0 then 1420 | Exit(0); 1421 | Inc(I, J - 1); 1422 | Inc(C, 4); 1423 | end 1424 | else 1425 | Exit(0); 1426 | end 1427 | else if C^ = #0 then 1428 | Exit(0) 1429 | end; 1430 | Inc(C); 1431 | Inc(I); 1432 | end; 1433 | Result := I; 1434 | end; 1435 | 1436 | const 1437 | Escape = ['b', 't', 'n', 'v', 'f', 'r']; 1438 | var 1439 | C: PChar; 1440 | R: string; 1441 | I, J: Integer; 1442 | H: string; 1443 | begin 1444 | C := PChar(S); 1445 | I := Len(C); 1446 | if I < 1 then 1447 | Exit(''); 1448 | R := ''; 1449 | SetLength(R, I); 1450 | I := 1; 1451 | Inc(C); 1452 | while C^ <> '"' do 1453 | begin 1454 | if C^ = '\' then 1455 | begin 1456 | Inc(C); 1457 | if C^ in Escape then 1458 | case C^ of 1459 | 'b': R[I] := #8; 1460 | 't': R[I] := #9; 1461 | 'n': R[I] := #10; 1462 | 'v': R[I] := #11; 1463 | 'f': R[I] := #12; 1464 | 'r': R[I] := #13; 1465 | end 1466 | else if C^ = 'u' then 1467 | begin 1468 | H := UnicodeToString(HexToInt(C[1], C[2], C[3], C[4])); 1469 | for J := 1 to Length(H) - 1 do 1470 | begin 1471 | R[I] := H[J]; 1472 | Inc(I); 1473 | end; 1474 | R[I] := H[Length(H)]; 1475 | Inc(C, 4); 1476 | end 1477 | else 1478 | R[I] := C^; 1479 | end 1480 | else 1481 | R[I] := C^; 1482 | Inc(C); 1483 | Inc(I); 1484 | end; 1485 | Result := R; 1486 | end; 1487 | 1488 | function JsonToXml(const S: string): string; 1489 | const 1490 | Kinds: array[TJsonNodeKind] of string = 1491 | (' kind="object"', ' kind="array"', ' kind="bool"', ' kind="null"', ' kind="number"', ''); 1492 | Space = ' '; 1493 | 1494 | function Escape(N: TJsonNode): string; 1495 | begin 1496 | Result := N.Value; 1497 | if N.Kind = nkString then 1498 | begin 1499 | Result := JsonStringDecode(Result); 1500 | Result := StringReplace(Result, '<', '<', [rfReplaceAll]); 1501 | Result := StringReplace(Result, '>', '>', [rfReplaceAll]); 1502 | end; 1503 | end; 1504 | 1505 | function EnumNodes(P: TJsonNode; const Indent: string): string; 1506 | var 1507 | N: TJsonNode; 1508 | S: string; 1509 | begin 1510 | Result := ''; 1511 | if P.Kind = nkArray then 1512 | S := 'item' 1513 | else 1514 | S := ''; 1515 | for N in P do 1516 | begin 1517 | Result := Result + Indent + '<' + S + N.Name + Kinds[N.Kind]; 1518 | case N.Kind of 1519 | nkObject, nkArray: 1520 | if N.Count > 0 then 1521 | Result := Result + '>'#10 + EnumNodes(N, Indent + Space) + 1522 | Indent + ''#10 1523 | else 1524 | Result := Result + '/>'#10; 1525 | nkNull: Result := Result + '/>'#10; 1526 | else 1527 | Result := Result + '>' + Escape(N) + ''#10; 1528 | end; 1529 | end; 1530 | end; 1531 | 1532 | var 1533 | N: TJsonNode; 1534 | begin 1535 | Result := ''; 1536 | N := TJsonNode.Create; 1537 | try 1538 | if N.TryParse(S) then 1539 | begin 1540 | Result := 1541 | ''#10 + 1542 | ' 0 then 1544 | Result := Result + '>'#10 + EnumNodes(N, Space) + '' 1545 | else 1546 | Result := Result + '/>'; 1547 | end; 1548 | finally 1549 | N.Free; 1550 | end; 1551 | end; 1552 | 1553 | end. 1554 | --------------------------------------------------------------------------------