├── .gitattributes ├── .gitignore ├── LICENSE-LGPL.txt ├── LICENSE-MPL.txt ├── demos ├── PropertyEditor │ ├── demo.png │ └── soeditor.pas ├── RTTI │ ├── main.dfm │ ├── main.pas │ └── rttisearch.dpr ├── VirtualTreeView │ ├── main.dfm │ ├── main.pas │ ├── sample.json │ └── soedit.dpr ├── googlesearch │ ├── main.dfm │ ├── main.pas │ └── search.dpr └── googlesuggest │ ├── main.dfm │ ├── main.pas │ └── suggest.dpr ├── readme.md ├── superobject.pas ├── superxmlparser.pas └── tests ├── test_format.dpr ├── test_perf.dpr ├── test_prototype.dpr ├── test_rpc.dpr ├── test_usage.dpr └── test_validate.dpr /.gitattributes: -------------------------------------------------------------------------------- 1 | *.lpi -crlf -merge 2 | *.lpk -crlf -merge 3 | *.res -crlf -merge 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Compiled source # 2 | ################### 3 | *.com 4 | *.class 5 | *.dll 6 | *.exe 7 | *.o 8 | *.ppu 9 | *.dcu 10 | *.so 11 | *.compiled 12 | *.identcache 13 | *.local 14 | *.cache 15 | *.res 16 | *.app 17 | *.rst 18 | 19 | # Packages # 20 | ############ 21 | # it's better to unpack these files and commit the raw source 22 | # git has its own built in compression methods 23 | *.7z 24 | *.dmg 25 | *.gz 26 | *.iso 27 | *.jar 28 | *.rar 29 | *.tar 30 | *.zip 31 | 32 | # Logs and databases # 33 | ###################### 34 | *.log 35 | *.sql 36 | *.sqlite 37 | 38 | # OS generated files # 39 | ###################### 40 | *.DS_Store 41 | ehthumbs.db 42 | Thumbs.db 43 | 44 | # Additional stuff # 45 | #################### 46 | *.lock 47 | *.swp 48 | *.out 49 | 50 | # Backup # 51 | ########## 52 | backup 53 | __history 54 | *.bak 55 | *~ 56 | *.old 57 | -------------------------------------------------------------------------------- /LICENSE-LGPL.txt: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | 3 | Version 3, 29 June 2007 4 | 5 | Copyright © 2007 Free Software Foundation, Inc. 6 | 7 | Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. 8 | 9 | This version of the GNU Lesser General Public License incorporates the terms and conditions of version 3 of the GNU General Public License, supplemented by the additional permissions listed below. 10 | 11 | 0. Additional Definitions. 12 | As used herein, “this License” refers to version 3 of the GNU Lesser General Public License, and the “GNU GPL” refers to version 3 of the GNU General Public License. 13 | 14 | “The Library” refers to a covered work governed by this License, other than an Application or a Combined Work as defined below. 15 | 16 | An “Application” is any work that makes use of an interface provided by the Library, but which is not otherwise based on the Library. Defining a subclass of a class defined by the Library is deemed a mode of using an interface provided by the Library. 17 | 18 | A “Combined Work” is a work produced by combining or linking an Application with the Library. The particular version of the Library with which the Combined Work was made is also called the “Linked Version”. 19 | 20 | The “Minimal Corresponding Source” for a Combined Work means the Corresponding Source for the Combined Work, excluding any source code for portions of the Combined Work that, considered in isolation, are based on the Application, and not on the Linked Version. 21 | 22 | The “Corresponding Application Code” for a Combined Work means the object code and/or source code for the Application, including any data and utility programs needed for reproducing the Combined Work from the Application, but excluding the System Libraries of the Combined Work. 23 | 24 | 1. Exception to Section 3 of the GNU GPL. 25 | You may convey a covered work under sections 3 and 4 of this License without being bound by section 3 of the GNU GPL. 26 | 27 | 2. Conveying Modified Versions. 28 | If you modify a copy of the Library, and, in your modifications, a facility refers to a function or data to be supplied by an Application that uses the facility (other than as an argument passed when the facility is invoked), then you may convey a copy of the modified version: 29 | 30 | a) under this License, provided that you make a good faith effort to ensure that, in the event an Application does not supply the function or data, the facility still operates, and performs whatever part of its purpose remains meaningful, or 31 | b) under the GNU GPL, with none of the additional permissions of this License applicable to that copy. 32 | 3. Object Code Incorporating Material from Library Header Files. 33 | The object code form of an Application may incorporate material from a header file that is part of the Library. You may convey such object code under terms of your choice, provided that, if the incorporated material is not limited to numerical parameters, data structure layouts and accessors, or small macros, inline functions and templates (ten or fewer lines in length), you do both of the following: 34 | 35 | a) Give prominent notice with each copy of the object code that the Library is used in it and that the Library and its use are covered by this License. 36 | b) Accompany the object code with a copy of the GNU GPL and this license document. 37 | 4. Combined Works. 38 | You may convey a Combined Work under terms of your choice that, taken together, effectively do not restrict modification of the portions of the Library contained in the Combined Work and reverse engineering for debugging such modifications, if you also do each of the following: 39 | 40 | a) Give prominent notice with each copy of the Combined Work that the Library is used in it and that the Library and its use are covered by this License. 41 | b) Accompany the Combined Work with a copy of the GNU GPL and this license document. 42 | c) For a Combined Work that displays copyright notices during execution, include the copyright notice for the Library among these notices, as well as a reference directing the user to the copies of the GNU GPL and this license document. 43 | d) Do one of the following: 44 | 0) Convey the Minimal Corresponding Source under the terms of this License, and the Corresponding Application Code in a form suitable for, and under terms that permit, the user to recombine or relink the Application with a modified version of the Linked Version to produce a modified Combined Work, in the manner specified by section 6 of the GNU GPL for conveying Corresponding Source. 45 | 1) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (a) uses at run time a copy of the Library already present on the user's computer system, and (b) will operate properly with a modified version of the Library that is interface-compatible with the Linked Version. 46 | e) Provide Installation Information, but only if you would otherwise be required to provide such information under section 6 of the GNU GPL, and only to the extent that such information is necessary to install and execute a modified version of the Combined Work produced by recombining or relinking the Application with a modified version of the Linked Version. (If you use option 4d0, the Installation Information must accompany the Minimal Corresponding Source and Corresponding Application Code. If you use option 4d1, you must provide the Installation Information in the manner specified by section 6 of the GNU GPL for conveying Corresponding Source.) 47 | 5. Combined Libraries. 48 | You may place library facilities that are a work based on the Library side by side in a single library together with other library facilities that are not Applications and are not covered by this License, and convey such a combined library under terms of your choice, if you do both of the following: 49 | 50 | a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities, conveyed under the terms of this License. 51 | b) Give prominent notice with the combined library that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 52 | 6. Revised Versions of the GNU Lesser General Public License. 53 | The Free Software Foundation may publish revised and/or new versions of the GNU Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. 54 | 55 | Each version is given a distinguishing version number. If the Library as you received it specifies that a certain numbered version of the GNU Lesser General Public License “or any later version” applies to it, you have the option of following the terms and conditions either of that published version or of any later version published by the Free Software Foundation. If the Library as you received it does not specify a version number of the GNU Lesser General Public License, you may choose any version of the GNU Lesser General Public License ever published by the Free Software Foundation. 56 | 57 | If the Library as you received it specifies that a proxy can decide whether future versions of the GNU Lesser General Public License shall apply, that proxy's public statement of acceptance of any version is permanent authorization for you to choose that version for the Library. 58 | -------------------------------------------------------------------------------- /LICENSE-MPL.txt: -------------------------------------------------------------------------------- 1 | MOZILLA PUBLIC LICENSE 2 | Version 1.1 3 | 4 | --------------- 5 | 6 | 1. Definitions. 7 | 8 | 1.0.1. "Commercial Use" means distribution or otherwise making the 9 | Covered Code available to a third party. 10 | 11 | 1.1. "Contributor" means each entity that creates or contributes to 12 | the creation of Modifications. 13 | 14 | 1.2. "Contributor Version" means the combination of the Original 15 | Code, prior Modifications used by a Contributor, and the Modifications 16 | made by that particular Contributor. 17 | 18 | 1.3. "Covered Code" means the Original Code or Modifications or the 19 | combination of the Original Code and Modifications, in each case 20 | including portions thereof. 21 | 22 | 1.4. "Electronic Distribution Mechanism" means a mechanism generally 23 | accepted in the software development community for the electronic 24 | transfer of data. 25 | 26 | 1.5. "Executable" means Covered Code in any form other than Source 27 | Code. 28 | 29 | 1.6. "Initial Developer" means the individual or entity identified 30 | as the Initial Developer in the Source Code notice required by Exhibit 31 | A. 32 | 33 | 1.7. "Larger Work" means a work which combines Covered Code or 34 | portions thereof with code not governed by the terms of this License. 35 | 36 | 1.8. "License" means this document. 37 | 38 | 1.8.1. "Licensable" means having the right to grant, to the maximum 39 | extent possible, whether at the time of the initial grant or 40 | subsequently acquired, any and all of the rights conveyed herein. 41 | 42 | 1.9. "Modifications" means any addition to or deletion from the 43 | substance or structure of either the Original Code or any previous 44 | Modifications. When Covered Code is released as a series of files, a 45 | Modification is: 46 | A. Any addition to or deletion from the contents of a file 47 | containing Original Code or previous Modifications. 48 | 49 | B. Any new file that contains any part of the Original Code or 50 | previous Modifications. 51 | 52 | 1.10. "Original Code" means Source Code of computer software code 53 | which is described in the Source Code notice required by Exhibit A as 54 | Original Code, and which, at the time of its release under this 55 | License is not already Covered Code governed by this License. 56 | 57 | 1.10.1. "Patent Claims" means any patent claim(s), now owned or 58 | hereafter acquired, including without limitation, method, process, 59 | and apparatus claims, in any patent Licensable by grantor. 60 | 61 | 1.11. "Source Code" means the preferred form of the Covered Code for 62 | making modifications to it, including all modules it contains, plus 63 | any associated interface definition files, scripts used to control 64 | compilation and installation of an Executable, or source code 65 | differential comparisons against either the Original Code or another 66 | well known, available Covered Code of the Contributor's choice. The 67 | Source Code can be in a compressed or archival form, provided the 68 | appropriate decompression or de-archiving software is widely available 69 | for no charge. 70 | 71 | 1.12. "You" (or "Your") means an individual or a legal entity 72 | exercising rights under, and complying with all of the terms of, this 73 | License or a future version of this License issued under Section 6.1. 74 | For legal entities, "You" includes any entity which controls, is 75 | controlled by, or is under common control with You. For purposes of 76 | this definition, "control" means (a) the power, direct or indirect, 77 | to cause the direction or management of such entity, whether by 78 | contract or otherwise, or (b) ownership of more than fifty percent 79 | (50%) of the outstanding shares or beneficial ownership of such 80 | entity. 81 | 82 | 2. Source Code License. 83 | 84 | 2.1. The Initial Developer Grant. 85 | The Initial Developer hereby grants You a world-wide, royalty-free, 86 | non-exclusive license, subject to third party intellectual property 87 | claims: 88 | (a) under intellectual property rights (other than patent or 89 | trademark) Licensable by Initial Developer to use, reproduce, 90 | modify, display, perform, sublicense and distribute the Original 91 | Code (or portions thereof) with or without Modifications, and/or 92 | as part of a Larger Work; and 93 | 94 | (b) under Patents Claims infringed by the making, using or 95 | selling of Original Code, to make, have made, use, practice, 96 | sell, and offer for sale, and/or otherwise dispose of the 97 | Original Code (or portions thereof). 98 | 99 | (c) the licenses granted in this Section 2.1(a) and (b) are 100 | effective on the date Initial Developer first distributes 101 | Original Code under the terms of this License. 102 | 103 | (d) Notwithstanding Section 2.1(b) above, no patent license is 104 | granted: 1) for code that You delete from the Original Code; 2) 105 | separate from the Original Code; or 3) for infringements caused 106 | by: i) the modification of the Original Code or ii) the 107 | combination of the Original Code with other software or devices. 108 | 109 | 2.2. Contributor Grant. 110 | Subject to third party intellectual property claims, each Contributor 111 | hereby grants You a world-wide, royalty-free, non-exclusive license 112 | 113 | (a) under intellectual property rights (other than patent or 114 | trademark) Licensable by Contributor, to use, reproduce, modify, 115 | display, perform, sublicense and distribute the Modifications 116 | created by such Contributor (or portions thereof) either on an 117 | unmodified basis, with other Modifications, as Covered Code 118 | and/or as part of a Larger Work; and 119 | 120 | (b) under Patent Claims infringed by the making, using, or 121 | selling of Modifications made by that Contributor either alone 122 | and/or in combination with its Contributor Version (or portions 123 | of such combination), to make, use, sell, offer for sale, have 124 | made, and/or otherwise dispose of: 1) Modifications made by that 125 | Contributor (or portions thereof); and 2) the combination of 126 | Modifications made by that Contributor with its Contributor 127 | Version (or portions of such combination). 128 | 129 | (c) the licenses granted in Sections 2.2(a) and 2.2(b) are 130 | effective on the date Contributor first makes Commercial Use of 131 | the Covered Code. 132 | 133 | (d) Notwithstanding Section 2.2(b) above, no patent license is 134 | granted: 1) for any code that Contributor has deleted from the 135 | Contributor Version; 2) separate from the Contributor Version; 136 | 3) for infringements caused by: i) third party modifications of 137 | Contributor Version or ii) the combination of Modifications made 138 | by that Contributor with other software (except as part of the 139 | Contributor Version) or other devices; or 4) under Patent Claims 140 | infringed by Covered Code in the absence of Modifications made by 141 | that Contributor. 142 | 143 | 3. Distribution Obligations. 144 | 145 | 3.1. Application of License. 146 | The Modifications which You create or to which You contribute are 147 | governed by the terms of this License, including without limitation 148 | Section 2.2. The Source Code version of Covered Code may be 149 | distributed only under the terms of this License or a future version 150 | of this License released under Section 6.1, and You must include a 151 | copy of this License with every copy of the Source Code You 152 | distribute. You may not offer or impose any terms on any Source Code 153 | version that alters or restricts the applicable version of this 154 | License or the recipients' rights hereunder. However, You may include 155 | an additional document offering the additional rights described in 156 | Section 3.5. 157 | 158 | 3.2. Availability of Source Code. 159 | Any Modification which You create or to which You contribute must be 160 | made available in Source Code form under the terms of this License 161 | either on the same media as an Executable version or via an accepted 162 | Electronic Distribution Mechanism to anyone to whom you made an 163 | Executable version available; and if made available via Electronic 164 | Distribution Mechanism, must remain available for at least twelve (12) 165 | months after the date it initially became available, or at least six 166 | (6) months after a subsequent version of that particular Modification 167 | has been made available to such recipients. You are responsible for 168 | ensuring that the Source Code version remains available even if the 169 | Electronic Distribution Mechanism is maintained by a third party. 170 | 171 | 3.3. Description of Modifications. 172 | You must cause all Covered Code to which You contribute to contain a 173 | file documenting the changes You made to create that Covered Code and 174 | the date of any change. You must include a prominent statement that 175 | the Modification is derived, directly or indirectly, from Original 176 | Code provided by the Initial Developer and including the name of the 177 | Initial Developer in (a) the Source Code, and (b) in any notice in an 178 | Executable version or related documentation in which You describe the 179 | origin or ownership of the Covered Code. 180 | 181 | 3.4. Intellectual Property Matters 182 | (a) Third Party Claims. 183 | If Contributor has knowledge that a license under a third party's 184 | intellectual property rights is required to exercise the rights 185 | granted by such Contributor under Sections 2.1 or 2.2, 186 | Contributor must include a text file with the Source Code 187 | distribution titled "LEGAL" which describes the claim and the 188 | party making the claim in sufficient detail that a recipient will 189 | know whom to contact. If Contributor obtains such knowledge after 190 | the Modification is made available as described in Section 3.2, 191 | Contributor shall promptly modify the LEGAL file in all copies 192 | Contributor makes available thereafter and shall take other steps 193 | (such as notifying appropriate mailing lists or newsgroups) 194 | reasonably calculated to inform those who received the Covered 195 | Code that new knowledge has been obtained. 196 | 197 | (b) Contributor APIs. 198 | If Contributor's Modifications include an application programming 199 | interface and Contributor has knowledge of patent licenses which 200 | are reasonably necessary to implement that API, Contributor must 201 | also include this information in the LEGAL file. 202 | 203 | (c) Representations. 204 | Contributor represents that, except as disclosed pursuant to 205 | Section 3.4(a) above, Contributor believes that Contributor's 206 | Modifications are Contributor's original creation(s) and/or 207 | Contributor has sufficient rights to grant the rights conveyed by 208 | this License. 209 | 210 | 3.5. Required Notices. 211 | You must duplicate the notice in Exhibit A in each file of the Source 212 | Code. If it is not possible to put such notice in a particular Source 213 | Code file due to its structure, then You must include such notice in a 214 | location (such as a relevant directory) where a user would be likely 215 | to look for such a notice. If You created one or more Modification(s) 216 | You may add your name as a Contributor to the notice described in 217 | Exhibit A. You must also duplicate this License in any documentation 218 | for the Source Code where You describe recipients' rights or ownership 219 | rights relating to Covered Code. You may choose to offer, and to 220 | charge a fee for, warranty, support, indemnity or liability 221 | obligations to one or more recipients of Covered Code. However, You 222 | may do so only on Your own behalf, and not on behalf of the Initial 223 | Developer or any Contributor. You must make it absolutely clear than 224 | any such warranty, support, indemnity or liability obligation is 225 | offered by You alone, and You hereby agree to indemnify the Initial 226 | Developer and every Contributor for any liability incurred by the 227 | Initial Developer or such Contributor as a result of warranty, 228 | support, indemnity or liability terms You offer. 229 | 230 | 3.6. Distribution of Executable Versions. 231 | You may distribute Covered Code in Executable form only if the 232 | requirements of Section 3.1-3.5 have been met for that Covered Code, 233 | and if You include a notice stating that the Source Code version of 234 | the Covered Code is available under the terms of this License, 235 | including a description of how and where You have fulfilled the 236 | obligations of Section 3.2. The notice must be conspicuously included 237 | in any notice in an Executable version, related documentation or 238 | collateral in which You describe recipients' rights relating to the 239 | Covered Code. You may distribute the Executable version of Covered 240 | Code or ownership rights under a license of Your choice, which may 241 | contain terms different from this License, provided that You are in 242 | compliance with the terms of this License and that the license for the 243 | Executable version does not attempt to limit or alter the recipient's 244 | rights in the Source Code version from the rights set forth in this 245 | License. If You distribute the Executable version under a different 246 | license You must make it absolutely clear that any terms which differ 247 | from this License are offered by You alone, not by the Initial 248 | Developer or any Contributor. You hereby agree to indemnify the 249 | Initial Developer and every Contributor for any liability incurred by 250 | the Initial Developer or such Contributor as a result of any such 251 | terms You offer. 252 | 253 | 3.7. Larger Works. 254 | You may create a Larger Work by combining Covered Code with other code 255 | not governed by the terms of this License and distribute the Larger 256 | Work as a single product. In such a case, You must make sure the 257 | requirements of this License are fulfilled for the Covered Code. 258 | 259 | 4. Inability to Comply Due to Statute or Regulation. 260 | 261 | If it is impossible for You to comply with any of the terms of this 262 | License with respect to some or all of the Covered Code due to 263 | statute, judicial order, or regulation then You must: (a) comply with 264 | the terms of this License to the maximum extent possible; and (b) 265 | describe the limitations and the code they affect. Such description 266 | must be included in the LEGAL file described in Section 3.4 and must 267 | be included with all distributions of the Source Code. Except to the 268 | extent prohibited by statute or regulation, such description must be 269 | sufficiently detailed for a recipient of ordinary skill to be able to 270 | understand it. 271 | 272 | 5. Application of this License. 273 | 274 | This License applies to code to which the Initial Developer has 275 | attached the notice in Exhibit A and to related Covered Code. 276 | 277 | 6. Versions of the License. 278 | 279 | 6.1. New Versions. 280 | Netscape Communications Corporation ("Netscape") may publish revised 281 | and/or new versions of the License from time to time. Each version 282 | will be given a distinguishing version number. 283 | 284 | 6.2. Effect of New Versions. 285 | Once Covered Code has been published under a particular version of the 286 | License, You may always continue to use it under the terms of that 287 | version. You may also choose to use such Covered Code under the terms 288 | of any subsequent version of the License published by Netscape. No one 289 | other than Netscape has the right to modify the terms applicable to 290 | Covered Code created under this License. 291 | 292 | 6.3. Derivative Works. 293 | If You create or use a modified version of this License (which you may 294 | only do in order to apply it to code which is not already Covered Code 295 | governed by this License), You must (a) rename Your license so that 296 | the phrases "Mozilla", "MOZILLAPL", "MOZPL", "Netscape", 297 | "MPL", "NPL" or any confusingly similar phrase do not appear in your 298 | license (except to note that your license differs from this License) 299 | and (b) otherwise make it clear that Your version of the license 300 | contains terms which differ from the Mozilla Public License and 301 | Netscape Public License. (Filling in the name of the Initial 302 | Developer, Original Code or Contributor in the notice described in 303 | Exhibit A shall not of themselves be deemed to be modifications of 304 | this License.) 305 | 306 | 7. DISCLAIMER OF WARRANTY. 307 | 308 | COVERED CODE IS PROVIDED UNDER THIS LICENSE ON AN "AS IS" BASIS, 309 | WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, 310 | WITHOUT LIMITATION, WARRANTIES THAT THE COVERED CODE IS FREE OF 311 | DEFECTS, MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE OR NON-INFRINGING. 312 | THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE COVERED CODE 313 | IS WITH YOU. SHOULD ANY COVERED CODE PROVE DEFECTIVE IN ANY RESPECT, 314 | YOU (NOT THE INITIAL DEVELOPER OR ANY OTHER CONTRIBUTOR) ASSUME THE 315 | COST OF ANY NECESSARY SERVICING, REPAIR OR CORRECTION. THIS DISCLAIMER 316 | OF WARRANTY CONSTITUTES AN ESSENTIAL PART OF THIS LICENSE. NO USE OF 317 | ANY COVERED CODE IS AUTHORIZED HEREUNDER EXCEPT UNDER THIS DISCLAIMER. 318 | 319 | 8. TERMINATION. 320 | 321 | 8.1. This License and the rights granted hereunder will terminate 322 | automatically if You fail to comply with terms herein and fail to cure 323 | such breach within 30 days of becoming aware of the breach. All 324 | sublicenses to the Covered Code which are properly granted shall 325 | survive any termination of this License. Provisions which, by their 326 | nature, must remain in effect beyond the termination of this License 327 | shall survive. 328 | 329 | 8.2. If You initiate litigation by asserting a patent infringement 330 | claim (excluding declatory judgment actions) against Initial Developer 331 | or a Contributor (the Initial Developer or Contributor against whom 332 | You file such action is referred to as "Participant") alleging that: 333 | 334 | (a) such Participant's Contributor Version directly or indirectly 335 | infringes any patent, then any and all rights granted by such 336 | Participant to You under Sections 2.1 and/or 2.2 of this License 337 | shall, upon 60 days notice from Participant terminate prospectively, 338 | unless if within 60 days after receipt of notice You either: (i) 339 | agree in writing to pay Participant a mutually agreeable reasonable 340 | royalty for Your past and future use of Modifications made by such 341 | Participant, or (ii) withdraw Your litigation claim with respect to 342 | the Contributor Version against such Participant. If within 60 days 343 | of notice, a reasonable royalty and payment arrangement are not 344 | mutually agreed upon in writing by the parties or the litigation claim 345 | is not withdrawn, the rights granted by Participant to You under 346 | Sections 2.1 and/or 2.2 automatically terminate at the expiration of 347 | the 60 day notice period specified above. 348 | 349 | (b) any software, hardware, or device, other than such Participant's 350 | Contributor Version, directly or indirectly infringes any patent, then 351 | any rights granted to You by such Participant under Sections 2.1(b) 352 | and 2.2(b) are revoked effective as of the date You first made, used, 353 | sold, distributed, or had made, Modifications made by that 354 | Participant. 355 | 356 | 8.3. If You assert a patent infringement claim against Participant 357 | alleging that such Participant's Contributor Version directly or 358 | indirectly infringes any patent where such claim is resolved (such as 359 | by license or settlement) prior to the initiation of patent 360 | infringement litigation, then the reasonable value of the licenses 361 | granted by such Participant under Sections 2.1 or 2.2 shall be taken 362 | into account in determining the amount or value of any payment or 363 | license. 364 | 365 | 8.4. In the event of termination under Sections 8.1 or 8.2 above, 366 | all end user license agreements (excluding distributors and resellers) 367 | which have been validly granted by You or any distributor hereunder 368 | prior to termination shall survive termination. 369 | 370 | 9. LIMITATION OF LIABILITY. 371 | 372 | UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, WHETHER TORT 373 | (INCLUDING NEGLIGENCE), CONTRACT, OR OTHERWISE, SHALL YOU, THE INITIAL 374 | DEVELOPER, ANY OTHER CONTRIBUTOR, OR ANY DISTRIBUTOR OF COVERED CODE, 375 | OR ANY SUPPLIER OF ANY OF SUCH PARTIES, BE LIABLE TO ANY PERSON FOR 376 | ANY INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES OF ANY 377 | CHARACTER INCLUDING, WITHOUT LIMITATION, DAMAGES FOR LOSS OF GOODWILL, 378 | WORK STOPPAGE, COMPUTER FAILURE OR MALFUNCTION, OR ANY AND ALL OTHER 379 | COMMERCIAL DAMAGES OR LOSSES, EVEN IF SUCH PARTY SHALL HAVE BEEN 380 | INFORMED OF THE POSSIBILITY OF SUCH DAMAGES. THIS LIMITATION OF 381 | LIABILITY SHALL NOT APPLY TO LIABILITY FOR DEATH OR PERSONAL INJURY 382 | RESULTING FROM SUCH PARTY'S NEGLIGENCE TO THE EXTENT APPLICABLE LAW 383 | PROHIBITS SUCH LIMITATION. SOME JURISDICTIONS DO NOT ALLOW THE 384 | EXCLUSION OR LIMITATION OF INCIDENTAL OR CONSEQUENTIAL DAMAGES, SO 385 | THIS EXCLUSION AND LIMITATION MAY NOT APPLY TO YOU. 386 | 387 | 10. U.S. GOVERNMENT END USERS. 388 | 389 | The Covered Code is a "commercial item," as that term is defined in 390 | 48 C.F.R. 2.101 (Oct. 1995), consisting of "commercial computer 391 | software" and "commercial computer software documentation," as such 392 | terms are used in 48 C.F.R. 12.212 (Sept. 1995). Consistent with 48 393 | C.F.R. 12.212 and 48 C.F.R. 227.7202-1 through 227.7202-4 (June 1995), 394 | all U.S. Government End Users acquire Covered Code with only those 395 | rights set forth herein. 396 | 397 | 11. MISCELLANEOUS. 398 | 399 | This License represents the complete agreement concerning subject 400 | matter hereof. If any provision of this License is held to be 401 | unenforceable, such provision shall be reformed only to the extent 402 | necessary to make it enforceable. This License shall be governed by 403 | California law provisions (except to the extent applicable law, if 404 | any, provides otherwise), excluding its conflict-of-law provisions. 405 | With respect to disputes in which at least one party is a citizen of, 406 | or an entity chartered or registered to do business in the United 407 | States of America, any litigation relating to this License shall be 408 | subject to the jurisdiction of the Federal Courts of the Northern 409 | District of California, with venue lying in Santa Clara County, 410 | California, with the losing party responsible for costs, including 411 | without limitation, court costs and reasonable attorneys' fees and 412 | expenses. The application of the United Nations Convention on 413 | Contracts for the International Sale of Goods is expressly excluded. 414 | Any law or regulation which provides that the language of a contract 415 | shall be construed against the drafter shall not apply to this 416 | License. 417 | 418 | 12. RESPONSIBILITY FOR CLAIMS. 419 | 420 | As between Initial Developer and the Contributors, each party is 421 | responsible for claims and damages arising, directly or indirectly, 422 | out of its utilization of rights under this License and You agree to 423 | work with Initial Developer and Contributors to distribute such 424 | responsibility on an equitable basis. Nothing herein is intended or 425 | shall be deemed to constitute any admission of liability. 426 | 427 | 13. MULTIPLE-LICENSED CODE. 428 | 429 | Initial Developer may designate portions of the Covered Code as 430 | "Multiple-Licensed". "Multiple-Licensed" means that the Initial 431 | Developer permits you to utilize portions of the Covered Code under 432 | Your choice of the NPL or the alternative licenses, if any, specified 433 | by the Initial Developer in the file described in Exhibit A. 434 | 435 | 436 | Software distributed under the License is distributed on an "AS IS" 437 | basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the 438 | License for the specific language governing rights and limitations 439 | under the License. 440 | 441 | For information who the copyright holder are and who contributed, 442 | take a look at README.markdown 443 | 444 | Alternatively, the contents of these files may be used under the terms 445 | of the MIT license (the "MIT License"), in which case the 446 | provisions of MIT License are applicable instead of those 447 | above. If you wish to allow use of your version of these file only 448 | under the terms of the MIT License and not to allow others to use 449 | your version of this file under the MPL, indicate your decision by 450 | deleting the provisions above and replace them with the notice and 451 | other provisions required by the MIT License. If you do not delete 452 | the provisions above, a recipient may use your version of these files 453 | under either the MPL or the MIT License. 454 | -------------------------------------------------------------------------------- /demos/PropertyEditor/demo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/frostney/superobject/abfa1ee1f4a96a5b4bbc241848cea066ae5fb432/demos/PropertyEditor/demo.png -------------------------------------------------------------------------------- /demos/PropertyEditor/soeditor.pas: -------------------------------------------------------------------------------- 1 | unit soeditor; 2 | 3 | interface 4 | uses superobject, classes, DesignIntf, DesignEditors; 5 | 6 | type 7 | 8 | TSuperObjectProperty = class(TNestedProperty) 9 | private 10 | FName: string; 11 | FPath: ISuperObject; 12 | function GetNode: ISuperObject; 13 | public 14 | function GetName: string; override; 15 | constructor Create(Parent: TPropertyEditor; const name: string; const path: ISuperObject); reintroduce; 16 | function GetAttributes: TPropertyAttributes; override; 17 | function GetValue: string; override; 18 | procedure SetValue(const Value: string); override; 19 | procedure GetProperties(Proc: TGetPropProc); override; 20 | procedure GetValues(Proc: TGetStrProc); override; 21 | end; 22 | 23 | procedure Register; 24 | 25 | implementation 26 | uses SysUtils; 27 | 28 | procedure Register; 29 | begin 30 | RegisterPropertyEditor(TypeInfo(ISuperObject), nil, '', TSuperObjectProperty); 31 | end; 32 | 33 | { TSuperObjectProperty } 34 | 35 | constructor TSuperObjectProperty.Create(Parent: TPropertyEditor; const name: string; const path: ISuperObject); 36 | begin 37 | inherited Create(Parent); 38 | FName := name; 39 | FPath := path; 40 | end; 41 | 42 | function TSuperObjectProperty.GetAttributes: TPropertyAttributes; 43 | var 44 | node: ISuperObject; 45 | count: Integer; 46 | const 47 | common = [paValueEditable, paValueList, paRevertable]; 48 | begin 49 | node := GetNode; 50 | case ObjectGetType(node) of 51 | stObject: count := node.AsObject.count; 52 | stArray : count := node.AsArray.Length; 53 | else 54 | count := 0; 55 | end; 56 | if count > 0 then 57 | result := common + [paSubProperties, paVolatileSubProperties] else 58 | result := common; 59 | end; 60 | 61 | function TSuperObjectProperty.GetName: string; 62 | begin 63 | if FName <> '' then 64 | Result := FName else 65 | Result := inherited; 66 | end; 67 | 68 | function TSuperObjectProperty.GetNode: ISuperObject; 69 | var 70 | v: IInterface; 71 | begin 72 | if FPath = nil then 73 | begin 74 | v := GetIntfValue; 75 | if v = nil then 76 | Result := TSuperObject.Create(stNull) else 77 | Result := v as ISuperObject; 78 | end else 79 | Result := FPath.N[FName]; 80 | end; 81 | 82 | procedure TSuperObjectProperty.GetProperties(Proc: TGetPropProc); 83 | var 84 | node: ISuperObject; 85 | entry: TSuperObjectIter; 86 | i: Integer; 87 | list: TStringList; 88 | begin 89 | node := GetNode; 90 | case ObjectGetType(node) of 91 | stObject: 92 | begin 93 | list := TStringList.Create; 94 | try 95 | if ObjectFindFirst(node, entry) then 96 | repeat 97 | list.Add(entry.key); 98 | until not ObjectFindNext(entry); 99 | ObjectFindClose(entry); 100 | list.Sort; 101 | for i := 0 to list.Count - 1 do 102 | proc(TSuperObjectProperty.Create(Self, list[i], node) as IProperty); 103 | finally 104 | list.Free; 105 | end; 106 | end; 107 | stArray : 108 | for i := 0 to node.AsArray.Length - 1 do 109 | proc(TSuperObjectProperty.Create(Self, IntToStr(i), node) as IProperty); 110 | end; 111 | end; 112 | 113 | function TSuperObjectProperty.GetValue: string; 114 | begin 115 | Result := GetNode.AsJSon(false, false); 116 | end; 117 | 118 | procedure TSuperObjectProperty.GetValues(Proc: TGetStrProc); 119 | begin 120 | case GetNode.DataType of 121 | stNull, stDouble, stInt, stString, stObject, stArray: 122 | begin 123 | Proc('{}'); 124 | Proc('[]'); 125 | Proc('""'); 126 | Proc('null'); 127 | Proc('true'); 128 | Proc('false'); 129 | Proc('0'); 130 | Proc('0.0'); 131 | end; 132 | stBoolean: 133 | begin 134 | Proc('true'); 135 | Proc('false'); 136 | end; 137 | end; 138 | end; 139 | 140 | procedure TSuperObjectProperty.SetValue(const Value: string); 141 | begin 142 | if FPath = nil then 143 | SetIntfValue(SO(Value)) else 144 | FPath[FName] := SO(Value); 145 | Modified; 146 | end; 147 | 148 | end. 149 | -------------------------------------------------------------------------------- /demos/RTTI/main.dfm: -------------------------------------------------------------------------------- 1 | object SearchForm: TSearchForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'SearchForm' 5 | ClientHeight = 290 6 | ClientWidth = 426 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | DesignSize = ( 15 | 426 16 | 290) 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object GSearch: TEdit 20 | Left = 8 21 | Top = 8 22 | Width = 370 23 | Height = 21 24 | TabOrder = 0 25 | end 26 | object go: TButton 27 | Left = 384 28 | Top = 8 29 | Width = 34 30 | Height = 25 31 | Caption = 'go' 32 | TabOrder = 1 33 | OnClick = goClick 34 | end 35 | object ResultList: TListBox 36 | Left = 8 37 | Top = 40 38 | Width = 409 39 | Height = 241 40 | Anchors = [akLeft, akTop, akRight, akBottom] 41 | ItemHeight = 13 42 | TabOrder = 2 43 | end 44 | end 45 | -------------------------------------------------------------------------------- /demos/RTTI/main.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/frostney/superobject/abfa1ee1f4a96a5b4bbc241848cea066ae5fb432/demos/RTTI/main.pas -------------------------------------------------------------------------------- /demos/RTTI/rttisearch.dpr: -------------------------------------------------------------------------------- 1 | program rttisearch; 2 | 3 | uses 4 | Forms, 5 | main in 'main.pas' {SearchForm}, 6 | superobject in '..\..\superobject.pas'; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.MainFormOnTaskbar := True; 13 | Application.CreateForm(TSearchForm, SearchForm); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /demos/VirtualTreeView/main.dfm: -------------------------------------------------------------------------------- 1 | object MainForm: TMainForm 2 | Left = 275 3 | Top = 276 4 | Caption = 'SuperObject Editor' 5 | ClientHeight = 520 6 | ClientWidth = 625 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | Menu = MainMenu 14 | OldCreateOrder = False 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object Splitter1: TSplitter 18 | Left = 0 19 | Top = 345 20 | Width = 625 21 | Height = 2 22 | Cursor = crVSplit 23 | Align = alBottom 24 | end 25 | object treeview: TVirtualStringTree 26 | Left = 0 27 | Top = 21 28 | Width = 625 29 | Height = 324 30 | Align = alClient 31 | EditDelay = 200 32 | Header.AutoSizeIndex = 0 33 | Header.DefaultHeight = 17 34 | Header.Font.Charset = DEFAULT_CHARSET 35 | Header.Font.Color = clWindowText 36 | Header.Font.Height = -11 37 | Header.Font.Name = 'Tahoma' 38 | Header.Font.Style = [] 39 | Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoVisible] 40 | Header.SortColumn = 0 41 | Header.Style = hsFlatButtons 42 | TabOrder = 0 43 | TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking, toAutoDeleteMovedNodes] 44 | TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning] 45 | TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toShowRoot, toShowTreeLines, toShowVertGridLines, toThemeAware, toUseBlendedImages, toUseBlendedSelection] 46 | TreeOptions.SelectionOptions = [toFullRowSelect] 47 | OnChange = treeviewChange 48 | OnCompareNodes = treeviewCompareNodes 49 | OnFreeNode = treeviewFreeNode 50 | OnGetText = treeviewGetText 51 | OnGetNodeDataSize = treeviewGetNodeDataSize 52 | OnHeaderClick = treeviewHeaderClick 53 | Columns = < 54 | item 55 | Position = 0 56 | Width = 246 57 | WideText = 'key' 58 | end 59 | item 60 | Position = 1 61 | Width = 300 62 | WideText = 'value' 63 | end> 64 | WideDefaultText = '' 65 | end 66 | object StatusBar: TStatusBar 67 | Left = 0 68 | Top = 501 69 | Width = 625 70 | Height = 19 71 | Panels = <> 72 | SimplePanel = True 73 | end 74 | object Memo: TMemo 75 | Left = 0 76 | Top = 347 77 | Width = 625 78 | Height = 154 79 | Align = alBottom 80 | ScrollBars = ssVertical 81 | TabOrder = 2 82 | end 83 | object Panel1: TPanel 84 | Left = 0 85 | Top = 0 86 | Width = 625 87 | Height = 21 88 | Align = alTop 89 | BevelOuter = bvNone 90 | Caption = 'Panel1' 91 | TabOrder = 3 92 | DesignSize = ( 93 | 625 94 | 21) 95 | object edGetURL: TEdit 96 | Left = 0 97 | Top = 0 98 | Width = 625 99 | Height = 21 100 | Anchors = [akLeft, akTop, akRight] 101 | TabOrder = 0 102 | Text = 103 | 'http://www.google.com/uds/GwebSearch?rsz=large&v=1.0&q=open sour' + 104 | 'ce' 105 | OnKeyPress = edGetURLKeyPress 106 | end 107 | end 108 | object MainMenu: TMainMenu 109 | Left = 16 110 | Top = 160 111 | object mFile: TMenuItem 112 | Caption = '&File' 113 | object Open1: TMenuItem 114 | Action = acFileOpen 115 | end 116 | end 117 | object Options1: TMenuItem 118 | Caption = '&Options' 119 | object acPackxml: TMenuItem 120 | Action = Action1 121 | end 122 | end 123 | end 124 | object ActionList: TActionList 125 | Left = 16 126 | Top = 192 127 | object acFileOpen: TFileOpen 128 | Category = 'Fichier' 129 | Caption = '&Open...' 130 | Dialog.Filter = 131 | 'all know files (*.json, *.xml)|*.json;*.xml|json (*.json)|*.json' + 132 | '|xml (*.xml)|*.xml' 133 | Hint = 'Ouvrir|Ouvrir un fichier existant' 134 | ImageIndex = 7 135 | ShortCut = 16463 136 | OnAccept = acFileOpenAccept 137 | end 138 | object Action1: TAction 139 | Caption = 'pack xml' 140 | Checked = True 141 | OnExecute = Action1Execute 142 | end 143 | end 144 | end 145 | -------------------------------------------------------------------------------- /demos/VirtualTreeView/main.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/frostney/superobject/abfa1ee1f4a96a5b4bbc241848cea066ae5fb432/demos/VirtualTreeView/main.pas -------------------------------------------------------------------------------- /demos/VirtualTreeView/sample.json: -------------------------------------------------------------------------------- 1 | { "store": { 2 | "book": [ 3 | { "category": "reference", 4 | "author": "Nigel Rees", 5 | "title": "Sayings of the Century", 6 | "price": 8.95 7 | }, 8 | { "category": "fiction", 9 | "author": "Evelyn Waugh", 10 | "title": "Sword of Honour", 11 | "price": 12.99 12 | }, 13 | { "category": "fiction", 14 | "author": "Herman Melville", 15 | "title": "Moby Dick", 16 | "isbn": "0-553-21311-3", 17 | "price": 8.99 18 | }, 19 | { "category": "fiction", 20 | "author": "J. R. R. Tolkien", 21 | "title": "The Lord of the Rings", 22 | "isbn": "0-395-19395-8", 23 | "price": 22.99 24 | } 25 | ], 26 | "bicycle": { 27 | "color": "red", 28 | "price": 19.95 29 | } 30 | } 31 | } -------------------------------------------------------------------------------- /demos/VirtualTreeView/soedit.dpr: -------------------------------------------------------------------------------- 1 | program soedit; 2 | 3 | uses 4 | Forms, 5 | main in 'main.pas' {MainForm}, 6 | superobject in '..\..\superobject.pas', 7 | superxmlparser in '..\..\superxmlparser.pas'; 8 | 9 | {$R *.res} 10 | 11 | begin 12 | Application.Initialize; 13 | {$IFDEF UNICODE} 14 | Application.MainFormOnTaskbar := True; 15 | {$ENDIF} 16 | Application.CreateForm(TMainForm, MainForm); 17 | Application.Run; 18 | end. 19 | -------------------------------------------------------------------------------- /demos/googlesearch/main.dfm: -------------------------------------------------------------------------------- 1 | object SearchForm: TSearchForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'SearchForm' 5 | ClientHeight = 290 6 | ClientWidth = 426 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | DesignSize = ( 15 | 426 16 | 290) 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object GSearch: TEdit 20 | Left = 8 21 | Top = 8 22 | Width = 370 23 | Height = 21 24 | TabOrder = 0 25 | end 26 | object go: TButton 27 | Left = 384 28 | Top = 8 29 | Width = 34 30 | Height = 25 31 | Caption = 'go' 32 | TabOrder = 1 33 | OnClick = goClick 34 | end 35 | object ResultList: TListBox 36 | Left = 8 37 | Top = 40 38 | Width = 409 39 | Height = 241 40 | Anchors = [akLeft, akTop, akRight, akBottom] 41 | ItemHeight = 13 42 | TabOrder = 2 43 | end 44 | end 45 | -------------------------------------------------------------------------------- /demos/googlesearch/main.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/frostney/superobject/abfa1ee1f4a96a5b4bbc241848cea066ae5fb432/demos/googlesearch/main.pas -------------------------------------------------------------------------------- /demos/googlesearch/search.dpr: -------------------------------------------------------------------------------- 1 | program search; 2 | 3 | uses 4 | Forms, 5 | main in 'main.pas' {SearchForm}, 6 | superobject in '..\..\superobject.pas'; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.MainFormOnTaskbar := True; 13 | Application.CreateForm(TSearchForm, SearchForm); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /demos/googlesuggest/main.dfm: -------------------------------------------------------------------------------- 1 | object SuggestForm: TSuggestForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Google Suggest' 5 | ClientHeight = 293 6 | ClientWidth = 426 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object GSearch: TEdit 17 | Left = 8 18 | Top = 8 19 | Width = 409 20 | Height = 21 21 | TabOrder = 0 22 | OnChange = GSearchChange 23 | end 24 | object SuggestList: TListBox 25 | Left = 8 26 | Top = 40 27 | Width = 401 28 | Height = 225 29 | ItemHeight = 13 30 | TabOrder = 1 31 | end 32 | end 33 | -------------------------------------------------------------------------------- /demos/googlesuggest/main.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/frostney/superobject/abfa1ee1f4a96a5b4bbc241848cea066ae5fb432/demos/googlesuggest/main.pas -------------------------------------------------------------------------------- /demos/googlesuggest/suggest.dpr: -------------------------------------------------------------------------------- 1 | program suggest; 2 | 3 | uses 4 | Forms, 5 | main in 'main.pas' {SuggestForm}, 6 | superobject in '..\..\superobject.pas'; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.MainFormOnTaskbar := True; 13 | Application.CreateForm(TSuggestForm, SuggestForm); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | This is a fork of [http://code.google.com/p/superobject](http://code.google.com/p/superobject) 2 | 3 | # SuperObject # 4 | 5 | **What is JSON ?** 6 | 7 | JSON (JavaScript Object Notation) is a lightweight data-interchange format. 8 | It is easy for humans to read and write. 9 | It is easy for machines to parse and generate. 10 | It is based on a subset of the JavaScript Programming Language, Standard ECMA-262 3rd Edition - December 1999. 11 | JSON is a text format that is completely language independent but uses conventions that are familiar to programmers. 12 | These properties make JSON an ideal data-interchange language. 13 | You can get more informations on [json.org](http://www.json.org). 14 | 15 | { 16 | "name": "Henri Gourvest", /* this is a comment */ 17 | "vip": true, 18 | "telephones": ["000000000", "111111111111"], 19 | "age": 33, 20 | "size": 1.83, 21 | "adresses": [ 22 | { 23 | "adress": "blabla", 24 | "city": "Metz", 25 | "pc": 57000 26 | }, 27 | { 28 | "adress": "blabla", 29 | "city": "Nantes", 30 | "pc": 44000 31 | } 32 | ] 33 | } 34 | 35 | **Parsing a JSON data structure** 36 | 37 | var 38 | obj: ISuperObject; 39 | begin 40 | obj := SO('{"foo": true}'); 41 | obj := TSuperObject.ParseString('{"foo": true}'); 42 | obj := TSuperObject.ParseStream(stream); 43 | obj := TSuperObject.ParseFile(FileName); 44 | end; 45 | 46 | **Accessing data** 47 | 48 | There isn't individual datastructure for each supported data types. 49 | They are all an object: the ISuperObject. 50 | 51 | val := obj.AsString; 52 | val := obj.AsInteger; 53 | val := obj.AsBoolean; 54 | val := obj.AsDouble; 55 | val := obj.AsArray; 56 | val := obj.AsObject; 57 | val := obj.AsMethod; 58 | 59 | **How to read a property value of an object ?** 60 | 61 | val := obj.AsObject.S['foo']; // get a string 62 | val := obj.AsObject.I['foo']; // get an Int64 63 | val := obj.AsObject.B['foo']; // get a Boolean 64 | val := obj.AsObject.D['foo']; // get a Double 65 | val := obj.AsObject.O['foo']; // get an Object (default) 66 | val := obj.AsObject.M['foo']; // get a Method 67 | val := obj.AsObject.N['foo']; // get a null object 68 | 69 | **How to read a value from an array ?** 70 | 71 | // the advanced way 72 | val := obj.AsArray.S[0]; // get a string 73 | val := obj.AsArray.I[0]; // get an Int64 74 | val := obj.AsArray.B[0]; // get a Boolean 75 | val := obj.AsArray.D[0]; // get a Double 76 | val := obj.AsArray.O[0]; // get an Object (default) 77 | val := obj.AsArray.M[0]; // get a Method 78 | val := obj.AsArray.N[0]; // get a null object 79 | 80 | **Using paths** 81 | 82 | Using paths is a very productive method to find an object when you know where is it. 83 | This is some usage cases: 84 | 85 | obj['foo']; // get a property 86 | obj['123']; // get an item array 87 | obj['foo.list']; // get a property from an object 88 | obj['foo[123]']; // get an item array from an object 89 | obj['foo(1,2,3)']; // call a method 90 | obj['foo[]'] := value; // add an item array 91 | 92 | you also can encapsulate paths: 93 | 94 | obj := so('{"index": 1, "items": ["item 1", "item 2", "item 3"]}'); 95 | obj['items[index]'] // return "item 2" 96 | 97 | or recreate a new data structure from another: 98 | 99 | obj := so('{"index": 1, "items": ["item 1", "item 2", "item 3"]}'); 100 | obj['{"item": items[index], "index": index}'] // return {"item": "item 2", "index": 1} 101 | 102 | **Browsing data structure** 103 | 104 | *Using Delphi enumerator.* 105 | 106 | Using Delphi enumerator you can browse item's array or property's object value in the same maner. 107 | 108 | var 109 | item: ISuperObject; 110 | begin 111 | for item in obj['items'] do ... 112 | 113 | you can also browse the keys and values of an object like this: 114 | 115 | var 116 | item: TSuperAvlEntry; 117 | begin 118 | for item in obj.AsObject do ... 119 | begin 120 | item.Name; 121 | item.Value; 122 | end; 123 | 124 | *Browsing object properties without enumerator* 125 | 126 | var 127 | item: TSuperObjectIter; 128 | begin 129 | if ObjectFindFirst(obj, item) then 130 | repeat 131 | item.key; 132 | item.val; 133 | until not ObjectFindNext(item); 134 | ObjectFindClose(item); 135 | 136 | *Browsing array items without enumerator* 137 | 138 | var 139 | item: Integer; 140 | begin 141 | for item := 0 to obj.AsArray.Length - 1 do 142 | obj.AsArray[item] 143 | 144 | **RTTI & marshalling in Delphi 2010** 145 | 146 | type 147 | TData = record 148 | str: string; 149 | int: Integer; 150 | bool: Boolean; 151 | flt: Double; 152 | end; 153 | var 154 | ctx: TSuperRttiContext; 155 | data: TData; 156 | obj: ISuperObject; 157 | begin 158 | ctx := TSuperRttiContext.Create; 159 | try 160 | data := ctx.AsType(SO('{str: "foo", int: 123, bool: true, flt: 1.23}')); 161 | obj := ctx.AsJson(data); 162 | finally 163 | ctx.Free; 164 | end; 165 | end; 166 | 167 | **Saving data** 168 | 169 | obj.AsJSon(options); 170 | obj.SaveTo(stream); 171 | obj.SaveTo(filename); 172 | 173 | **Helpers** 174 | 175 | SO(['prop1', true, 'prop2', 123]); // return an object {"prop1": true, "prop2": 123} 176 | SA([true, 123]); // return an array [true, 123] 177 | 178 | **Non canonical forms** 179 | 180 | The SuperObject is able to parse non canonical forms. 181 | 182 | // unquoted identifiers 183 | SO('{foo: true}'); 184 | // unescaped or unquoted strings 185 | SO('{собственность: bla bla bla}'); 186 | // excadecimal 187 | SO('{foo: \xFF}'); 188 | -------------------------------------------------------------------------------- /superxmlparser.pas: -------------------------------------------------------------------------------- 1 | (* 2 | * Super Object Toolkit 3 | * 4 | * Usage allowed under the restrictions of the Lesser GNU General Public License 5 | * or alternatively the restrictions of the Mozilla Public License 1.1 6 | * 7 | * Software distributed under the License is distributed on an "AS IS" basis, 8 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 9 | * the specific language governing rights and limitations under the License. 10 | * 11 | * Embarcadero Technologies Inc is not permitted to use or redistribute 12 | * this source code without explicit permission. 13 | * 14 | * Unit owner : Henri Gourvest 15 | * Web site : http://www.progdigy.com 16 | *) 17 | 18 | unit superxmlparser; 19 | {$IFDEF FPC} 20 | {$MODE OBJFPC}{$H+} 21 | {$ENDIF} 22 | 23 | interface 24 | 25 | uses superobject, classes; 26 | 27 | 28 | type 29 | TOnProcessingInstruction = procedure(const PI, PIParent: ISuperObject); 30 | 31 | function XMLParseString(const data: SOString; pack: Boolean = false; onpi: TOnProcessingInstruction = nil): ISuperObject; 32 | function XMLParseStream(stream: TStream; pack: Boolean = false; onpi: TOnProcessingInstruction = nil): ISuperObject; 33 | function XMLParseFile(const FileName: string; pack: Boolean = false; onpi: TOnProcessingInstruction = nil): ISuperObject; 34 | 35 | {$IFDEF UNICODE} 36 | type 37 | TXMLWriteMethod = reference to procedure(const data: string); 38 | procedure XMLWrite(const node: ISuperObject; const method: TXMLWriteMethod); 39 | {$ENDIF} 40 | 41 | const 42 | xmlname = '#name'; 43 | xmlattributes = '#attributes'; 44 | xmlchildren = '#children'; 45 | xmltext = '#text'; 46 | 47 | dtdname = '#name'; 48 | dtdPubidLiteral = '#pubidliteral'; 49 | dtdSystemLiteral = '#systemliteral'; 50 | 51 | 52 | implementation 53 | uses sysutils {$IFNDEF UNIX}, windows{$ENDIF}; 54 | 55 | const 56 | XML_SPACE : PSOChar = #32; 57 | // XML_ARL: PSOChar = '['; 58 | XML_ARR: PSOChar = ']'; 59 | XML_BIG: PSOChar = '>'; 60 | XML_LOW: PSOChar = '<'; 61 | XML_AMP: PSOChar = '&'; 62 | XML_SQU: PSOChar = ''''; 63 | XML_DQU: PSOChar = '"'; 64 | 65 | type 66 | TSuperXMLState = ( 67 | xsStart, // | 68 | xsEatSpaces, // 69 | xsElement, // <| 70 | xsElementName, // <[a..z]| 71 | xsAttributes, // ..<| 77 | xsCloseElementName, // ..| 79 | xsElementString, // |azer 80 | xsElementComment, // 93 | xsElementPI, // 96 | xsElementCDATA, // 98 | xsEscape, // &| 99 | xsEscape_lt, // &l|t; 100 | xsEscape_gt, // &g|t; 101 | xsEscape_amp, // &a|mp; 102 | xsEscape_apos, // &a|pos; 103 | xsEscape_quot, // &q|uot; 104 | xsEscape_char, // &#|; 105 | xsEscape_char_num, // |123456; 106 | xsEscape_char_hex, // &#x|000FFff; 107 | xsEnd); 108 | 109 | TSuperXMLError = (xeSuccess, xeContinue, xeProcessInst, xeError); 110 | TSuperXMLElementClass = (xcNone, xcElement, xcComment, xcString, xcCdata, xcDocType, xcProcessInst); 111 | TSuperXMLEncoding = ({$IFNDEF UNIX}xnANSI,{$ENDIF} xnUTF8, xnUnicode); 112 | 113 | {$IFDEF UNICODE} 114 | procedure XMLWrite(const node: ISuperObject; const method: TXMLWriteMethod); 115 | var 116 | o: ISuperObject; 117 | ent: TSuperAvlEntry; 118 | str: string; 119 | begin 120 | str := '<' + node.S[xmlname]; 121 | if ObjectIsType(node[xmlattributes], stObject) then 122 | for ent in node[xmlattributes].AsObject do 123 | str := str + ' ' + ent.Name + '="' + ent.Value.AsString + '"'; 124 | if ObjectIsType(node[xmlchildren], stArray) then 125 | begin 126 | method(str + '>'); 127 | for o in node[xmlchildren] do 128 | if ObjectIsType(o, stString) then 129 | method(o.AsString) else 130 | XMLWrite(o, method); 131 | method(''); 132 | end else 133 | method(str + '/>'); 134 | end; 135 | {$ENDIF} 136 | 137 | type 138 | PSuperXMLStack = ^TSuperXMLStack; 139 | TSuperXMLStack = record 140 | state: TSuperXMLState; 141 | savedstate: TSuperXMLState; 142 | prev: PSuperXMLStack; 143 | next: PSuperXMLStack; 144 | clazz: TSuperXMLElementClass; 145 | obj: ISuperObject; 146 | end; 147 | 148 | TSuperXMLParser = class 149 | private 150 | FStack: PSuperXMLStack; 151 | FDocType: ISuperObject; 152 | FError: TSuperXMLError; 153 | FStr: TSuperWriterString; 154 | FValue: TSuperWriterString; 155 | FPosition: Integer; 156 | FAChar: SOChar; 157 | FPack: Boolean; 158 | procedure StackUp; 159 | procedure StackDown; 160 | procedure Reset; 161 | function ParseBuffer(data: PSOChar; var PI, PIParent: ISuperObject; len: Integer = -1): Integer; 162 | public 163 | constructor Create(pack: Boolean); 164 | destructor Destroy; override; 165 | end; 166 | 167 | { TXMLContext } 168 | 169 | constructor TSuperXMLParser.Create(pack: Boolean); 170 | begin 171 | FDocType := nil; 172 | FStr := TSuperWriterString.Create; 173 | FValue := TSuperWriterString.Create; 174 | StackUp; 175 | FError := xeSuccess; 176 | FPack := pack; 177 | end; 178 | 179 | destructor TSuperXMLParser.Destroy; 180 | begin 181 | while FStack <> nil do 182 | StackDown; 183 | FStr.Free; 184 | FValue.Free; 185 | end; 186 | 187 | procedure TSuperXMLParser.Reset; 188 | begin 189 | while FStack <> nil do 190 | StackDown; 191 | StackUp; 192 | FError := xeSuccess; 193 | end; 194 | 195 | function TSuperXMLParser.ParseBuffer(data: PSOChar; var PI, PIParent: ISuperObject; len: integer): Integer; 196 | const 197 | spaces = [#32,#9,#10,#13]; 198 | alphas = ['a'..'z', 'A'..'Z', '_', ':', #161..#255]; 199 | nums = ['0'..'9', '.', '-']; 200 | hex = nums + ['a'..'f','A'..'F']; 201 | alphanums = alphas + nums; 202 | publitteral = [#32, #13, #10, 'a'..'z', 'A'..'Z', '0'..'9', '-', '''', '"', '(', ')', 203 | '+', ',', '.', '/', ':', '=', '?', ';', '!', '*', '#', '@', '$', '_', '%']; 204 | 205 | function hexdigit(const x: SOChar): byte; 206 | begin 207 | if x <= '9' then 208 | Result := byte(x) - byte('0') else 209 | Result := (byte(x) and 7) + 9; 210 | end; 211 | 212 | procedure putchildrenstr; 213 | var 214 | anobject: ISuperObject; 215 | begin 216 | anobject := FStack^.obj.AsObject[xmlchildren]; 217 | if anobject = nil then 218 | begin 219 | anobject := TSuperObject.Create(stArray); 220 | FStack^.obj.AsObject[xmlchildren] := anobject; 221 | end; 222 | anobject.AsArray.Add(TSuperObject.Create(FValue.Data)); 223 | end; 224 | 225 | procedure AddProperty(const parent, value: ISuperObject; const name: SOString); 226 | var 227 | anobject: ISuperObject; 228 | arr: ISuperObject; 229 | begin 230 | anobject := parent.AsObject[name]; 231 | if anobject = nil then 232 | parent.AsObject[name] := value else 233 | begin 234 | if (anobject.DataType = stArray) then 235 | anobject.AsArray.Add(value) else 236 | begin 237 | arr := TSuperObject.Create(stArray); 238 | arr.AsArray.Add(anobject); 239 | arr.AsArray.Add(value); 240 | parent.AsObject[name] := arr; 241 | end; 242 | end; 243 | end; 244 | 245 | procedure packend; 246 | var 247 | anobject, anobject2: ISuperObject; 248 | n: Integer; 249 | begin 250 | anobject := FStack^.obj.AsObject[xmlchildren]; 251 | if (anobject <> nil) and (anobject.AsArray.Length = 1) and (anobject.AsArray[0].DataType = stString) then 252 | begin 253 | if FStack^.obj.AsObject.count = 2 then // name + children 254 | begin 255 | if FStack^.prev <> nil then 256 | AddProperty(FStack^.prev^.obj, anobject.AsArray[0], FStack^.obj.AsObject.S[xmlname]) else 257 | begin 258 | AddProperty(FStack^.obj, anobject.AsArray[0], xmltext); 259 | FStack^.obj.AsObject.Delete(xmlchildren); 260 | end; 261 | end 262 | else 263 | begin 264 | AddProperty(FStack^.obj, anobject.AsArray[0], FStack^.obj.AsObject.S[xmlname]); 265 | FStack^.obj.AsObject.Delete(xmlchildren); 266 | if FStack^.prev <> nil then 267 | AddProperty(FStack^.prev^.obj, FStack^.obj, FStack^.obj.AsObject.S[xmlname]) else 268 | FStack^.obj.AsObject.Delete(xmlchildren); 269 | FStack^.obj.AsObject.Delete(xmlname); 270 | end; 271 | end else 272 | begin 273 | if (anobject <> nil) then 274 | begin 275 | for n := 0 to anobject.AsArray.Length - 1 do 276 | begin 277 | anobject2 := anobject.AsArray[n]; 278 | if ObjectIsType(anobject2, stObject) then 279 | begin 280 | AddProperty(FStack^.obj, anobject2, anobject2.AsObject.S[xmlname]); 281 | anobject2.AsObject.Delete(xmlname); 282 | end else 283 | AddProperty(FStack^.obj, anobject2, xmltext); 284 | end; 285 | FStack^.obj.Delete(xmlchildren); 286 | end; 287 | if (FStack^.prev <> nil) and (FStack^.obj.AsObject.count > 1) then 288 | begin 289 | if (FStack^.obj.AsObject.count = 2) and (FStack^.obj.AsObject[xmltext] <> nil) then 290 | AddProperty(FStack^.prev^.obj, FStack^.obj.AsObject[xmltext], FStack^.obj.AsObject.S[xmlname]) else 291 | AddProperty(FStack^.prev^.obj, FStack^.obj, FStack^.obj.AsObject.S[xmlname]); 292 | end; 293 | FStack^.obj.Delete(xmlname); 294 | end; 295 | end; 296 | 297 | var 298 | c: SOChar; 299 | read: Integer; 300 | p: PSOChar; 301 | anobject: ISuperObject; 302 | label 303 | redo, err; 304 | begin 305 | p := data; 306 | read := 0; 307 | //Result := 0; 308 | repeat 309 | 310 | if (read = len) then 311 | begin 312 | if (FStack^.prev = nil) and ((FStack^.state = xsEnd) or ((FStack^.state = xsEatSpaces) and (FStack^.savedstate = xsEnd))) then 313 | begin 314 | if FPack then 315 | packend; 316 | FError := xeSuccess; 317 | end else 318 | FError := xeContinue; 319 | Result := read; 320 | exit; 321 | end; 322 | c := p^; 323 | redo: 324 | case FStack^.state of 325 | 326 | xsEatSpaces: 327 | if {$IFDEF UNICODE}(c < #256) and {$ENDIF} (AnsiChar(c) in spaces) then {nop} else 328 | begin 329 | FStack^.state := FStack^.savedstate; 330 | goto redo; 331 | end; 332 | 333 | xsStart: 334 | case c of 335 | '<': FStack^.state := xsElement; 336 | else 337 | goto err; 338 | end; 339 | xsElement: 340 | begin 341 | case c of 342 | '?': 343 | begin 344 | FStack^.savedstate := xsStart; 345 | FStack^.state := xsEatSpaces; 346 | StackUp; 347 | FStr.Reset; 348 | FStack^.state := xsElementPI; 349 | FStack^.clazz := xcProcessInst; 350 | end; 351 | '!': 352 | begin 353 | FPosition := 0; 354 | FStack^.state := xsElementComment; 355 | FStack^.clazz := xcComment; 356 | end; 357 | else 358 | if ((c < #256) and (AnsiChar(c) in alphas)) or (c >= #256) then 359 | begin 360 | FStr.Reset; 361 | FStack^.state := xsElementName; 362 | FStack^.clazz := xcElement; 363 | goto redo; 364 | end else 365 | goto err; 366 | end; 367 | end; 368 | xsElementPI: 369 | begin 370 | if ((c < #256) and (AnsiChar(c) in alphanums)) or (c >= #256) then 371 | FStr.Append(@c, 1) else 372 | begin 373 | FStack^.obj := TSuperObject.Create(stObject); 374 | FStack^.obj.AsObject.S[xmlname] := FStr.Data; 375 | FStack^.state := xsEatSpaces; 376 | if FStr.Data = 'xml' then 377 | FStack^.savedstate := xsAttributes else 378 | begin 379 | FValue.Reset; 380 | FStack^.savedstate := xsElementDataPI; 381 | end; 382 | goto redo; 383 | end; 384 | end; 385 | xsElementDataPI: 386 | begin 387 | case c of 388 | '?': 389 | begin 390 | FStack^.obj.AsObject.S['data'] := FValue.Data; 391 | FStack^.state := xsCloseElementPI; 392 | end; 393 | else 394 | FValue.Append(@c, 1); 395 | end; 396 | end; 397 | xsCloseElementPI: 398 | begin 399 | if (c <> '>') then goto err; 400 | PI := FStack^.obj; 401 | StackDown; 402 | PIParent := FStack^.obj; 403 | FError := xeProcessInst; 404 | Result := read + 1; 405 | Exit; 406 | end; 407 | xsElementName: 408 | begin 409 | if ((c < #256) and (AnsiChar(c) in alphanums)) or (c >= #256) then 410 | FStr.Append(@c, 1) else 411 | begin 412 | FStack^.obj := TSuperObject.Create(stObject); 413 | FStack^.obj.AsObject.S[xmlname] := FStr.Data; 414 | FStack^.state := xsEatSpaces; 415 | FStack^.savedstate := xsAttributes; 416 | goto redo; 417 | end; 418 | end; 419 | xsChildren: 420 | begin 421 | case c of 422 | '<': FStack^.state := xsTryCloseElement; 423 | else 424 | FValue.Reset; 425 | FStack^.state := xsElementString; 426 | FStack^.clazz := xcString; 427 | goto redo; 428 | end; 429 | end; 430 | xsCloseEmptyElement: 431 | begin 432 | case c of 433 | '>': 434 | begin 435 | FStack^.state := xsEatSpaces; 436 | FStack^.savedstate := xsEnd; 437 | end 438 | else 439 | goto err; 440 | end; 441 | end; 442 | xsTryCloseElement: 443 | begin 444 | case c of 445 | '/': begin 446 | FStack^.state := xsCloseElementName; 447 | FPosition := 0; 448 | FStr.Reset; 449 | FStr.Append(PSoChar(FStack^.obj.AsObject.S[xmlname])); 450 | end; 451 | '!': begin 452 | FPosition := 0; 453 | FStack^.state := xsElementComment; 454 | FStack^.clazz := xcComment; 455 | end; 456 | '?': begin 457 | FStack^.savedstate := xsChildren; 458 | FStack^.state := xsEatSpaces; 459 | StackUp; 460 | FStr.Reset; 461 | FStack^.state := xsElementPI; 462 | FStack^.clazz := xcProcessInst; 463 | end 464 | else 465 | FStack^.state := xsChildren; 466 | StackUp; 467 | if ((c < #256) and (AnsiChar(c) in alphas)) or (c >= #256) then 468 | begin 469 | FStr.Reset; 470 | FStack^.state := xsElementName; 471 | FStack^.clazz := xcElement; 472 | goto redo; 473 | end else 474 | goto err; 475 | end; 476 | end; 477 | xsCloseElementName: 478 | begin 479 | if FStr.Position = FPosition then 480 | begin 481 | FStack^.savedstate := xsCloseEmptyElement; 482 | FStack^.state := xsEatSpaces; 483 | goto redo; 484 | end else 485 | begin 486 | if (c <> FStr.Data[FPosition]) then goto err; 487 | inc(FPosition); 488 | end; 489 | end; 490 | xsAttributes: 491 | begin 492 | case c of 493 | '?': begin 494 | if FStack^.clazz <> xcProcessInst then goto err; 495 | FStack^.state := xsCloseElementPI; 496 | end; 497 | '/': begin 498 | FStack^.state := xsCloseEmptyElement; 499 | end; 500 | '>': begin 501 | FStack^.state := xsEatSpaces; 502 | FStack^.savedstate := xsChildren; 503 | end 504 | else 505 | if ((c < #256) and (AnsiChar(c) in alphas)) or (c >= #256) then 506 | begin 507 | FStr.Reset; 508 | FStr.Append(@c, 1); 509 | FStack^.state := xsAttributeName; 510 | end else 511 | goto err; 512 | end; 513 | end; 514 | xsAttributeName: 515 | begin 516 | if ((c < #256) and (AnsiChar(c) in alphanums)) or (c >= #256) then 517 | FStr.Append(@c, 1) else 518 | begin 519 | // no duplicate attribute 520 | if FPack then 521 | begin 522 | if FStack^.obj.AsObject[FStr.Data] <> nil then 523 | goto err; 524 | end else 525 | begin 526 | anobject := FStack^.obj.AsObject[xmlattributes]; 527 | if (anobject <> nil) and (anobject.AsObject[FStr.Data] <> nil) then 528 | goto err; 529 | end; 530 | FStack^.state := xsEatSpaces; 531 | FStack^.savedstate := xsEqual; 532 | goto redo; 533 | end; 534 | end; 535 | xsEqual: 536 | begin 537 | if c <> '=' then goto err; 538 | FStack^.state := xsEatSpaces; 539 | FStack^.savedstate := xsAttributeValue; 540 | FValue.Reset; 541 | FPosition := 0; 542 | FAChar := #0; 543 | end; 544 | xsAttributeValue: 545 | begin 546 | if FAChar <> #0 then 547 | begin 548 | if (c = FAChar) then 549 | begin 550 | if FPack then 551 | begin 552 | FStack^.obj.AsObject[FStr.Data] := TSuperObject.Create(Fvalue.Data); 553 | end else 554 | begin 555 | anobject := FStack^.obj.AsObject[xmlattributes]; 556 | if anobject = nil then 557 | begin 558 | anobject := TSuperObject.Create(stObject); 559 | FStack^.obj.AsObject[xmlattributes] := anobject; 560 | end; 561 | anobject.AsObject[FStr.Data] := TSuperObject.Create(Fvalue.Data); 562 | end; 563 | FStack^.savedstate := xsAttributes; 564 | FStack^.state := xsEatSpaces; 565 | end else 566 | case c of 567 | '&': 568 | begin 569 | FStack^.state := xsEscape; 570 | FStack^.savedstate := xsAttributeValue; 571 | end; 572 | #13, #10: 573 | begin 574 | FValue.TrimRight; 575 | FValue.Append(XML_SPACE, 1); 576 | FStack^.state := xsEatSpaces; 577 | FStack^.savedstate := xsAttributeValue; 578 | end; 579 | else 580 | FValue.Append(@c, 1); 581 | end; 582 | 583 | end else 584 | begin 585 | if (c < #256) and (AnsiChar(c) in ['"', '''']) then 586 | begin 587 | FAChar := c; 588 | inc(FPosition); 589 | 590 | end else 591 | goto err; 592 | end; 593 | end; 594 | xsElementString: 595 | begin 596 | case c of 597 | '<': begin 598 | FValue.TrimRight; 599 | putchildrenstr; 600 | FStack^.state := xsTryCloseElement; 601 | end; 602 | #13, #10: 603 | begin 604 | FValue.TrimRight; 605 | FValue.Append(XML_SPACE, 1); 606 | FStack^.state := xsEatSpaces; 607 | FStack^.savedstate := xsElementString; 608 | end; 609 | '&': 610 | begin 611 | FStack^.state := xsEscape; 612 | FStack^.savedstate := xsElementString; 613 | end 614 | else 615 | FValue.Append(@c, 1); 616 | end; 617 | end; 618 | xsElementComment: 619 | begin 620 | case FPosition of 621 | 0: 622 | begin 623 | case c of 624 | '-': Inc(FPosition); 625 | '[': 626 | begin 627 | FValue.Reset; 628 | FPosition := 0; 629 | FStack^.state := xsElementCDATA; 630 | FStack^.clazz := xcCdata; 631 | end; 632 | 'D': 633 | begin 634 | if (FStack^.prev = nil) and (FDocType = nil) then 635 | begin 636 | FStack^.state := xsElementDocType; 637 | FPosition := 0; 638 | FStack^.clazz := xcDocType; 639 | end else 640 | goto err; 641 | end; 642 | else 643 | goto err; 644 | end; 645 | end; 646 | 1: 647 | begin 648 | if c <> '-' then goto err; 649 | Inc(FPosition); 650 | end; 651 | else 652 | if c = '-' then 653 | begin 654 | FPosition := 0; 655 | FStack^.state := xsCloseElementComment; 656 | end; 657 | end; 658 | end; 659 | xsCloseElementComment: 660 | begin 661 | case FPosition of 662 | 0: begin 663 | if c <> '-' then 664 | begin 665 | FPosition := 2; 666 | FStack^.state := xsElementComment; 667 | end else 668 | Inc(FPosition); 669 | end; 670 | 1: begin 671 | if c <> '>' then goto err; 672 | FStack^.state := xsEatSpaces; 673 | if FStack^.obj <> nil then 674 | FStack^.savedstate := xsChildren else 675 | FStack^.savedstate := xsStart; 676 | end; 677 | end; 678 | end; 679 | xsElementCDATA: 680 | begin 681 | case FPosition of 682 | 0: if (c = 'C') then inc(FPosition) else goto err; 683 | 1: if (c = 'D') then inc(FPosition) else goto err; 684 | 2: if (c = 'A') then inc(FPosition) else goto err; 685 | 3: if (c = 'T') then inc(FPosition) else goto err; 686 | 4: if (c = 'A') then inc(FPosition) else goto err; 687 | 5: if (c = '[') then inc(FPosition) else goto err; 688 | else 689 | case c of 690 | ']': begin 691 | FPosition := 0; 692 | FStack^.state := xsClodeElementCDATA; 693 | end; 694 | else 695 | FValue.Append(@c, 1); 696 | end; 697 | end; 698 | end; 699 | xsClodeElementCDATA: 700 | begin 701 | case FPosition of 702 | 0: if (c = ']') then 703 | inc(FPosition) else 704 | begin 705 | FValue.Append(XML_ARR, 1); 706 | FValue.Append(@c, 1); 707 | FPosition := 6; 708 | FStack^.state := xsElementCDATA; 709 | end; 710 | 1: case c of 711 | '>': 712 | begin 713 | putchildrenstr; 714 | FStack^.state := xsEatSpaces; 715 | FStack^.savedstate := xsChildren; 716 | end; 717 | ']': 718 | begin 719 | FValue.Append(@c, 1); 720 | end; 721 | else 722 | FValue.Append(@c, 1); 723 | FStack^.state := xsElementCDATA; 724 | end; 725 | end; 726 | end; 727 | xsElementDocType: 728 | begin 729 | case FPosition of 730 | 0: if (c = 'O') then inc(FPosition) else goto err; 731 | 1: if (c = 'C') then inc(FPosition) else goto err; 732 | 2: if (c = 'T') then inc(FPosition) else goto err; 733 | 3: if (c = 'Y') then inc(FPosition) else goto err; 734 | 4: if (c = 'P') then inc(FPosition) else goto err; 735 | 5: if (c = 'E') then inc(FPosition) else goto err; 736 | else 737 | if (c < #256) and (AnsiChar(c) in spaces) then 738 | begin 739 | FStack^.state := xsEatSpaces; 740 | FStack^.savedstate := xsElementDocTypeName; 741 | FStr.Reset; 742 | end else 743 | goto err; 744 | end; 745 | end; 746 | xsElementDocTypeName: 747 | begin 748 | case FStr.Position of 749 | 0: begin 750 | case c of 751 | '>': 752 | begin 753 | FStack^.state := xsEatSpaces; 754 | FStack^.state := xsStart; 755 | FStack^.clazz := xcNone; 756 | end 757 | else 758 | if ((c < #256) and (AnsiChar(c) in alphas)) or (c > #256) then 759 | FStr.Append(@c, 1) else 760 | goto err; 761 | end; 762 | end; 763 | else 764 | if ((c < #256) and (AnsiChar(c) in alphanums)) or (c > #256) then 765 | FStr.Append(@c, 1) else 766 | if (c < #256) and (AnsiChar(c) in spaces) then 767 | begin 768 | FDocType := TSuperObject.Create(stObject); 769 | FDocType.AsObject.S[xmlname] := FStr.Data; 770 | FStack^.state := xsEatSpaces; 771 | FStack^.savedstate := xsElementDocTypeExternId; 772 | end else 773 | goto err; 774 | end; 775 | end; 776 | xsElementDocTypeExternId: 777 | begin 778 | case c of 779 | 'P': 780 | begin 781 | FPosition := 0; 782 | FStack^.state := xsElementDocTypeExternIdPublic; 783 | end; 784 | 'S': 785 | begin 786 | FPosition := 0; 787 | FStack^.state := xsElementDocTypeExternIdSystem; 788 | end; 789 | '[': 790 | begin 791 | FStack^.savedstate := xsElementDocTypeIntSubset; 792 | FStack^.state := xsEatSpaces; 793 | end; 794 | '>': 795 | begin 796 | FStack^.savedstate := xsStart; 797 | FStack^.state := xsEatSpaces 798 | end 799 | else 800 | goto err; 801 | end; 802 | end; 803 | xsElementDocTypeExternIdPublic: 804 | begin 805 | case FPosition of 806 | 0: if (c = 'U') then inc(FPosition) else goto err; 807 | 1: if (c = 'B') then inc(FPosition) else goto err; 808 | 2: if (c = 'L') then inc(FPosition) else goto err; 809 | 3: if (c = 'I') then inc(FPosition) else goto err; 810 | 4: if (c = 'C') then inc(FPosition) else goto err; 811 | else 812 | if (c < #256) and (AnsiChar(c) in spaces) then 813 | begin 814 | FStr.Reset; 815 | FPosition := 0; 816 | FStack^.savedstate := xsElementDocTypePubIdLiteral; 817 | FStack^.state := xsEatSpaces; 818 | end else 819 | goto err; 820 | end; 821 | end; 822 | 823 | xsElementDocTypeExternIdSystem: 824 | begin 825 | case FPosition of 826 | 0: if (c = 'Y') then inc(FPosition) else goto err; 827 | 1: if (c = 'S') then inc(FPosition) else goto err; 828 | 2: if (c = 'T') then inc(FPosition) else goto err; 829 | 3: if (c = 'E') then inc(FPosition) else goto err; 830 | 4: if (c = 'M') then inc(FPosition) else goto err; 831 | else 832 | if (c < #256) and (AnsiChar(c) in spaces) then 833 | begin 834 | FStr.Reset; 835 | FPosition := 0; 836 | FStack^.savedstate := xsElementDocTypeSystemLiteral; 837 | FStack^.state := xsEatSpaces; 838 | end else 839 | goto err; 840 | end; 841 | end; 842 | xsElementDocTypePubIdLiteral: 843 | begin 844 | if FPosition = 0 then 845 | case c of 846 | '"', '''': 847 | begin 848 | FAChar := c; 849 | FPosition := 1; 850 | end 851 | else 852 | goto err; 853 | end else 854 | if c = FAChar then 855 | begin 856 | FDocType.AsObject.S[dtdPubidLiteral] := FStr.Data; 857 | FStr.Reset; 858 | FPosition := 0; 859 | FStack^.state := xsEatSpaces; 860 | FStack^.savedstate := xsElementDocTypeSystemLiteral; 861 | end else 862 | if (c < #256) and (AnsiChar(c) in publitteral) then 863 | FStr.Append(@c, 1); 864 | end; 865 | xsElementDocTypeSystemLiteral: 866 | begin 867 | if FPosition = 0 then 868 | case c of 869 | '"', '''': 870 | begin 871 | FAChar := c; 872 | FPosition := 1; 873 | end 874 | else 875 | goto err; 876 | end else 877 | if c = FAChar then 878 | begin 879 | FDocType.AsObject.S[dtdSystemLiteral] := FStr.Data; 880 | FStack^.state := xsEatSpaces; 881 | FStack^.savedstate := xsElementDocTypeTryIntSubset; 882 | end else 883 | FStr.Append(@c, 1); 884 | end; 885 | 886 | xsElementDocTypeTryIntSubset: 887 | begin 888 | case c of 889 | '>': 890 | begin 891 | FStack^.state := xsEatSpaces; 892 | FStack^.savedstate := xsStart; 893 | FStack^.clazz := xcNone; 894 | end; 895 | '[': 896 | begin 897 | FStack^.state := xsEatSpaces; 898 | FStack^.savedstate := xsElementDocTypeIntSubset; 899 | end; 900 | end; 901 | end; 902 | xsElementDocTypeIntSubset: 903 | begin 904 | case c of 905 | ']': 906 | begin 907 | FStack^.state := xsEatSpaces; 908 | FStack^.savedstate := xsElementDocTypeTryClose; 909 | end; 910 | end; 911 | end; 912 | xsElementDocTypeTryClose: 913 | begin 914 | if c = '>' then 915 | begin 916 | FStack^.state := xsEatSpaces; 917 | FStack^.savedstate := xsStart; 918 | FStack^.clazz := xcNone; 919 | end else 920 | goto err; 921 | end; 922 | xsEscape: 923 | begin 924 | FPosition := 0; 925 | case c of 926 | 'l': FStack^.state := xsEscape_lt; 927 | 'g': FStack^.state := xsEscape_gt; 928 | 'a': FStack^.state := xsEscape_amp; 929 | 'q': FStack^.state := xsEscape_quot; 930 | '#': FStack^.state := xsEscape_char; 931 | else 932 | goto err; 933 | end; 934 | end; 935 | xsEscape_lt: 936 | begin 937 | case FPosition of 938 | 0: begin 939 | if c <> 't' then goto err; 940 | Inc(FPosition); 941 | end; 942 | 1: begin 943 | if c <> ';' then goto err; 944 | FValue.Append(XML_LOW, 1); 945 | FStack^.state := FStack^.savedstate; 946 | end; 947 | end; 948 | end; 949 | xsEscape_gt: 950 | begin 951 | case FPosition of 952 | 0: begin 953 | if c <> 't' then goto err; 954 | Inc(FPosition); 955 | end; 956 | 1: begin 957 | if c <> ';' then goto err; 958 | FValue.Append(XML_BIG, 1); 959 | FStack^.state := FStack^.savedstate; 960 | end; 961 | end; 962 | end; 963 | xsEscape_amp: 964 | begin 965 | case FPosition of 966 | 0: begin 967 | case c of 968 | 'm': Inc(FPosition); 969 | 'p': begin 970 | FStack^.state := xsEscape_apos; 971 | Inc(FPosition); 972 | end; 973 | else 974 | goto err; 975 | end; 976 | end; 977 | 1: begin 978 | if c <> 'p' then goto err; 979 | Inc(FPosition); 980 | end; 981 | 2: begin 982 | if c <> ';' then goto err; 983 | FValue.Append(XML_AMP, 1); 984 | FStack^.state := FStack^.savedstate; 985 | end; 986 | end; 987 | end; 988 | xsEscape_apos: 989 | begin 990 | case FPosition of 991 | 0: begin 992 | case c of 993 | 'p': Inc(FPosition); 994 | 'm': begin 995 | FStack^.state := xsEscape_amp; 996 | Inc(FPosition); 997 | end; 998 | else 999 | goto err; 1000 | end; 1001 | end; 1002 | 1: begin 1003 | if c <> 'o' then goto err; 1004 | Inc(FPosition); 1005 | end; 1006 | 2: begin 1007 | if c <> 's' then goto err; 1008 | Inc(FPosition); 1009 | end; 1010 | 3: begin 1011 | if c <> ';' then goto err; 1012 | FValue.Append(XML_SQU, 1); 1013 | FStack^.state := FStack^.savedstate; 1014 | end; 1015 | end; 1016 | end; 1017 | xsEscape_quot: 1018 | begin 1019 | case FPosition of 1020 | 0: begin 1021 | if c <> 'u' then goto err; 1022 | Inc(FPosition); 1023 | end; 1024 | 1: begin 1025 | if c <> 'o' then goto err; 1026 | Inc(FPosition); 1027 | end; 1028 | 2: begin 1029 | if c <> 't' then goto err; 1030 | Inc(FPosition); 1031 | end; 1032 | 3: begin 1033 | if c <> ';' then goto err; 1034 | FValue.Append(XML_DQU, 1); 1035 | FStack^.state := FStack^.savedstate; 1036 | end; 1037 | end; 1038 | end; 1039 | xsEscape_char: 1040 | begin 1041 | if (SOIChar(c) >= 256) then goto err; 1042 | case AnsiChar(c) of 1043 | '0'..'9': 1044 | begin 1045 | FPosition := SOIChar(c) - 48; 1046 | FStack^.state := xsEscape_char_num; 1047 | end; 1048 | 'x': 1049 | begin 1050 | FStack^.state := xsEscape_char_hex; 1051 | end 1052 | else 1053 | goto err; 1054 | end; 1055 | end; 1056 | xsEscape_char_num: 1057 | begin 1058 | if (SOIChar(c) >= 256) then goto err; 1059 | case AnsiChar(c) of 1060 | '0'..'9':FPosition := (FPosition * 10) + (SOIChar(c) - 48); 1061 | ';': begin 1062 | FValue.Append(@FPosition, 1); 1063 | FStack^.state := FStack^.savedstate; 1064 | end; 1065 | else 1066 | goto err; 1067 | end; 1068 | end; 1069 | xsEscape_char_hex: 1070 | begin 1071 | if (c >= #256) then goto err; 1072 | if (AnsiChar(c) in hex) then 1073 | begin 1074 | FPosition := (FPosition * 16) + SOIChar(hexdigit(c)); 1075 | end else 1076 | if c = ';' then 1077 | begin 1078 | FValue.Append(@FPosition, 1); 1079 | FStack^.state := FStack^.savedstate; 1080 | end else 1081 | goto err; 1082 | end; 1083 | xsEnd: 1084 | begin 1085 | if(FStack^.prev = nil) then Break; 1086 | if FStack^.obj <> nil then 1087 | begin 1088 | if FPack then 1089 | packend else 1090 | begin 1091 | anobject := FStack^.prev^.obj.AsObject[xmlchildren]; 1092 | if anobject = nil then 1093 | begin 1094 | anobject := TSuperObject.Create(stArray); 1095 | FStack^.prev^.obj.AsObject[xmlchildren] := anobject; 1096 | end; 1097 | anobject.AsArray.Add(FStack^.obj); 1098 | end; 1099 | end; 1100 | StackDown; 1101 | goto redo; 1102 | end; 1103 | end; 1104 | inc(p); 1105 | inc(read); 1106 | until (c = #0); 1107 | 1108 | if FStack^.state = xsEnd then 1109 | begin 1110 | if FPack then 1111 | packend; 1112 | FError := xeSuccess; 1113 | end else 1114 | FError := xeError; 1115 | Result := read; 1116 | exit; 1117 | err: 1118 | FError := xeError; 1119 | Result := read; 1120 | end; 1121 | 1122 | function XMLParseFile(const FileName: string; pack: Boolean; onpi: TOnProcessingInstruction): ISuperObject; 1123 | var 1124 | stream: TFileStream; 1125 | begin 1126 | stream := TFileStream.Create(FileName, fmOpenRead, fmShareDenyWrite); 1127 | try 1128 | Result := XMLParseStream(stream, pack, onpi); 1129 | finally 1130 | stream.Free; 1131 | end; 1132 | end; 1133 | 1134 | procedure TSuperXMLParser.StackDown; 1135 | var 1136 | prev: PSuperXMLStack; 1137 | begin 1138 | if FStack <> nil then 1139 | begin 1140 | prev := FStack^.prev; 1141 | FStack^.obj := nil; 1142 | FreeMem(FStack); 1143 | FStack := prev; 1144 | if FStack <> nil then 1145 | FStack^.next := nil; 1146 | end; 1147 | end; 1148 | 1149 | procedure TSuperXMLParser.StackUp; 1150 | var 1151 | st: PSuperXMLStack; 1152 | begin 1153 | {$IFDEF FPC} 1154 | st := nil; 1155 | {$ENDIF} 1156 | GetMem(st, SizeOf(st^)); 1157 | FillChar(st^, SizeOf(st^), 0); 1158 | st^.state := xsEatSpaces; 1159 | st^.savedstate := xsStart; 1160 | st^.prev := FStack; 1161 | if st^.prev <> nil then 1162 | st^.prev^.next := st; 1163 | st^.next := nil; 1164 | st^.obj := nil; 1165 | FStack := st; 1166 | end; 1167 | 1168 | function utf8toucs2(src: PAnsiChar; srclen: Integer; dst: PWideChar; unused: PInteger): Integer; 1169 | var 1170 | ch: Byte; 1171 | ret: Word; 1172 | min: Cardinal; 1173 | rem, com: integer; 1174 | label 1175 | redo; 1176 | begin 1177 | Result := 0; 1178 | ret := 0; 1179 | rem := 0; 1180 | min := 0; 1181 | 1182 | if unused <> nil then 1183 | unused^ := 0; 1184 | 1185 | if(src = nil) or (srclen = 0) then 1186 | begin 1187 | dst^ := #0; 1188 | Exit; 1189 | end; 1190 | 1191 | while srclen > 0 do 1192 | begin 1193 | ch := Byte(src^); 1194 | inc(src); 1195 | dec(srclen); 1196 | 1197 | redo: 1198 | if (ch and $80) = 0 then 1199 | begin 1200 | dst^ := WideChar(ch); 1201 | inc(Result); 1202 | end else 1203 | begin 1204 | if((ch and $E0) = $C0) then 1205 | begin 1206 | min := $80; 1207 | rem := 1; 1208 | ret := ch and $1F; 1209 | end else 1210 | if((ch and $F0) = $E0) then 1211 | begin 1212 | min := $800; 1213 | rem := 2; 1214 | ret := ch and $0F; 1215 | end else 1216 | // too large utf8 bloc 1217 | // ignore and continue 1218 | continue; 1219 | 1220 | com := rem; 1221 | while(rem <> 0) do 1222 | begin 1223 | dec(rem); 1224 | if(srclen = 0) then 1225 | begin 1226 | if unused <> nil then 1227 | unused^ := com; 1228 | Exit; 1229 | end; 1230 | ch := Byte(src^); 1231 | inc(src); 1232 | dec(srclen); 1233 | if((ch and $C0) = $80) then 1234 | begin 1235 | ret := ret shl 6; 1236 | ret := ret or (ch and $3F); 1237 | end else 1238 | begin 1239 | // unterminated utf8 bloc :/ 1240 | // try next one 1241 | goto redo; 1242 | end; 1243 | end; 1244 | 1245 | if (ret >= min) then 1246 | begin 1247 | dst^ := WideChar(ret); 1248 | inc(Result); 1249 | end else 1250 | // too small utf8 bloc 1251 | // ignore and continue 1252 | Continue; 1253 | end; 1254 | inc(dst); 1255 | end; 1256 | end; 1257 | 1258 | function XMLParseStream(stream: TStream; pack: Boolean; onpi: TOnProcessingInstruction): ISuperObject; 1259 | const 1260 | CP_UTF8 = 65001; 1261 | var 1262 | wbuffer: array[0..1023] of SOChar; 1263 | abuffer: array[0..1023] of AnsiChar; 1264 | len, read, cursor: Integer; 1265 | PI, PIParent: ISuperObject; 1266 | bom: array[0..2] of byte; 1267 | 1268 | encoding: TSuperXMLEncoding; 1269 | encodingstr: string; 1270 | cp: Integer; 1271 | ecp: ISuperObject; 1272 | 1273 | function getbuffer: Integer; 1274 | var 1275 | size, unusued: Integer; 1276 | begin 1277 | 1278 | case encoding of 1279 | {$IFNDEF UNIX} 1280 | xnANSI: 1281 | begin 1282 | size := stream.Read(abuffer, sizeof(abuffer)); 1283 | result := MultiByteToWideChar(cp, 0, @abuffer, size, @wbuffer, sizeof(wbuffer)); 1284 | end; 1285 | {$ENDIF} 1286 | xnUTF8: 1287 | begin 1288 | size := stream.Read(abuffer, sizeof(abuffer)); 1289 | result := utf8toucs2(@abuffer, size, @wbuffer, @unusued); 1290 | if unusued > 0 then 1291 | stream.Seek(-unusued, soFromCurrent); 1292 | end; 1293 | xnUnicode: Result := stream.Read(wbuffer, sizeof(wbuffer)) div sizeof(SOChar); 1294 | else 1295 | Result := 0; 1296 | end; 1297 | end; 1298 | label 1299 | redo, retry; 1300 | begin 1301 | // init knowned code pages 1302 | ecp := so('{iso-8859-1: 28591,'+ 1303 | 'iso-8859-2: 28592,'+ 1304 | 'iso-8859-3: 28593,'+ 1305 | 'iso-8859-4: 28594,'+ 1306 | 'iso-8859-5: 28595,'+ 1307 | 'iso-8859-6: 28596,'+ 1308 | 'iso-8859-7: 28597,'+ 1309 | 'iso-8859-8: 28598,'+ 1310 | 'iso-8859-9: 28599,'+ 1311 | 'iso 8859-15: 28605,'+ 1312 | 'iso-2022-jp: 50220,'+ 1313 | 'shift_jis: 932,'+ 1314 | 'euc-jp: 20932,'+ 1315 | 'ascii: 20127,'+ 1316 | 'windows-1251: 1251,'+ 1317 | 'windows-1252: 1252}'); 1318 | 1319 | // detect bom 1320 | stream.Seek(0, soFromBeginning); 1321 | len := stream.Read(bom, sizeof(bom)); 1322 | if (len >= 2) and (bom[0] = $FF) and (bom[1] = $FE) then 1323 | begin 1324 | encoding := xnUnicode; 1325 | stream.Seek(2, soFromBeginning); 1326 | end else 1327 | if (len = 3) and (bom[0] = $EF) and (bom[1] = $BB) and (bom[2] = $BF) then 1328 | begin 1329 | encoding := xnUTF8; 1330 | cp := CP_UTF8; 1331 | end else 1332 | begin 1333 | encoding := xnUTF8; 1334 | cp := 0; 1335 | stream.Seek(0, soFromBeginning); 1336 | end; 1337 | 1338 | with TSuperXMLParser.Create(pack) do 1339 | try 1340 | len := getbuffer; 1341 | while len > 0 do 1342 | begin 1343 | retry: 1344 | read := ParseBuffer(@wbuffer, PI, PIParent, len); 1345 | cursor := 0; 1346 | redo: 1347 | case FError of 1348 | xeContinue: len := getbuffer; 1349 | xeSuccess, xeError: Break; 1350 | xeProcessInst: 1351 | begin 1352 | if (PIParent = nil) and (PI.AsObject.S[xmlname] = 'xml') then 1353 | begin 1354 | if pack then 1355 | encodingstr := LowerCase(trim(PI.S['encoding'])) else 1356 | encodingstr := LowerCase(trim(PI.S[xmlattributes + '.encoding'])); 1357 | if (encodingstr <> '') then 1358 | case encoding of 1359 | xnUTF8: if(cp = CP_UTF8) then 1360 | begin 1361 | if (encodingstr <> 'utf-8') then 1362 | begin 1363 | FError := xeError; 1364 | Break; 1365 | end; 1366 | end else 1367 | begin 1368 | cp := ecp.I[encodingstr]; 1369 | if cp > 0 then 1370 | begin 1371 | {$IFNDEF UNIX} 1372 | encoding := xnANSI; 1373 | Reset; 1374 | stream.Seek(0, soFromBeginning); 1375 | len := getbuffer; 1376 | goto retry; 1377 | {$ELSE} 1378 | raise Exception.Create('charset not implemented'); 1379 | {$ENDIF} 1380 | end; 1381 | end; 1382 | xnUnicode: 1383 | if (encodingstr <> 'utf-16') and (encodingstr <> 'unicode') then 1384 | begin 1385 | FError := xeError; 1386 | Break; 1387 | end; 1388 | end; 1389 | end else 1390 | if Assigned(onpi) then 1391 | onpi(PI, PIParent); 1392 | 1393 | inc(cursor, read); 1394 | if cursor >= len then 1395 | begin 1396 | len := getbuffer; 1397 | continue; 1398 | end; 1399 | read := ParseBuffer(@wbuffer[cursor], PI, PIParent, len - cursor); 1400 | goto redo; 1401 | end; 1402 | end; 1403 | end; 1404 | if FError = xeSuccess then 1405 | Result := FStack^.obj else 1406 | Result := nil; 1407 | finally 1408 | Free; 1409 | end; 1410 | end; 1411 | 1412 | function XMLParseString(const data: SOString; pack: Boolean; onpi: TOnProcessingInstruction): ISuperObject; 1413 | var 1414 | PI, PIParent: ISuperObject; 1415 | cursor, read: Integer; 1416 | label 1417 | redo; 1418 | begin 1419 | with TSuperXMLParser.Create(pack) do 1420 | try 1421 | cursor := 0; 1422 | read := ParseBuffer(PSOChar(data), PI, PIParent); 1423 | redo: 1424 | case FError of 1425 | xeSuccess: Result := FStack^.obj; 1426 | xeError: Result := nil; 1427 | xeProcessInst: 1428 | begin 1429 | if Assigned(onpi) then 1430 | onpi(PI, PIParent); 1431 | inc(cursor, read); 1432 | read := ParseBuffer(@data[cursor+1], PI, PIParent); 1433 | goto redo; 1434 | end; 1435 | end; 1436 | finally 1437 | Free; 1438 | end; 1439 | end; 1440 | 1441 | end. 1442 | -------------------------------------------------------------------------------- /tests/test_format.dpr: -------------------------------------------------------------------------------- 1 | program test_format; 2 | {$IFDEF FPC} 3 | {$MODE OBJFPC}{$H+} 4 | {$ELSE} 5 | {$APPTYPE CONSOLE} 6 | {$ENDIF} 7 | 8 | uses 9 | SysUtils, superobject; 10 | 11 | const 12 | data = 13 | '/* more difficult test case */ { "glossary": { "title": "example glossary", "GlossDiv":'+ 14 | ' { "title": "S", "GlossList": [ { "ID": "SGML", "SortAs": "SGML", "GlossTerm": "Standar'+ 15 | 'd Generalized Markup Language", "Acronym": "SGML", "Abbrev": "ISO 8879:1986", "GlossDef'+ 16 | '": "A meta-markup language, used to create markup languages such as DocBook.", "GlossSe'+ 17 | 'eAlso": ["GML", "XML", "markup"] } ] } } }'; 18 | 19 | var 20 | new_obj: ISuperObject; 21 | begin 22 | new_obj := TSuperObject.ParseString(data); 23 | writeln('new_obj.AsJson=', new_obj.AsJson(true, false)); 24 | new_obj := nil; 25 | writeln(#10'press enter ...'); 26 | readln; 27 | end. 28 | 29 | -------------------------------------------------------------------------------- /tests/test_perf.dpr: -------------------------------------------------------------------------------- 1 | program test_perf; 2 | 3 | {$IFDEF FPC} 4 | {$MODE OBJFPC}{$H+} 5 | {$ELSE} 6 | {$APPTYPE CONSOLE} 7 | {$ENDIF} 8 | 9 | uses 10 | {$IFNDEF UNIX} 11 | windows, 12 | {$ENDIF} 13 | sysutils, 14 | superobject; 15 | 16 | {$IFDEF UNIX} 17 | function GetTickCount: Cardinal; 18 | var 19 | h, m, s, s1000: word; 20 | begin 21 | decodetime(time, h, m, s, s1000); 22 | Result := Cardinal(h * 3600000 + m * 60000 + s * 1000 + s1000); 23 | end; 24 | {$ENDIF} 25 | 26 | var 27 | js: ISuperObject; 28 | xs: ISuperObject; 29 | i,l: Integer; 30 | k: cardinal; 31 | s: SOString; 32 | ts: TSuperTableString; 33 | pb: TSuperWriterString; 34 | begin 35 | Randomize; 36 | js := TSuperObject.Create; 37 | ts := js.AsObject; 38 | k := GetTickCount; 39 | for i := 1 to 50000 do 40 | begin 41 | l := random(9999999); 42 | s := 'param' + IntToStr(l); 43 | ts.S[s] := s; 44 | s := 'int' + IntToStr(l); 45 | ts.I[s] := i; 46 | end; 47 | k := GetTickCount-k; 48 | writeln('records inserted:',js.AsObject.Count); 49 | writeln('time for insert:',k); 50 | 51 | k := GetTickCount; 52 | pb := TSuperWriterString.Create; 53 | js.write(pb, false, true, 0); 54 | writeln('text length:',pb.position); 55 | k := GetTickCount-k; 56 | writeln('release memory...'); 57 | js := nil; 58 | 59 | writeln('time for gentext:',k); 60 | 61 | k := GetTickCount; 62 | xs := TSuperObject.ParseString(pb.Data); 63 | 64 | k := GetTickCount-k; 65 | writeln('time for parse:',k); 66 | 67 | writeln('press enter...'); 68 | readln; 69 | writeln(xs.AsJson); 70 | xs := nil; 71 | pb.Free; 72 | writeln('press enter...'); 73 | s := ''; 74 | readln; 75 | end. 76 | -------------------------------------------------------------------------------- /tests/test_prototype.dpr: -------------------------------------------------------------------------------- 1 | program test_prototype; 2 | 3 | {$IFDEF FPC} 4 | {$MODE OBJFPC}{$H+} 5 | {$ELSE} 6 | {$APPTYPE CONSOLE} 7 | {$ENDIF} 8 | 9 | uses 10 | SysUtils, 11 | superobject; 12 | 13 | var 14 | proto, obj: ISuperObject; 15 | 16 | procedure class1_display(const This, Params: ISuperObject; var Result: ISuperObject); 17 | begin 18 | if Params <> nil then 19 | writeln(Params.asString); 20 | end; 21 | 22 | procedure class_new(const This, Params: ISuperObject; var Result: ISuperObject); 23 | begin 24 | Result := SO; 25 | Result['class'] := this; 26 | Result.Merge(Params, true); 27 | end; 28 | 29 | procedure class1_new(const This, Params: ISuperObject; var Result: ISuperObject); 30 | begin 31 | class_new(This, Params, Result); // inherited 32 | Result.M['display'] := @class1_display; 33 | end; 34 | 35 | begin 36 | try 37 | proto := SO('{}'); 38 | proto.M['class.new'] := @class_new; 39 | proto.M['class1.new'] := @class1_new; 40 | 41 | obj := proto['class1.new({name: "foo", bool: true})']; 42 | try 43 | obj['display([name, bool])']; 44 | readln; 45 | finally 46 | obj := nil; 47 | proto.Clear(true); // for circular references 48 | proto := nil; 49 | end; 50 | except 51 | on E: Exception do 52 | writeln(E.Message) 53 | end; 54 | end. 55 | -------------------------------------------------------------------------------- /tests/test_rpc.dpr: -------------------------------------------------------------------------------- 1 | program test_rpc; 2 | 3 | {$IFDEF FPC} 4 | {$MODE OBJFPC}{$H+} 5 | {$ELSE} 6 | {$APPTYPE CONSOLE} 7 | {$ENDIF} 8 | 9 | uses 10 | SysUtils, superobject; 11 | 12 | procedure controler_method1(const This, Params: ISuperObject; var Result: ISuperObject); 13 | begin 14 | write('action called with params '); 15 | writeln(Params.AsJSon); 16 | end; 17 | 18 | var 19 | s: ISuperObject; 20 | begin 21 | s := TSuperObject.Create; 22 | s.M['controler.action1'] := @controler_method1; 23 | try 24 | s.call('controler.action1', '{"a": [1,2,3], "b": null}'); 25 | s['controler.action1([123, "foo"])']; 26 | finally 27 | s := nil; 28 | writeln('Press enter ...'); 29 | readln; 30 | end; 31 | end. 32 | -------------------------------------------------------------------------------- /tests/test_usage.dpr: -------------------------------------------------------------------------------- 1 | program test_usage; 2 | {$IFDEF FPC} 3 | {$MODE OBJFPC}{$H+} 4 | {$ELSE} 5 | {$APPTYPE CONSOLE} 6 | {$ENDIF} 7 | 8 | uses 9 | SysUtils, 10 | superobject; 11 | 12 | var 13 | my_string, my_int, my_object, my_array: ISuperObject; 14 | new_obj: ISuperObject; 15 | j: integer; 16 | ite: TSuperObjectIter; 17 | 18 | begin 19 | try 20 | my_string := TSuperObject.Create(#9); 21 | writeln('my_string=', my_string.AsString); 22 | writeln('my_string.AsJSon=', my_string.AsJSon); 23 | 24 | my_string := TSuperObject.Create('foo'); 25 | writeln('my_string=', my_string.AsString); 26 | writeln('my_string.AsJson=', my_string.AsJson); 27 | 28 | my_int := TSuperObject.Create(9); 29 | writeln('my_int=', my_int.AsInteger); 30 | writeln('my_int.AsJson=', my_int.AsJson); 31 | 32 | my_array := TSuperObject.Create(stArray); 33 | my_array.I[''] := 1; // append 34 | my_array.I[''] := 2; // append 35 | my_array.I[''] := 3; // append 36 | my_array.I['4'] := 5; 37 | writeln('my_array='); 38 | with my_array.AsArray do 39 | for j := 0 to Length - 1 do 40 | if O[j] = nil then 41 | writeln(#9'[', j,']=', 'null') else 42 | writeln(#9'[', j,']=', O[j].AsJson); 43 | writeln('my_array.AsJson=', my_array.AsJson); 44 | 45 | my_object := TSuperObject.Create(stObject); 46 | my_object.I['abc'] := 12; 47 | // my_object.S['path.to.foo[5]'] := 'bar'; 48 | my_object.B['bool0'] := false; 49 | my_object.B['bool1'] := true; 50 | my_object.S['baz'] := 'bang'; 51 | my_object.S['baz'] := 'fark'; 52 | my_object.AsObject.Delete('baz'); 53 | my_object['arr'] := my_array; 54 | writeln('my_object='); 55 | if ObjectFindFirst(my_object, ite) then 56 | repeat 57 | writeln(#9,ite.key,': ', ite.val.AsJson); 58 | until not ObjectFindNext(ite); 59 | ObjectFindClose(ite); 60 | writeln('my_object.AsJson=', my_object.AsJson); 61 | 62 | new_obj := SO('"003"'); 63 | writeln('new_obj.AsJson=', new_obj.AsJson); 64 | 65 | new_obj := SO('/* hello */"foo"'); 66 | writeln('new_obj.AsJson=', new_obj.AsJson); 67 | 68 | new_obj := SO('// hello'#10'"foo"'); 69 | writeln('new_obj.AsJson=', new_obj.AsJson); 70 | 71 | new_obj := SO('"\u0041\u0042\u0043"'); 72 | writeln('new_obj.AsJson=', new_obj.AsJson); 73 | 74 | new_obj := SO('null'); 75 | if new_obj = nil then 76 | writeln('new_obj.AsJson=', 'null'); 77 | 78 | new_obj := SO('true'); 79 | writeln('new_obj.AsJson=', new_obj.AsJson); 80 | 81 | new_obj := SO('12'); 82 | writeln('new_obj.AsJson=', new_obj.AsJson); 83 | 84 | new_obj := SO('12.3'); 85 | writeln('new_obj.AsJson=', new_obj.AsJson); 86 | 87 | new_obj := SO('["\n"]'); 88 | writeln('new_obj.AsJson=', new_obj.AsJson); 89 | 90 | new_obj := SO('["\nabc\n"]'); 91 | writeln('new_obj.AsJson=', new_obj.AsJson); 92 | 93 | new_obj := SO('[null]'); 94 | writeln('new_obj.AsJson=', new_obj.AsJson); 95 | 96 | new_obj := SO('[]'); 97 | writeln('new_obj.AsJson=', new_obj.AsJson); 98 | 99 | new_obj := SO('["abc",null,"def",12]'); 100 | writeln('new_obj.AsJson=', new_obj.AsJson); 101 | 102 | new_obj := SO('{}'); 103 | writeln('new_obj.AsJson=', new_obj.AsJson); 104 | 105 | new_obj := SO('{ "foo": "bar" }'); 106 | writeln('new_obj.AsJson=', new_obj.AsJson); 107 | 108 | new_obj := SO('{ "foo": "bar", "baz": null, "bool0": true }'); 109 | writeln('new_obj.AsJson=', new_obj.AsJson); 110 | 111 | new_obj := SO('{ "foo": [null, "foo"] }'); 112 | writeln('new_obj.AsJson=', new_obj.AsJson); 113 | 114 | new_obj := SO('{ "abc": 12, "foo": "bar", "bool0": false, "bool1": true, "arr": [ 1, 2, 3, null, 5 ] }'); 115 | writeln('new_obj.AsJson=', new_obj.AsJson); 116 | 117 | try 118 | new_obj := SO('{ foo }'); 119 | except 120 | writeln('got error as expected'); 121 | end; 122 | 123 | my_string := nil; 124 | my_int := nil; 125 | my_object := nil; 126 | my_array := nil; 127 | new_obj := nil; 128 | 129 | 130 | writeln(#10'press enter ...'); 131 | readln; 132 | except 133 | on E: Exception do 134 | writeln(E.Message) 135 | end; 136 | end. 137 | -------------------------------------------------------------------------------- /tests/test_validate.dpr: -------------------------------------------------------------------------------- 1 | program test_validate; 2 | {$IFDEF FPC} 3 | {$MODE OBJFPC}{$H+} 4 | {$ELSE} 5 | {$APPTYPE CONSOLE} 6 | {$ENDIF} 7 | 8 | 9 | uses 10 | SysUtils, superobject; 11 | 12 | procedure onerror(sender: Pointer; error: TSuperValidateError; const path: SOString); 13 | const 14 | errors: array[TSuperValidateError] of string = 15 | ('RuleMalformated', 16 | 'FieldIsRequired', 17 | 'InvalidDataType', 18 | 'FieldNotFound', 19 | 'UnexpectedField', 20 | 'DuplicateEntry', 21 | 'ValueNotInEnum', 22 | 'InvalidLengthRule', 23 | 'InvalidRange'); 24 | 25 | begin 26 | writeln(errors[error], ' -> ', path) 27 | end; 28 | 29 | 30 | procedure Validate(const d, r, f: SOString); 31 | var 32 | o: ISuperObject; 33 | begin 34 | o := TSuperObject.ParseString(PSOChar(d)); 35 | case o.Validate(r, f, @onerror) of 36 | true: writeln('valid'); 37 | false: writeln('invalid'); 38 | end; 39 | o := nil; 40 | end; 41 | 42 | 43 | begin 44 | try 45 | // unique field 46 | Validate('[{name: a}, {name: b}]', 47 | '{type: seq, sequence: {type: map, mapping: {name: {type: str, unique: true}}}}}', ''); 48 | 49 | // unique object 50 | Validate('[{n: 1, name: a}, {name: a, n: 2}]', 51 | '{type: seq, sequence: {type: map, unique: true, mapping: {name: {type: str}, n: {type: int}}}}}', ''); 52 | 53 | // inherited fields 54 | Validate('{'+ 55 | 'x1: {f1: foo},'+ 56 | 'x2: {f1: foo, f2: foo},'+ 57 | 'x3: {f1: foo, f2: foo, f3: foo},'+ 58 | 'x4: {f1: 123, f2: foo, f3: foo}'+ 59 | '}', 60 | '{type: map, mapping: {'+ 61 | 'x1: {type: map, name: n1, mapping: {f1: {type: str}}},'+ 62 | 'x2: {name: n2, inherit: n1, mapping: {f2: {type: str}}},'+ // inherit 63 | 'x3: {name: n3, inherit: n2, mapping: {f3: {type: str}}},'+ // inherit 64 | 'x4: {name: n4, inherit: n3, mapping: {f1: {type: int}}}'+ // overide 65 | '}}', ''); 66 | 67 | // additionnal shemat 68 | Validate('{'+ 69 | 'x1: {f1: foo},'+ 70 | 'x2: {f1: foo, f2: foo},'+ 71 | 'x3: {f1: foo, f2: foo, f3: foo},'+ 72 | 'x4: {f1: 123, f2: foo, f3: foo}'+ 73 | '}', 74 | '{type: map, mapping: {'+ 75 | 'x1: {inherit: n1},'+ 76 | 'x2: {inherit: n2},'+ 77 | 'x3: {inherit: n3},'+ 78 | 'x4: {inherit: n4}'+ 79 | '}}', 80 | 81 | '[{type: map, name: n1, mapping: {f1: {type: str}}},'+ 82 | '{name: n2, inherit: n1, mapping: {f2: {type: str}}},'+ 83 | '{name: n3, inherit: n2, mapping: {f3: {type: str}}},'+ 84 | '{name: n4, inherit: n3, mapping: {f1: {type: int}}}]' 85 | ); 86 | 87 | 88 | // enum 89 | Validate('b', '{type: str, enum: [a,b,c]}', ''); 90 | Validate('2', '{type: int, enum: [1,2,3]}', '[]'); 91 | 92 | // length 93 | Validate('"123456789"', '{type: str, length: {max: 9}}', ''); 94 | Validate('[1,2,3,4,5,6,7,8,9]', '{type: seq, sequence: {type: int}, length: {max: 9}}', ''); 95 | Validate('123456789', '{type: text, length: {max: 9}}', ''); 96 | 97 | // range 98 | Validate('5', '{type: int, range: {min: 5, max: 5, minex: 4, maxex: 6}}', ''); 99 | Validate('abc', '{type: str, range: {min: ab, max: abcd}}', ''); 100 | 101 | except 102 | on E: Exception do 103 | Writeln(E.message); 104 | end; 105 | writeln('press enter ...'); 106 | readln; 107 | end. 108 | 109 | --------------------------------------------------------------------------------