├── .gitignore ├── LICENSE ├── README.md ├── src └── McJSON.pas └── test ├── PrjTestMcJSON.dpr ├── PrjTestMcJSON.lpi ├── PrjTestMcJSON.lpr ├── test13-Ansi.json ├── test13-UTF8-BOM.json ├── test13-UTF8.json ├── test13.json └── test99.json /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | 68 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 69 | modules/ 70 | 71 | # Lazarus compiler-generated binaries (safe to delete) 72 | *.exe 73 | *.dll 74 | *.so 75 | *.dylib 76 | *.lrs 77 | *.res 78 | *.compiled 79 | *.dbg 80 | *.ppu 81 | *.o 82 | *.or 83 | *.a 84 | 85 | # Lazarus autogenerated files (duplicated info) 86 | *.rst 87 | *.rsj 88 | *.lrt 89 | 90 | # Lazarus local files (user-specific info) 91 | *.lps 92 | *.lpi 93 | 94 | # Lazarus backups and unit output folders. 95 | # These can be changed by user in Lazarus/project options. 96 | backup/ 97 | *.bak 98 | lib/ 99 | 100 | # Application bundle for Mac OS 101 | *.app/ 102 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2021 hydrobyte 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # McJSON 2 | A **Delphi / Lazarus / C++Builder** simple and small class for fast JSON parsing. 3 | 4 | * [Motivation](#motivation) 5 | * [Examples](#examples) 6 | * [Use cases](#use-cases) 7 | * [Known issues](#known-issues) 8 | * [Performance tests](#performance-tests) 9 | 10 | ## Motivation 11 | Some points of interest: 12 | * Simple Object-Pascal native code using TList as internal data structure. 13 | * Single-pass string parser. 14 | * Compatible (aimed): 15 | * Delphi 7 up to now. 16 | * Lazarus. 17 | * C++Builder 2006 up to now. 18 | * Tested with: 19 | * BDS 2006 (Delphi and BCP) 20 | * Lazarus 2.3.0 (FPC 3.2.2) 21 | * C++Builder XE2 and 10.2. 22 | * Just one unit (`McJSON`), just one class(`TMcJsonItem`). 23 | * Inspired by [badunius/myJSON](https://github.com/badunius/myJSON). 24 | * Improved parser after applying Tan Li Hau's [article](https://lihautan.com/json-parser-with-javascript/#understand-the-grammar). 25 | * Performance [tests](#performance-tests) using C++Builder and comparing: 26 | * [myJSON](https://github.com/badunius/myJSON) 27 | * [LkJson](https://sourceforge.net/projects/lkjson/) 28 | * [JsonTools](https://github.com/sysrpl/JsonTools) 29 | * [uJSON](https://sourceforge.net/projects/is-webstart/) (Delphi Web Utils) 30 | 31 | ## Examples 32 | ### Object-Pascal Example 33 | 34 | ```pascal 35 | uses 36 | McJSON; 37 | ... 38 | function Test99(out Msg: string): Boolean; 39 | var 40 | Json: TMcJsonItem; 41 | i: Integer; 42 | begin 43 | Msg := 'Test: Github readme.md content'; 44 | Json := TMcJsonItem.Create(); 45 | try 46 | try 47 | // add some pairs. 48 | Json.Add('key1').AsInteger := 1; 49 | Json.Add('key2').AsBoolean := True; 50 | Json.Add('key3').AsNumber := 1.234; 51 | Json.Add('key4').AsString := 'value 1'; 52 | // add an array 53 | Json.Add('array', jitArray); 54 | for i := 1 to 3 do 55 | Json['array'].Add.AsInteger := i; 56 | // save a backup to file 57 | if (Json['array'].Count = 3) then 58 | Json.SaveToFile('test99.json'); 59 | // remove an item 60 | Json.Delete('array'); 61 | // oops, load the backup 62 | if (Json.Count = 4) then 63 | Json.LoadFromFile('test99.json'); 64 | // test final result 65 | Result := (Json.AsJSON = '{"key1":1,"key2":true,"key3":1.234,"key4":"value 1","array":[1,2,3]}'); 66 | except 67 | Result := False; 68 | end; 69 | finally 70 | Json.Free; 71 | end; 72 | end; 73 | ``` 74 | Will produce `\test\test99.json`: 75 | ```json 76 | { 77 | "key1": 1, 78 | "key2": true, 79 | "key3": 1.234, 80 | "key4": "value 1", 81 | "array": [ 82 | 1, 83 | 2, 84 | 3 85 | ] 86 | } 87 | ``` 88 | 89 | ### C++Builder Example 90 | 91 | ```C++ 92 | #include "McJson.hpp" 93 | ... 94 | bool Test99(AnsiString& Msg) 95 | { 96 | bool Result; 97 | TMcJsonItem* Json = NULL; 98 | Msg = "Test: Github readme.md content"; 99 | Json = new TMcJsonItem(); 100 | try 101 | { 102 | try 103 | { // add some pairs. 104 | Json->Add("key1")->AsInteger = 1; 105 | Json->Add("key2")->AsBoolean = true; 106 | Json->Add("key3")->AsNumber = 1.234; 107 | Json->Add("key4")->AsString = "value 1"; 108 | // add an array 109 | Json->Add("array", jitArray); 110 | for (int i = 1; i <= 3 ; i++) 111 | Json->Values["array"]->Add()->AsInteger = i; 112 | // save a backup to file 113 | if (Json->Values["array"]->Count == 3) 114 | Json->SaveToFile("test99.json"); 115 | // remove an item 116 | Json->Delete("array"); 117 | // oops, load the backup 118 | if (Json->Count == 4) 119 | Json->LoadFromFile("test99.json"); 120 | // test final result 121 | Result = (Json->AsJSON == 122 | "{\"key1\":1,\"key2\":true,\"key3\":1.234,\"key4\":\"value 1\",\"array\":[1,2,3]}"); 123 | } 124 | catch(...) 125 | { 126 | Result = false; 127 | } 128 | } 129 | __finally 130 | { 131 | if (Json) delete (Json); 132 | } 133 | return (Result); 134 | } 135 | ``` 136 | 137 | ## Use Cases 138 | Please considere read Unit Tests in `test` folder for a complete list of `McJSON` use cases. 139 | 140 | ### Parse a JSON string 141 | Just use the `AsJSON` property 142 | ```pascal 143 | var 144 | N: TMcJsonItem; 145 | begin 146 | N := TMcJsonItem.Create; 147 | N.AsJSON := '{"i": 123, "f": 123.456, "s": "abc", "b": true, "n": null}'; 148 | // use N here 149 | N.Free; 150 | end; 151 | ``` 152 | If you want to check if a JSON string is valid: 153 | ```pascal 154 | Answer := N.Check( '{"i":[123}' ); // Answer will be false 155 | ``` 156 | The `Check` method will not raise any exception. The example above will catch and hide the `Error while parsing text: "expected , got }" at pos "10"` exception. 157 | If you need to catch and manage exceptions, use `CheckException` like: 158 | ```pascal 159 | try 160 | Answer := N.CheckException( '{"k":1, "k":2}' ); // Answer will be false 161 | except 162 | on E: Exception do 163 | begin 164 | // Error while parsing text: "duplicated key k" at pos "11" 165 | end; 166 | end; 167 | ``` 168 | 169 | ### Paths 170 | `McJSON` allows a simple way to access items through paths. We can use '/', '\\' or '.' as path separators. 171 | ```pascal 172 | N.AsJSON := '{"o": {"k1":"v1", "k2":"v2"}}'; 173 | // access and change second object's value 174 | N.Path('o.k2').AsString := 'value2'; 175 | ``` 176 | Results in: 177 | ```json 178 | { 179 | "o": { 180 | "k1":"v1", 181 | "k2":"value2" 182 | } 183 | } 184 | ``` 185 | Note that `Path()` does not accept indexes yet, like this: 186 | ```pascal 187 | N.AsJSON := '{"o": [{"k1":"v1"}, {"k2":"v2"}]'; 188 | N.Path('o[1].k2').AsString := 'value2'; 189 | ``` 190 | 191 | ### Property shorteners 192 | Since version 1.0.4 `McJSON` allows to use property shorteners like in Andreas Hausladen's [Json Data Objects](https://github.com/ahausladen/JsonDataObjects). 193 | ```pascal 194 | // access (automatic creation as in JDO) 195 | Obj.S['foo'] := 'bar'; 196 | Obj.S['bar'] := 'foo'; 197 | // array creation, Obj is the owner of 'array' 198 | Obj.A['array'].Add.AsInteger := 10; 199 | Obj.A['array'].Add.AsInteger := 20; 200 | // object creation, 'array' is the owner of ChildObj 201 | ChildObj := Obj['array'].Add(jitObject); 202 | ChildObj.D['value'] := 12.3; 203 | // array creation, ChildObj is the owner of 'subarray' 204 | ChildObj.A['subarray'].Add.AsInteger := 100; 205 | ChildObj.A['subarray'].Add.AsInteger := 200; 206 | ``` 207 | 208 | Results in: 209 | 210 | ```json 211 | { 212 | "foo":"bar", 213 | "bar":"foo", 214 | "array":[ 215 | 10, 216 | 20, 217 | { 218 | "value":12.3, 219 | "subarray":[ 220 | 100, 221 | 200 222 | ] 223 | } 224 | ] 225 | } 226 | ``` 227 | 228 | ### Array or object items 229 | Here is how to access all items (children) of a JSON object and change their value type and content. 230 | ```pascal 231 | N.AsJSON := '{"o": {"k1":"v1", "k2":"v2"}}'; 232 | // type and value: from string to integer 233 | for i := 0 to N['o'].Count-1 do 234 | N['o'].Items[i].AsInteger := i+1; 235 | ``` 236 | Results in: 237 | ```json 238 | { 239 | "o": { 240 | "k1":1, 241 | "k2":2 242 | } 243 | } 244 | ``` 245 | 246 | ### Shortener for array item access 247 | We can use the `Items[index]` and `Values['key']` properties to access items inside objects and arrays. 248 | Since version `0.9.5`, we can use the `At(index, 'key')` or `At('key', index)` as shorteners. 249 | ```pascal 250 | N.AsJSON := '{"a": [{"k1":1,"k2":2},{"k1":10,"k2":20}]}'; 251 | // how to access k2 of second object. 252 | i := N['a'].Items[1].Values['k2'].AsInteger; // i will be equal to 20 253 | i := N['a'].Items[1]['k2'].AsInteger; // uses the Values[] as default property 254 | i := N['a'].At(1, 'k2').AsInteger; // shortener: index, key 255 | i := N.At('a', 1)['k2'].AsInteger; // shortener: key, index 256 | ``` 257 | And there are other uses without the `key` parameter: 258 | ```pascal 259 | N.AsJSON := '{"k1":1,"k2":2,"k3":3,"k4":4}'; 260 | i := N.Items[2].AsInteger; // i will be equal to 3 261 | i := N.At(2).AsInteger; // shortener: just index 262 | i := N.At('k3').AsInteger; // shortener: just key 263 | ``` 264 | 265 | ### Enumerate 266 | Using Delphi enumerator you can browse item's object children and values. 267 | ```pascal 268 | var 269 | N, item: TMcJsonItem; 270 | begin 271 | N := TMcJsonItem.Create; 272 | N.AsJSON := '{"o": {"k1":"v1", "k2":"v2"}}'; 273 | for item in N['o'] do 274 | // use item here, e.g. item.Key, item.Value, item.AsString 275 | ``` 276 | 277 | ### Object and array value setters 278 | Change all values of an object with multiple items. 279 | Not so common out there. 280 | ```pascal 281 | N.AsJSON := '{"o": {"k1":"v1", "k2":"v2"}}'; 282 | N['o'].AsString := 'str'; 283 | ``` 284 | Results in: 285 | ```json 286 | { 287 | "o": { 288 | "k1": "str", 289 | "k2": "str" 290 | } 291 | } 292 | ``` 293 | And if it is necessary to change the type of `o`: 294 | ```pascal 295 | N['o'].ItemType := jitValue; 296 | N['o'].AsString := 'str'; 297 | ``` 298 | Results in: 299 | ```json 300 | { 301 | "o": "str" 302 | } 303 | ``` 304 | 305 | ### Object and array type convertions 306 | Convert from array to object type and vice-versa. 307 | Also, not so common out there. 308 | ```pascal 309 | N.AsJSON := '{ "k1": ["1", "2"], "k2": {"1": "a", "2": "b"} }'; 310 | N['k1'].ItemType := jitObject; // convert array to object with items 311 | N['k2'].ItemType := jitArray ; // convert object with items to array 312 | ``` 313 | Results in: 314 | ```json 315 | { 316 | "k1": { 317 | "0": "1", 318 | "1": "2" 319 | }, 320 | "k2": [ 321 | "a", 322 | "b" 323 | ] 324 | } 325 | ``` 326 | 327 | ### Add objects 328 | To add objects inside others, simply use the `Add()` method: 329 | ```pascal 330 | M.Add('k1').AsString := 'v1'; 331 | P.Add('k2').AsString := 'v2'; 332 | N.ItemType := jitArray; // important: array of objects 333 | N.Add(M); 334 | N.Add(P); 335 | ``` 336 | Note that the `N` object must be set to `jitArray` in order to receive two or more objects. 337 | 338 | Results in: 339 | ```json 340 | [ 341 | { 342 | "k1": "v1" 343 | }, 344 | { 345 | "k2": "v2" 346 | } 347 | ] 348 | ``` 349 | 350 | ### Add pairs 351 | To add `key:value` pairs inside other objects, use the `AddPair()` method: 352 | ```pascal 353 | M.Add('k1').AsString := 'v1'; 354 | P.Add('k2').AsString := 'v2'; 355 | N.ItemType := jitObject; // important: must be an object 356 | N.AddPair(M.Items[0]); 357 | N.AddPair(P.Items[0]); 358 | ``` 359 | Note that the `N` object must be set to `jitObject` in order to receive `key:value` pairs. 360 | 361 | Results in: 362 | ```json 363 | { 364 | "k1": "v1", 365 | "k2": "v2" 366 | } 367 | ``` 368 | 369 | ### Insert items 370 | Insert some items using keys and position. 371 | ```pascal 372 | P.Insert('c', 0).AsInteger := 3; 373 | P.Insert('b', 0).AsInteger := 2; 374 | P.Insert('a', 0).AsInteger := 1; 375 | ``` 376 | Results in: 377 | ```json 378 | { 379 | "a": 1, 380 | "b": 2, 381 | "c": 3 382 | } 383 | ``` 384 | Also, it is possible to insert objects in arrays. 385 | ```pascal 386 | Q.AsJSON := '{"x":0}'; 387 | P.ItemType := jitArray; 388 | P.Insert(Q, 1); 389 | ``` 390 | Results in: 391 | ```json 392 | [ 393 | 1, 394 | { 395 | "x": 0 396 | }, 397 | 2, 398 | 3 399 | ] 400 | ``` 401 | *Important*: since version 0.9.3, `Add()` and `Insert()` will clone arguments of type `TMcJsonItem`. So, we have to free memory for `Q` too: 402 | ```pascal 403 | P.Free; 404 | Q.Free; 405 | ``` 406 | 407 | ### Escape strings 408 | Since version 1.0.5 strings can be escaped with `McJsonEscapeString()` helper function: 409 | ```pascal 410 | N.AsJSON := '{"path": ' + McJsonEscapeString('\dir\subdir') + '}'; 411 | ``` 412 | 413 | Results in: 414 | ```json 415 | { 416 | "path": "\\dir\\subdir" 417 | } 418 | ``` 419 | 420 | In version 1.0.6 was introduced the `TJEscapeType` enum used in `McJsonEscapeString()` with these escape levels: 421 | - `jetNormal` : escapes `#8 #9 #10 #12 #13 " \`. 422 | - `jetStrict` : Normal + `/`. 423 | - `jetUnicode` : Strict + `\uXXXX`. 424 | - `jetNone` : backwards compatibility. 425 | 426 | These levels are inspired by Lazarus' helper function `StringToJSONString()` from library [fpjson](https://www.freepascal.org/docs-html/fcl/fpjson/stringtojsonstring.html). 427 | 428 | ### Inspect the content of an object 429 | Let's see how to inspect all the inner data structure, types and values of a `TMcJsonItem` object. 430 | ```c++ 431 | //--------------------------------------------------------------------------- 432 | void 433 | TFormMain::Inspect(TMcJsonItem* AMcJItem, AnsiString Ident) 434 | { 435 | if (!AMcJItem) return; 436 | // log current 437 | MyLog( Ident + ItemToStr(AMcJItem) ); 438 | // log child 439 | if ( AMcJItem->HasChild ) 440 | { 441 | Ident = " " + Ident; 442 | for (int i=0; i < AMcJItem->Count; i++) 443 | { // use Value not Child because are note using Key[]. 444 | Inspect( AMcJItem->Items[i], Ident ); 445 | } 446 | } 447 | } 448 | //--------------------------------------------------------------------------- 449 | String 450 | TFormMain::ItemToStr(TMcJsonItem* AMcJItem) const 451 | { 452 | String Ans = ""; 453 | if (AMcJItem) 454 | Ans = AMcJItem->GetTypeStr() + 455 | "; " + AMcJItem->GetValueStr() + 456 | "; Key=" + AMcJItem->Key + 457 | "; Value="+ AMcJItem->Value + 458 | "; JSON=" + AMcJItem->AsJSON; 459 | return (Ans); 460 | } 461 | //--------------------------------------------------------------------------- 462 | ``` 463 | And using a example like `testInspect.json`: 464 | ```json 465 | { 466 | "foo": "bar", 467 | "array": [ 468 | 100, 469 | 20 470 | ], 471 | "arrayObj": [ 472 | { 473 | "key1": 1.0 474 | }, 475 | { 476 | "key2": 2.0 477 | } 478 | ], 479 | "Msg": [ 480 | "#1 UTF8 example: motivação", 481 | "#2 Scapes: \b\t\n\f\r\\uFFFF\"\\" 482 | ] 483 | } 484 | ``` 485 | 486 | Calling `Inspect()` with a `Json` object loaded with `testInspect.json`: 487 | ```c++ 488 | TMcJsonItem* Json = new TMcJsonItem(); 489 | if (Json) 490 | { 491 | Json->LoadFromFile("testInspect.json"); 492 | Inspect(Json); 493 | delete (Json); 494 | } 495 | ``` 496 | 497 | Results in: 498 | ``` 499 | object; string; Key=; Value=; JSON={"foo":"bar","array":[100,20],"arrayObj":[{"key1":1.0},{"key2":2.0}],"Msg":["#1 UTF8 example: motivação","#2 Scapes: \b\t\n\f\r\u\"\\"]} 500 | value; string; Key=foo; Value=bar; JSON="foo":"bar" 501 | array; string; Key=array; Value=; JSON="array":[100,20] 502 | value; number; Key=; Value=100; JSON=100 503 | value; number; Key=; Value=20; JSON=20 504 | array; string; Key=arrayObj; Value=; JSON="arrayObj":[{"key1":1.0},{"key2":2.0}] 505 | object; string; Key=; Value=; JSON={"key1":1.0} 506 | value; number; Key=key1; Value=1.0; JSON="key1":1.0 507 | object; string; Key=; Value=; JSON={"key2":2.0} 508 | value; number; Key=key2; Value=2.0; JSON="key2":2.0 509 | array; string; Key=Msg; Value=; JSON="Msg":["#1 UTF8 example: motivação","#2 Scapes: \b\t\n\f\r\uFFFF\"\\"] 510 | value; string; Key=; Value=#1 UTF8 example: motivação; JSON="#1 UTF8 example: motivação" 511 | value; string; Key=; Value=#2 Scapes: \b\t\n\f\r\uFFFF\"\\; JSON="#2 Scapes: \b\t\n\f\r\uFFFF\"\\" 512 | ``` 513 | 514 | ### A note about empty keys 515 | Since version `0.9.0`, empty keys will be parsed and checked withou errors: 516 | ```pascal 517 | N.AsJSON := '{"": "value"}'; 518 | ``` 519 | And `ToString()` will produce a valid JSON object: 520 | ```json 521 | { 522 | "": "value" 523 | } 524 | ``` 525 | Internally, it will use the C_EMPTY_KEY constant string as content of the fKey field. 526 | 527 | ### A note about line breaks 528 | Since version `0.9.2`, strings with not escaped line breakes will be parsed with errors: 529 | ```pascal 530 | N.AsJSON := '{"key": "value' + #13 + '"}'; 531 | ``` 532 | Will raise exception: 533 | ``` 534 | Error while parsing text: "line break" at pos "14" 535 | ``` 536 | 537 | ### Load from and Save to Files 538 | `McJSON` can load from ASCII and UTF-8 files (with or without BOM). See `LoadFromFile` method. 539 | The `SaveToFile` method will write using UTF-8 encoding. 540 | *Note*: since vertion 1.0.4, the test project's source code in Lazarus was converted to UTF-8, so the `asUTF8` parameter was set to `false`. 541 | 542 | ## Known issues 543 | The world is not perfect and neither am I. 544 | Here are some known issues: 545 | * As `TMcJsonItem` objects are instantiated in hierarchical structure using lists `fChild`, there is a problem to create fields that propagate automatically between items. A solution under study tries to create a new parent class `TMcJson` which objects will be like roots and have `TMcJsonItem` objects as its children. 546 | * Trying to follow and confirm the [specification](https://www.json.org/json-en.html) using [JSONLint](https://jsonlint.com/). 547 | 548 | ## Performance tests 549 | A performance test have been done with the original `myJSON`, `LkJson`, `JsonTools` and `uJSON` units. 550 | Here is a summary of the tests. 551 | * Generate a JSON with 50k items like: `{... {"keyi":"valuei"}... }` 552 | * Save to file. 553 | * Parse from memory (copy object forcing a parse). 554 | * Load from file (and parsing). 555 | * Access 1k items randomly. 556 | 557 | And about the compiler and machine used: 558 | * C++Builder VCL examples built with BDS 2006 (the older version I have). 559 | * Very old 32 bits machine: Intel Core 2 CPU T5500 1.66GHz 4 GB RAM. 560 | 561 | The next table summarizes the results[^1]: 562 | 563 | Library | Generate | Save | Parse | Load | Access | Total | 564 | :-----------|----------:|---------:|---------:|---------:|--------:|-----------:| 565 | `McJSON`[^2]| .11 s | .07 s | .12 s | .09 s | .83 s | 1.25 s | 566 | `LkJson`[^2]| .30 s | .11 s | .47 s | .36 s | .01 s | 1.24 s | 567 | `JsonTools` | 48.00 s | .70 s | 39.00 s | 40.00 s | .48 s | 1.2 min | 568 | `myJSON` | 50.00 s | .07 s | 5.1 min | 7.7 min | 1.60 s | 13.1 min | 569 | `uJSON` | 18.6 min | 20.1 min | 17.5 min | 4.31 s | 53.02 s | 57.6 min | 570 | 571 | 572 | [^1]: Metric: average time in seconds (s) for 5 consecutive executions. Total is the average of partial tests. Some results converted to minutes (min). 573 | [^2]: Version 1.0.5. Improved Test JSON 0.9.0 project that will be released soon. 574 | 575 | ### Notes about `McJSON` 576 | * Good performance, but not the better about random access due to the use of TList. 577 | * Simple and smart interface using "AsXXX" getters and setters (not invented here). 578 | * Generate using: `Json->Add("key")->AsString = "value"`. 579 | * Parse using: `JsonP->AsJSON = Json->AsJSON`. 580 | 581 | ### Notes about `LkJson` 582 | * Good performance generating and parsing and even better with random access due to "Balanced Search Tree" `TlkBalTree`. 583 | * TLkJSONBase and other derivated classes force to cast objects using the "as" operator. In C++Builder, this requires `dynamic_cast` making the code verbosy. 584 | * Generate using: `Json->Add("key", "value")`. 585 | * Parse using: `JsonP = dynamic_cast(TlkJSON::ParseText(NULL, TlkJSON::GenerateText(NULL, Json)))`. 586 | 587 | ### Notes about `JsonTools` 588 | * Very nice and interesting code focused on the concept of Tokens. 589 | * Also uses TList as internal data structure. 590 | * It needs a performance review. 591 | * Generate using: `Json->Add("key", "value")`. 592 | * Parse using: `JsonP->Value = Json->AsJson`. 593 | 594 | ### Notes about `myJSON` 595 | * Performance deteriored due the recurrent use of wsTrim(). 596 | * Generate using: `Json->Item["key"]->setStr("value")`. 597 | * Parse using: `JsonP->Code = Json->getJSON()`. 598 | 599 | ### Notes about `uJSON` 600 | * Less verbosy in C++ than `LkJson`, but the colection of classes also will force casting with `dynamic_cast`. 601 | * Uses TStringList as a "Hash Map" [string] -> [object address]. The quotation marks here is because I think the string entry is not a true hash within TStringList. 602 | * In some aspects, the methods interface might became puzzling. 603 | * It needs a performance review. 604 | * With `uJSON`, there seems to be a performance problem related to `toString()`. 605 | * This unit is used in other projects, e.g. [Diffbot API Delphi Client Library](https://github.com/diffbot/diffbot-delphi-client) (same author). 606 | * Generate using: `Json->put("key", "value")`. 607 | * Parse using: `JsonP = new TJSONObject(Json->toString())`. 608 | * `SaveToFile` doesn't exist, so it has used `TStringList->SaveToFile()` after filling `Text` with `Json->toString()`. 609 | 610 | -------------------------------------------------------------------------------- /src/McJSON.pas: -------------------------------------------------------------------------------- 1 | (******************************************************************************* 2 | 3 | The MIT License (MIT) 4 | 5 | Copyright (c) 2021 - 2025, HydroByte Software 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in all 15 | copies or substantial portions of the Software. 16 | 17 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 18 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 19 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 20 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 21 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 23 | SOFTWARE. 24 | *******************************************************************************) 25 | 26 | unit McJSON; 27 | 28 | interface 29 | 30 | uses 31 | Classes, SysUtils; 32 | 33 | type 34 | EMcJsonException = class(Exception); 35 | 36 | TJItemType = (jitUnset, jitValue, jitObject, jitArray); 37 | TJValueType = (jvtString, jvtNumber, jvtBoolean, jvtNull); 38 | 39 | TMcJsonItemEnumerator = class; 40 | 41 | TMcJsonItem = class 42 | private 43 | fType : TJItemType; // item type (value/object/array) 44 | fValType: TJValueType; // value type (text/number/boolean) 45 | fKey : string; // item name 46 | fValue : string; // value (if item type is value) 47 | fChild : TList; // child nodes (if item type is object/array) 48 | 49 | // property getters 50 | function fGetCount: Integer; 51 | function fGetKey(aIdx: Integer): string; 52 | function fGetType: TJItemType; 53 | function fGetItemByKey(const aKey: string): TMcJsonItem; 54 | function fGetItemByIdx(aIdx: Integer): TMcJsonItem; 55 | function fHasChild: Boolean; 56 | function fIsNull : Boolean; 57 | // AsSomething getters 58 | function fGetAsJSON : string ; 59 | function fGetAsObject : TMcJsonItem; 60 | function fGetAsArray : TMcJsonItem; 61 | function fGetAsInteger: Integer ; 62 | function fGetAsDouble : Double ; 63 | function fGetAsString : string ; 64 | function fGetAsBoolean: Boolean ; 65 | function fGetAsNull : string ; 66 | // shortener getters 67 | function fGetJSON (const aKey: string): string ; 68 | function fGetObject (const aKey: string): TMcJsonItem; 69 | function fGetArray (const aKey: string): TMcJsonItem; 70 | function fGetInteger(const aKey: string): Integer ; 71 | function fGetDouble (const aKey: string): Double ; 72 | function fGetString (const aKey: string): string ; 73 | function fGetBoolean(const aKey: string): Boolean ; 74 | function fGetNull (const aKey: string): string ; 75 | 76 | // property setters 77 | procedure fSetType(aType: TJItemType); 78 | // AsSomething setters. 79 | procedure fSetAsJSON (aValue: string ); 80 | procedure fSetAsObject (aValue: TMcJsonItem); 81 | procedure fSetAsArray (aValue: TMcJsonItem); 82 | procedure fSetAsInteger(aValue: Integer ); 83 | procedure fSetAsDouble (aValue: Double ); 84 | procedure fSetAsString (aValue: string ); 85 | procedure fSetAsBoolean(aValue: Boolean ); 86 | procedure fSetAsNull (aValue: string ); 87 | // shortener setters 88 | procedure fSetJSON (const aKey: string; aValue: string ); 89 | procedure fSetObject (const aKey: string; aValue: TMcJsonItem); 90 | procedure fSetArray (const aKey: string; aValue: TMcJsonItem); 91 | procedure fSetInteger(const aKey: string; aValue: Integer ); 92 | procedure fSetDouble (const aKey: string; aValue: Double ); 93 | procedure fSetString (const aKey: string; aValue: string ); 94 | procedure fSetBoolean(const aKey: string; aValue: Boolean ); 95 | procedure fSetNull (const aKey: string; aValue: string ); 96 | 97 | // string single-pass parser 98 | procedure parse(const aCode: string; aSpeed: Boolean); overload; 99 | function parse(const aCode: string; aPos, aLen: Integer; aSpeed: Boolean): Integer; overload; 100 | // read methods used by parse 101 | function readString (const aCode: string; var aStr:string; aPos, aLen: Integer): Integer; 102 | function readChar (const aCode: string; aChar: Char; aPos: Integer): Integer; 103 | function readKeyword(const aCode, aKeyword: string; aPos, aLen: Integer): Integer; 104 | function readValue (const aCode: string; aPos, aLen: Integer): Integer; 105 | function readObject (const aCode: string; aPos, aLen: Integer; aSpeed: Boolean): Integer; 106 | function readArray (const aCode: string; aPos, aLen: Integer; aSpeed: Boolean): Integer; 107 | function readNumber (const aCode: string; aPos, aLen: Integer): Integer; 108 | function readBoolean(const aCode: string; aPos, aLen: Integer): Integer; 109 | function readNull (const aCode: string; aPos, aLen: Integer): Integer; 110 | 111 | // aux functions used in ToString 112 | function sFormat(aHuman: Boolean): string; 113 | function sFormatItem(aStrS: TStringStream; const aIn, aNL, aSp: string): string; 114 | // other 115 | function isIndexValid(aIdx: Integer): Boolean; 116 | function InternalFloatToStr(aValue: Extended): string; 117 | function InternalStrToFloat(const aStr: string): Extended; 118 | 119 | public 120 | property Count : Integer read fGetCount; 121 | property Key : string read fKey write fKey; 122 | property Value : string read fValue write fValue; 123 | property ItemType: TJItemType read fGetType write fSetType; 124 | 125 | property Keys [aIdx : Integer]: string read fGetKey; 126 | property Items [aIdx : Integer]: TMcJsonItem read fGetItemByIdx; 127 | property Values[const aKey: string ]: TMcJsonItem read fGetItemByKey; default; 128 | 129 | property HasChild: Boolean read fHasChild; 130 | property IsNull : Boolean read fIsNull; 131 | // shorteners properties 132 | property J[const aKey: string]: string read fGetJSON write fSetJSON ; 133 | property O[const aKey: string]: TMcJsonItem read fGetObject write fSetObject ; 134 | property A[const aKey: string]: TMcJsonItem read fGetArray write fSetArray ; 135 | property I[const aKey: string]: Integer read fGetInteger write fSetInteger; 136 | property D[const aKey: string]: Double read fGetDouble write fSetDouble ; 137 | property S[const aKey: string]: string read fGetString write fSetString ; 138 | property B[const aKey: string]: Boolean read fGetBoolean write fSetBoolean; 139 | property N[const aKey: string]: string read fGetNull write fSetNull ; 140 | // AsSomething properties 141 | property AsJSON : string read fGetAsJSON write fSetAsJSON ; 142 | property AsObject : TMcJsonItem read fGetAsObject write fSetAsObject ; 143 | property AsArray : TMcJsonItem read fGetAsArray write fSetAsArray ; 144 | property AsInteger: Integer read fGetAsInteger write fSetAsInteger; 145 | property AsNumber : Double read fGetAsDouble write fSetAsDouble ; 146 | property AsString : string read fGetAsString write fSetAsString ; 147 | property AsBoolean: Boolean read fGetAsBoolean write fSetAsBoolean; 148 | property AsNull : string read fGetAsNull write fSetAsNull ; 149 | 150 | constructor Create; overload; virtual; 151 | constructor Create(aJItemType: TJItemType); overload; virtual; 152 | constructor Create(const aItem: TMcJsonItem); overload; virtual; 153 | constructor Create(const aCode: string); overload; virtual; 154 | destructor Destroy; override; 155 | 156 | procedure Clear; 157 | function IndexOf(const aKey: string): Integer; overload; 158 | function Path(const aPath: string): TMcJsonItem; overload; 159 | function Add(const aKey: string = ''): TMcJsonItem; overload; 160 | function Add(const aKey: string; aItemType: TJItemType): TMcJsonItem; overload; 161 | function Add(aItemType: TJItemType): TMcJsonItem; overload; 162 | function Add(const aItem: TMcJsonItem): TMcJsonItem; overload; 163 | function AddPair(const aItem: TMcJsonItem): TMcJsonItem; 164 | function Copy(const aItem: TMcJsonItem): TMcJsonItem; overload; 165 | function Clone: TMcJsonItem; overload; 166 | function Insert(const aKey: string; aIdx: Integer): TMcJsonItem; overload; 167 | function Insert(const aItem: TMcJsonItem; aIdx: Integer): TMcJsonItem; overload; 168 | function Delete(aIdx: Integer): Boolean; overload; 169 | function Delete(const aKey: string): Boolean; overload; 170 | function HasKey(const aKey: string): Boolean; 171 | function IsEqual(const aItem: TMcJsonItem): Boolean; 172 | function Check(const aStr: string; aSpeed: Boolean = False): Boolean; 173 | function CheckException(const aStr: string; aSpeed: Boolean = False): Boolean; 174 | function CountItems: Integer; 175 | 176 | // array shortener 177 | function At(aIdx: Integer; const aKey: string = ''): TMcJsonItem; overload; 178 | function At(const aKey: string; aIdx: Integer = -1): TMcJsonItem; overload; 179 | 180 | function ToString(aHuman: Boolean = False): string; reintroduce; overload; inline; 181 | function Minify(const aCode: string): string; 182 | 183 | procedure LoadFromStream(Stream: TStream; asUTF8: Boolean = True); 184 | procedure SaveToStream(Stream: TStream; asHuman: Boolean = True; asUTF8: Boolean = True); 185 | procedure LoadFromFile(const aFileName: string; asUTF8: Boolean = True); 186 | procedure SaveToFile(const aFileName: string; asHuman: Boolean = True; asUTF8: Boolean = True); 187 | 188 | function GetEnumerator: TMcJsonItemEnumerator; 189 | 190 | // helpers 191 | function GetTypeStr: string; 192 | function GetValueStr: string; 193 | function Qot(const aMsg: string): string; 194 | function QotKey(const aKey: string): string; 195 | procedure Error(const Msg: string; const S1: string = ''; 196 | const S2: string = ''; 197 | const S3: string = ''); 198 | end; 199 | 200 | // TMcJsonItemEnumerator 201 | TMcJsonItemEnumerator = class 202 | private 203 | fItem : TMcJsonItem; 204 | fIndex: Integer; 205 | public 206 | constructor Create(aItem: TMcJsonItem); 207 | function GetCurrent: TMcJsonItem; 208 | function MoveNext: Boolean; 209 | property Current: TMcJsonItem read GetCurrent; 210 | end; 211 | 212 | // Silence W1050 warning (D2009 and up). 213 | TMySysCharSet = set of AnsiChar; 214 | 215 | // Auxiliary escape types and functions 216 | TJEscapeType = (jetNormal , // #8 #9 #10 #12 #13 " \ 217 | jetStrict , // Normal + / 218 | jetUnicode, // Strict + \uXXXX 219 | jetNone ); // backwards compatibility 220 | function McJsonEscapeString(const aStr: string; aEsc: TJEscapeType = jetNone): string; 221 | function McJsonUnEscapeString(const aStr: string): string; 222 | 223 | // Auxiliary functions 224 | function GetItemTypeStr(aType: TJItemType): string; 225 | function GetValueTypeStr(aType: TJValueType): string; 226 | 227 | implementation 228 | 229 | const C_MCJSON_VERSION = '1.1.7'; 230 | const C_EMPTY_KEY = '__a3mptyStr__'; 231 | 232 | resourcestring 233 | SItemNil = 'Object reference is nil: %s'; 234 | SItemTypeInvalid = 'Invalid item type: expected "%s" got "%s"'; 235 | SItemTypeConvValue = 'Can''t convert item "%s" with value "%s" to "%s"'; 236 | SItemTypeConv = 'Can''t convert item "%s" to "%s"'; 237 | SParsingError = 'Error while parsing text: "%s" at pos "%s"'; 238 | SIndexInvalid = 'Invalid index: %s'; 239 | 240 | const 241 | WHITESPACE: set of AnsiChar = [#9, #10, #13, #32]; // \t(ab), \n(LF), \r(CR), spc 242 | LINEBREAK: set of AnsiChar = [#10, #13]; 243 | ESCAPES: set of AnsiChar = ['b', 't', 'n', 'f', 'r', '"', '/', '\', 'u' ]; 244 | DIGITS: set of AnsiChar = ['0'..'9']; 245 | SIGNS: set of AnsiChar = ['+', '-']; 246 | CLOSES: set of AnsiChar = ['}', ']']; 247 | HEXA: set of AnsiChar = ['0'..'9', 'A'..'F', 'a'..'f']; 248 | PATHSEPS: set of AnsiChar = ['\', '/', '.']; 249 | // escape chars names 250 | CHAR_ESCAPE = '\'; 251 | CHAR_BACKSPACE = 'b'; 252 | CHAR_H_TAB = 't'; 253 | CHAR_NEW_LINE = 'n'; 254 | CHAR_FORM_FEED = 'f'; 255 | CHAR_C_RETURN = 'r'; 256 | CHAR_Q_MARK = '"'; 257 | CHAR_SOLIDUS = '/'; 258 | CHAR_R_SOLIDUS = '\'; 259 | CHAR_U_HEX = 'u'; 260 | // escape chars integer values 261 | ID_BACKSPACE = #8; 262 | ID_H_TAB = #9; 263 | ID_NEW_LINE = #10; 264 | ID_FORM_FEED = #12; 265 | ID_C_RETURN = #13; 266 | ID_Q_MARK = #34; // '"' 267 | ID_SOLIDUS = #47; // '/' 268 | ID_R_SOLIDUS = #92; // '\' 269 | ID_U_HEX = #117; // 'u' 270 | 271 | { ---------------------------------------------------------------------------- } 272 | { Auxiliary private functions } 273 | { ---------------------------------------------------------------------------- } 274 | 275 | function myCharInSet(const aChar: Char; const aSet: TMySysCharSet): Boolean; 276 | begin 277 | {$IFNDEF UNICODE} 278 | Result := aChar in aSet; 279 | {$ELSE} 280 | Result := CharInSet(aChar, aSet); 281 | {$ENDIF} 282 | end; 283 | 284 | 285 | function escapeChar(const aStr: string; aPos, aLen: Integer; var aUnk: Boolean): Integer; 286 | var 287 | n: Integer; 288 | begin 289 | aUnk := False; 290 | n := 1; 291 | if (aStr[aPos] = '\') then 292 | begin 293 | // check next char is escapable 294 | if ( (aPos < aLen) and 295 | myCharInSet(aStr[aPos+1], ESCAPES) ) then 296 | begin 297 | // one char escapes 298 | if (aStr[aPos+1] <> 'u') then 299 | n := 2 300 | else 301 | // u+(4 hexa) escape 302 | begin 303 | if ( ( (aLen-aPos-1) > 4 ) and 304 | myCharInSet(aStr[aPos+2], HEXA) and 305 | myCharInSet(aStr[aPos+3], HEXA) and 306 | myCharInSet(aStr[aPos+4], HEXA) and 307 | myCharInSet(aStr[aPos+5], HEXA) ) 308 | then n := 6 // \u1234 (6 chars) 309 | else aUnk := True; // bad \u escape 310 | end 311 | // if not escapable 312 | end 313 | else aUnk := True; 314 | end; 315 | // return the gap escaped 316 | Result := n; 317 | end; 318 | 319 | function escapeWS(const aStr: string; aPos, aLen: Integer): Integer; 320 | var 321 | n,c: Integer; 322 | begin 323 | c := aPos; 324 | n := 0; 325 | while ( (c <= aLen) and 326 | myCharInSet(aStr[c], WHITESPACE) ) do 327 | begin 328 | Inc(c); 329 | Inc(n); 330 | end; 331 | // return the gap escaped 332 | Result := n; 333 | end; 334 | 335 | // removes all the whitespaces from the begining of the line 336 | function trimWS(const aStr: string): string; 337 | var 338 | i, j, k, n, len: Integer; 339 | sRes: string; 340 | opn, unk: Boolean; 341 | begin 342 | i := 1; 343 | j := 1; 344 | len := Length(aStr); 345 | sRes := ''; 346 | SetLength(sRes, len); 347 | opn := false; 348 | 349 | while ( i <= len ) do 350 | begin 351 | // check escapes 352 | n := escapeChar(aStr, i, len, unk); 353 | // control '"' for keys and string values. 354 | // if not escaped, toggle opn status 355 | if (n = 1) and (aStr[i] = '"') then 356 | opn := not opn; 357 | // ignore whitespaces chars 358 | if not (opn) and myCharInSet(aStr[i], WHITESPACE) then 359 | Inc(i) 360 | else 361 | // copy n chars from aStr to sRes and move on 362 | begin 363 | for k := 1 to n do 364 | begin 365 | sRes[j] := aStr[i]; 366 | Inc(i); 367 | Inc(j); 368 | end; 369 | end; 370 | end; 371 | if (j > 1) then 372 | SetLength(sRes, j-1); 373 | // result 374 | Result := sRes; 375 | end; 376 | 377 | function findUtf8BOM(const Stream: TStream): Int64; 378 | var 379 | bom: array[0..2] of Byte; 380 | begin 381 | Result := 0; 382 | if (Stream.Size > Length(bom)) then 383 | begin 384 | Stream.Read(bom, sizeof(bom)); 385 | if ( (bom[0] = $EF) and // UTF-8 BOM 386 | (bom[1] = $BB) and 387 | (bom[2] = $BF) ) then 388 | Result := 3; 389 | end; 390 | end; 391 | 392 | { ---------------------------------------------------------------------------- } 393 | { TMcJsonItem } 394 | { ---------------------------------------------------------------------------- } 395 | 396 | function TMcJsonItem.fGetCount: Integer; 397 | begin 398 | if (Self = nil) then Error(SItemNil, 'get count'); 399 | if (Assigned(fChild)) 400 | then Result := fChild.Count 401 | else Result := 0; 402 | end; 403 | 404 | function TMcJsonItem.fGetKey(aIdx: Integer): string; 405 | var 406 | aItem: TMcJsonItem; 407 | begin 408 | if (Self = nil) then Error(SItemNil, 'get key'); 409 | // return the key of the idx-th child 410 | Result := ''; 411 | aItem := fGetItemByIdx(aIdx); 412 | Result := aItem.fKey; 413 | end; 414 | 415 | function TMcJsonItem.fGetType(): TJItemType; 416 | begin 417 | if (Self = nil) then Error(SItemNil, 'get type'); 418 | Result := fType; 419 | end; 420 | 421 | function TMcJsonItem.fGetItemByKey(const aKey: string): TMcJsonItem; 422 | var 423 | idx: Integer; 424 | begin 425 | Result := nil; 426 | // check 427 | if (Self = nil) then Error(SItemNil, 'get item by key ' + Qot(aKey)); 428 | // find index of item with aKey 429 | idx := Self.IndexOf(aKey); 430 | if (idx >= 0) 431 | then Result := TMcJsonItem(fChild[idx]) 432 | else Error(SItemNil, 'get item by key ' + Qot(aKey)); 433 | end; 434 | 435 | function TMcJsonItem.fGetItemByIdx(aIdx: Integer): TMcJsonItem; 436 | begin 437 | // check 438 | if (Self = nil) then Error(SItemNil, 'get item by index ' + IntToStr(aIdx)); 439 | // type compatibility check 440 | if (fType <> jitObject) and 441 | (fType <> jitArray ) then 442 | Error(SItemNil, 'get item by index ' + IntToStr(aIdx)); 443 | // range check 444 | if (not isIndexValid(aIdx)) then 445 | Error(SIndexInvalid, 'get item by index ' + IntToStr(aIdx)); 446 | // return valid child at index aIdx 447 | Result := TMcJsonItem(fChild[aIdx]); 448 | end; 449 | 450 | function TMcJsonItem.fHasChild: Boolean; 451 | begin 452 | if (Self = nil) then Error(SItemNil, 'has child'); 453 | if (Assigned(fChild)) 454 | then Result := ( fChild.Count > 0 ) 455 | else Result := False; 456 | end; 457 | 458 | function TMcJsonItem.fIsNull: Boolean; 459 | begin 460 | if (Self = nil) then Error(SItemNil, 'is null'); 461 | Result := ( fValType = jvtNull ); 462 | end; 463 | 464 | function TMcJsonItem.fGetAsJSON(): string; 465 | begin 466 | if (Self = nil) then Error(SItemNil, 'get as JSON'); 467 | Result := ToString(False); 468 | end; 469 | 470 | function TMcJsonItem.fGetAsObject: TMcJsonItem; 471 | begin 472 | if (Self = nil ) then Error(SItemNil, 'get as object') 473 | else if (fType <> jitObject) then Error(SItemTypeInvalid, 'object', GetTypeStr); 474 | // return a compatible value type 475 | Result := Self; 476 | end; 477 | 478 | function TMcJsonItem.fGetAsArray: TMcJsonItem; 479 | begin 480 | if (Self = nil ) then Error(SItemNil, 'get as array') 481 | else if (fType <> jitArray) then Error(SItemTypeInvalid, 'array', GetTypeStr); 482 | // return a compatible value type 483 | Result := Self; 484 | end; 485 | 486 | function TMcJsonItem.fGetAsInteger: Integer; 487 | var 488 | Ans: Integer; 489 | Aux: Integer; 490 | begin 491 | Ans := 0; 492 | Aux := 0; 493 | if (Self = nil ) then Error(SItemNil, 'get as integer') 494 | else if (fType <> jitValue) then Error(SItemTypeInvalid, 'value', GetTypeStr); 495 | // return a compatible value type 496 | // try to convert 497 | try 498 | case fValType of 499 | jvtNumber : Ans := StrToInt(fValue); // expected 500 | jvtString : Ans := StrToInt(fValue); // convertion 501 | jvtBoolean: Ans := Integer(fValue = 'true'); // convertion 502 | else Aux := -1; 503 | end; 504 | except 505 | Error(SItemTypeConvValue, GetValueStr, fValue, 'integer'); 506 | end; 507 | // can´t convert, value type does not permit it 508 | if (Aux = -1) then 509 | Error(SItemTypeConv, GetValueStr, 'integer'); 510 | Result := Ans; 511 | end; 512 | 513 | function TMcJsonItem.fGetAsDouble: Double; 514 | var 515 | Ans: Double; 516 | Aux: Integer; 517 | begin 518 | Ans := 0.0; 519 | Aux := 0; 520 | if (Self = nil ) then Error(SItemNil, 'get as double') 521 | else if (fType <> jitValue) then Error(SItemTypeInvalid, 'value', GetTypeStr); 522 | // return a compatible value type 523 | // try to convert 524 | try 525 | case fValType of 526 | jvtNumber : Ans := InternalStrToFloat(fValue); // expected 527 | jvtString : Ans := InternalStrToFloat(fValue); // convertion 528 | jvtBoolean: Ans := Integer(fValue = 'true'); // convertion 529 | else Aux := -1; 530 | end; 531 | except 532 | Error(SItemTypeConvValue, GetValueStr, fValue, 'double'); 533 | end; 534 | // can´t convert, value type does not permit it 535 | if (Aux = -1) then 536 | Error(SItemTypeConv, GetValueStr, 'double'); 537 | Result := Ans; 538 | end; 539 | 540 | function TMcJsonItem.fGetAsString: string; 541 | begin 542 | if (Self = nil ) then Error(SItemNil, 'get as string') 543 | else if (fType <> jitValue) then Error(SItemTypeInvalid, 'value', GetTypeStr); 544 | // return fValue that is string already 545 | // no need to convert 546 | Result := fValue; 547 | end; 548 | 549 | function TMcJsonItem.fGetAsBoolean: Boolean; 550 | var 551 | Ans: Boolean; 552 | Aux: Integer; 553 | begin 554 | Ans := False; 555 | Aux := 0; 556 | if (Self = nil ) then Error(SItemNil, 'get as boolean') 557 | else if (fType <> jitValue) then Error(SItemTypeInvalid, 'value', GetTypeStr); 558 | // return a compatible value type 559 | // try to convert 560 | try 561 | case fValType of 562 | jvtBoolean: Ans := Boolean(fValue = 'true' ); // expected 563 | jvtString : Ans := Boolean(StrToBool(fValue)); // convertion 564 | jvtNumber : Ans := Boolean(StrToInt(fValue) ); // convertion 565 | else Aux := -1; 566 | end; 567 | except 568 | Error(SItemTypeConvValue, GetValueStr, fValue, 'boolean'); 569 | end; 570 | // can´t convert, value type does not permit it 571 | if (Aux = -1) then 572 | Error(SItemTypeConv, GetValueStr, 'boolean'); 573 | Result := Ans; 574 | end; 575 | 576 | function TMcJsonItem.fGetAsNull: string; 577 | begin 578 | if (Self = nil ) then Error(SItemNil, 'get as null') 579 | else if (fType <> jitValue) then Error(SItemTypeInvalid, 'value', GetTypeStr); 580 | // return fValue that is string already 581 | // no need to convert (null does not convet to anything, not presume zero) 582 | Result := fValue; 583 | end; 584 | 585 | // shortener getters 586 | function TMcJsonItem.fGetJSON(const aKey: string): string; 587 | begin 588 | if ( not HasKey(aKey) ) 589 | then Result := Self.Add(aKey, jitObject).AsJSON 590 | else Result := Self[aKey].AsJSON; 591 | end; 592 | 593 | function TMcJsonItem.fGetObject(const aKey: string): TMcJsonItem; 594 | begin 595 | if ( not HasKey(aKey) ) 596 | then Result := Self.Add(aKey, jitObject).AsObject 597 | else Result := Self[aKey].AsObject; 598 | end; 599 | 600 | function TMcJsonItem.fGetArray(const aKey: string): TMcJsonItem; 601 | begin 602 | if ( not HasKey(aKey) ) 603 | then Result := Self.Add(aKey, jitArray).AsArray 604 | else Result := Self[aKey].AsArray; 605 | end; 606 | 607 | function TMcJsonItem.fGetInteger(const aKey: string): Integer; 608 | begin 609 | if ( not HasKey(aKey) ) 610 | then Result := Self.Add(aKey, jitValue).AsInteger 611 | else Result := Self[aKey].AsInteger; 612 | end; 613 | 614 | function TMcJsonItem.fGetDouble(const aKey: string): Double; 615 | begin 616 | if ( not HasKey(aKey) ) 617 | then Result := Self.Add(aKey, jitValue).AsNumber 618 | else Result := Self[aKey].AsNumber; 619 | end; 620 | 621 | function TMcJsonItem.fGetString(const aKey: string): string; 622 | begin 623 | if ( not HasKey(aKey) ) 624 | then Result := Self.Add(aKey, jitValue).AsString 625 | else Result := Self[aKey].AsString; 626 | end; 627 | 628 | function TMcJsonItem.fGetBoolean(const aKey: string): Boolean; 629 | begin 630 | if ( not HasKey(aKey) ) 631 | then Result := Self.Add(aKey, jitValue).AsBoolean 632 | else Result := Self[aKey].AsBoolean; 633 | end; 634 | 635 | function TMcJsonItem.fGetNull(const aKey: string): string; 636 | begin 637 | if ( not HasKey(aKey) ) 638 | then Result := Self.Add(aKey, jitValue).AsNull 639 | else Result := Self[aKey].AsNull; 640 | end; 641 | 642 | procedure TMcJsonItem.fSetType(aType: TJItemType); 643 | var 644 | k: Integer; 645 | begin 646 | if (Self = nil) then Error(SItemNil, 'set type'); 647 | // if an array or object is converted to a number, clear all descendants 648 | if (aType = jitValue) and (fType <> jitValue) then 649 | begin 650 | Clear; 651 | // the default value type is text 652 | fValType := jvtString; 653 | end 654 | // if a number is converted to an object or array, then take away the value from it 655 | else if (aType <> jitValue) and (fType = jitValue) then 656 | begin 657 | fValue := ''; 658 | end 659 | // if the array is converted into an object, then assign keys to all its elements 660 | else if (aType = jitObject) and (fType = jitArray) then 661 | begin 662 | for k := 0 to (fChild.Count - 1) do 663 | TMcJsonItem(fChild[k]).fKey := IntToStr(k); 664 | end 665 | // if an object is converted into an array, then remove the keys from its descendants 666 | else if (aType = jitArray) and (fType = jitObject) then 667 | begin 668 | for k := 0 to (fChild.Count - 1) do 669 | TMcJsonItem(fChild[k]).fKey := ''; 670 | end; 671 | // return aked type 672 | fType := aType; 673 | end; 674 | 675 | procedure TMcJsonItem.fSetAsJSON(aValue: string); 676 | begin 677 | if (Self = nil) then Error(SItemNil, 'set as JSON'); 678 | // speed up = no key duplication verification (default) 679 | Self.parse(aValue, True); 680 | end; 681 | 682 | procedure TMcJsonItem.fSetAsObject(aValue: TMcJsonItem); 683 | begin 684 | if (Self = nil) then Error(SItemNil, 'set as object'); 685 | // if unset, set as value 686 | if (fType <> jitObject) then fSetType(jitObject); 687 | // make a copy (parsing) 688 | Self.AsJSON := aValue.AsJSON; 689 | end; 690 | 691 | procedure TMcJsonItem.fSetAsArray(aValue: TMcJsonItem); 692 | begin 693 | if (Self = nil) then Error(SItemNil, 'set as array'); 694 | // if unset, set as value 695 | if (fType <> jitArray) then fSetType(jitArray); 696 | // make a copy (parsing) 697 | Self.AsJSON := aValue.AsJSON; 698 | end; 699 | 700 | procedure TMcJsonItem.fSetAsInteger(aValue: Integer); 701 | var 702 | k: Integer; 703 | begin 704 | if (Self = nil ) then Error(SItemNil, 'set as integer'); 705 | // if unset, set as value 706 | if (fType = jitUnset) then fSetType(jitValue); 707 | // if container, set aValue for each child 708 | if (fType = jitArray) or (fType = jitObject) then 709 | begin 710 | for k := 0 to (fChild.Count - 1) do 711 | TMcJsonItem(fChild[k]).AsInteger := aValue; 712 | end 713 | else 714 | begin 715 | if (fValType <> jvtNumber) then fValType := jvtNumber; 716 | // set aValue as string 717 | fValue := IntToStr(aValue); 718 | end; 719 | end; 720 | 721 | procedure TMcJsonItem.fSetAsDouble(aValue: Double); 722 | var 723 | k: Integer; 724 | begin 725 | if (Self = nil ) then Error(SItemNil, 'set as double'); 726 | // if unset, set as value 727 | if (fType = jitUnset) then fSetType(jitValue); 728 | // if container, set aValue for each child 729 | if (fType = jitArray) or (fType = jitObject) then 730 | begin 731 | for k := 0 to (fChild.Count - 1) do 732 | TMcJsonItem(fChild[k]).AsNumber := aValue; 733 | end 734 | else 735 | begin 736 | if (fValType <> jvtNumber) then fValType := jvtNumber; 737 | // set aValue as string 738 | fValue := InternalFloatToStr(aValue); 739 | end; 740 | end; 741 | 742 | procedure TMcJsonItem.fSetAsString(aValue: string); 743 | var 744 | k: Integer; 745 | begin 746 | if (Self = nil ) then Error(SItemNil, 'set as string'); 747 | // if unset, set as value 748 | if (fType = jitUnset) then fSetType(jitValue); 749 | // if container, set aValue for each child 750 | if (fType = jitArray) or (fType = jitObject) then 751 | begin 752 | for k := 0 to (fChild.Count - 1) do 753 | TMcJsonItem(fChild[k]).AsString := aValue; 754 | end 755 | else 756 | begin 757 | if (fValType <> jvtString) then fValType := jvtString; 758 | // set aValue as string 759 | fValue := aValue; 760 | end; 761 | end; 762 | 763 | procedure TMcJsonItem.fSetAsBoolean(aValue: Boolean); 764 | var 765 | k: Integer; 766 | begin 767 | if (Self = nil ) then Error(SItemNil, 'set as boolean'); 768 | // if unset, set as value 769 | if (fType = jitUnset) then fSetType(jitValue); 770 | // if container, set aValue for each child 771 | if (fType = jitArray) or (fType = jitObject) then 772 | begin 773 | for k := 0 to (fChild.Count - 1) do 774 | TMcJsonItem(fChild[k]).AsBoolean := aValue; 775 | end 776 | else 777 | begin 778 | if (fValType <> jvtBoolean) then fValType := jvtBoolean; 779 | // set aValue as string 780 | if aValue 781 | then fValue := 'true' 782 | else fValue := 'false'; 783 | end; 784 | end; 785 | 786 | procedure TMcJsonItem.fSetAsNull(aValue: string); 787 | var 788 | k: Integer; 789 | begin 790 | if (Self = nil ) then Error(SItemNil, 'set as null'); 791 | // if unset, set as value 792 | if (fType = jitUnset) then fSetType(jitValue); 793 | // if container, set aValue for each child 794 | if (fType = jitArray) or (fType = jitObject) then 795 | begin 796 | for k := 0 to (fChild.Count - 1) do 797 | TMcJsonItem(fChild[k]).AsNull := 'null'; // ignore aValue 798 | end 799 | else 800 | begin 801 | if (fValType <> jvtNull) then fValType := jvtNull; 802 | // set aValue as string 803 | fValue := 'null'; // ignore aValue 804 | end; 805 | end; 806 | 807 | // shortener setters 808 | procedure TMcJsonItem.fSetJSON(const aKey: string; aValue: string); 809 | begin 810 | if ( not HasKey(aKey) ) 811 | then Self.Add(aKey).AsJSON := aValue 812 | else Self[aKey].AsJSON := aValue; 813 | end; 814 | 815 | procedure TMcJsonItem.fSetObject(const aKey: string; aValue: TMcJsonItem); 816 | begin 817 | if ( not HasKey(aKey) ) 818 | then Self.Add(aKey).AsObject := aValue 819 | else Self[aKey].AsObject := aValue; 820 | end; 821 | 822 | procedure TMcJsonItem.fSetArray(const aKey: string; aValue: TMcJsonItem); 823 | begin 824 | if ( not HasKey(aKey) ) 825 | then Self.Add(aKey).AsArray := aValue 826 | else Self[aKey].AsArray := aValue; 827 | end; 828 | 829 | procedure TMcJsonItem.fSetInteger(const aKey: string; aValue: Integer); 830 | begin 831 | if ( not HasKey(aKey) ) 832 | then Self.Add(aKey).AsInteger := aValue 833 | else Self[aKey].AsInteger := aValue; 834 | end; 835 | 836 | procedure TMcJsonItem.fSetDouble(const aKey: string; aValue: Double); 837 | begin 838 | if ( not HasKey(aKey) ) 839 | then Self.Add(aKey).AsNumber := aValue 840 | else Self[aKey].AsNumber := aValue; 841 | end; 842 | 843 | procedure TMcJsonItem.fSetString(const aKey: string; aValue: string); 844 | begin 845 | if ( not HasKey(aKey) ) 846 | then Self.Add(aKey).AsString := aValue 847 | else Self[aKey].AsString := aValue; 848 | end; 849 | 850 | procedure TMcJsonItem.fSetBoolean(const aKey: string; aValue: Boolean); 851 | begin 852 | if ( not HasKey(aKey) ) 853 | then Self.Add(aKey).AsBoolean := aValue 854 | else Self[aKey].AsBoolean := aValue; 855 | end; 856 | 857 | procedure TMcJsonItem.fSetNull(const aKey: string; aValue: string); 858 | begin 859 | if ( not HasKey(aKey) ) 860 | then Self.Add(aKey).AsNull := aValue 861 | else Self[aKey].AsNull := aValue; 862 | end; 863 | 864 | procedure TMcJsonItem.parse(const aCode: string; aSpeed: Boolean); 865 | var 866 | c, len: Integer; 867 | begin 868 | Clear; 869 | len := Length(aCode); 870 | c := 1; 871 | try 872 | c := Self.parse(aCode, 1, len, aSpeed); 873 | except 874 | on EOutOfMemory do 875 | Error(SItemNil, 'out of memory with ' + IntToStr(CountItems) + ' items'); 876 | end; 877 | // valid-JSON 878 | if (len = 0) then 879 | Error(SParsingError, 'bad json', IntToStr(len)); 880 | if (c < len) then 881 | Error(SParsingError, 'bad json', IntToStr(c) ); 882 | end; 883 | 884 | function TMcJsonItem.parse(const aCode: string; aPos, aLen: Integer; aSpeed: Boolean): Integer; 885 | begin 886 | Result := aPos; 887 | // check position 888 | if (aPos > aLen) then 889 | Exit; 890 | // escape white spaces 891 | Inc(aPos, escapeWS(aCode, aPos, aLen)); 892 | // now in the first character our open parenthesis 893 | case aCode[aPos] of 894 | '{': aPos := readObject (aCode, aPos, aLen, aSpeed); // recursive 895 | '[': aPos := readArray (aCode, aPos, aLen, aSpeed); // recursive 896 | '"': aPos := readValue (aCode, aPos, aLen); 897 | '0'..'9', '+', '-': aPos := readNumber (aCode, aPos, aLen); 898 | 't', 'T', 'f', 'F': aPos := readBoolean(aCode, aPos, aLen); 899 | 'n', 'N': aPos := readNull (aCode, aPos, aLen); 900 | else 901 | begin 902 | // valid-JSON 903 | Error(SParsingError, 'invalid char', IntToStr(aPos)); 904 | end; 905 | end; 906 | // escape white spaces 907 | Inc(aPos, escapeWS(aCode, aPos, aLen)); 908 | // move on 909 | Result := aPos; 910 | end; 911 | 912 | function TMcJsonItem.readObject(const aCode: string; aPos, aLen: Integer; aSpeed: Boolean): Integer; 913 | var 914 | c: Integer; 915 | aItem: TMcJsonItem; 916 | sKey : string; 917 | first: Boolean; 918 | begin 919 | // we got here because current symbol was '{' 920 | c := aPos+1; 921 | // escape white spaces 922 | Inc(c, escapeWS(aCode, c, aLen)); 923 | // set item type 924 | Self.fSetType(jitObject); 925 | first := True; 926 | // reading values until we reach a '}' 927 | while ( (c <= aLen) and (aCode[c] <> '}') ) do 928 | begin 929 | // parse ',' 930 | if (not first) then 931 | c := readChar(aCode, ',', c); 932 | first := False; 933 | // escape white spaces 934 | Inc(c, escapeWS(aCode, c, aLen)); 935 | // parsing a "key", stop next to '"' 936 | c := readString(aCode, sKey, c, aLen); 937 | // check empty key like {"":"value"} 938 | if (sKey = '') then 939 | sKey := C_EMPTY_KEY; 940 | // create a new item with parsed key 941 | // check duplicate (subject to speed up flag) 942 | aItem := nil; 943 | if (aSpeed) then 944 | aItem := Self.Add(sKey) 945 | else 946 | begin 947 | // valid-JSON 948 | if (Self.IndexOf(sKey) < 0) 949 | then aItem := Self.Add(sKey) 950 | else Error(SParsingError, 'duplicated key ' + sKey, IntToStr(c)); 951 | end; 952 | // escape white spaces 953 | Inc(c, escapeWS(aCode, c, aLen)); 954 | // parse ':' 955 | c := readChar(aCode, ':', c); 956 | // escape white spaces 957 | Inc(c, escapeWS(aCode, c, aLen)); 958 | // parsing a value (recursive) 959 | if (aItem <> nil) then 960 | c := aItem.parse(aCode, c, aLen, aSpeed); 961 | // move on 962 | Inc(c, escapeWS(aCode, c, aLen)); 963 | end; 964 | // valid-JSON 965 | if (c > aLen) then 966 | Error(SParsingError, 'bad object', IntToStr(aLen)) 967 | else if (aCode[c] <> '}') then 968 | Error(SParsingError, 'bad object', IntToStr(c) ); 969 | // stop next to '}' 970 | Result := c+1; 971 | end; 972 | 973 | function TMcJsonItem.readArray(const aCode: string; aPos, aLen: Integer; aSpeed: Boolean): Integer; 974 | var 975 | c: Integer; 976 | aItem: TMcJsonItem; 977 | first: Boolean; 978 | begin 979 | // we got here because current symbol was '[' 980 | c := aPos+1; 981 | // escape white spaces 982 | Inc(c, escapeWS(aCode, c, aLen)); 983 | // set item type 984 | Self.fSetType(jitArray); 985 | first := True; 986 | // reading values until we reach a ']' 987 | while ( (c <= aLen) and (aCode[c] <> ']') ) do 988 | begin 989 | // parse ',' 990 | if (not first) then 991 | c := readChar(aCode, ',', c); 992 | first := False; 993 | // escape white spaces 994 | Inc(c, escapeWS(aCode, c, aLen)); 995 | // Creating a new value (here explicity whith no key) 996 | aItem := Self.Add(); 997 | // parsing values (recursive) 998 | c := aItem.parse(aCode, c, aLen, aSpeed); // 1,2,3 or {...},{...} 999 | if (c > aLen) then 1000 | Error(SParsingError, 'bad array', IntToStr(aLen)); 1001 | // move on 1002 | Inc(c, escapeWS(aCode, c, aLen)); 1003 | end; 1004 | // valid-JSON 1005 | if (c > aLen) then 1006 | Error(SParsingError, 'bad object', IntToStr(aLen)) 1007 | else if (aCode[c] <> ']') then 1008 | Error(SParsingError, 'bad array', IntToStr(c) ); 1009 | // stop next to ']' 1010 | Result := c+1; 1011 | end; 1012 | 1013 | function TMcJsonItem.readString(const aCode: string; var aStr:string; aPos, aLen: Integer): Integer; 1014 | var 1015 | c: Integer; 1016 | unk: Boolean; 1017 | begin 1018 | aStr := ''; 1019 | c := aPos; 1020 | if (aCode[aPos] = '"') then 1021 | begin 1022 | Inc(c); 1023 | while ( (c <= aLen) and (aCode[c] <> '"') ) do 1024 | begin 1025 | // do escapes 1026 | Inc(c, escapeChar(aCode, c, aLen, unk)); 1027 | // Valid-JSON: break lines 1028 | if ( (c > aLen) or myCharInSet(aCode[c], LINEBREAK) ) then 1029 | Error(SParsingError, 'line break', IntToStr(c)); 1030 | // Valid-JSON: unknown escape 1031 | if (unk) then 1032 | Error(SParsingError, 'unknown escape', IntToStr(c)); 1033 | end; 1034 | // copy between '"' 1035 | if (aCode[c] = '"') then 1036 | aStr := System.Copy(aCode, aPos+1, c-aPos-1); // "string" -> string 1037 | end; 1038 | // stop next to '"' 1039 | if (c < aLen) then Inc(c); 1040 | Result := c; 1041 | end; 1042 | 1043 | function TMcJsonItem.readChar(const aCode: string; aChar: Char; aPos: Integer): Integer; 1044 | begin 1045 | // Valid-JSON: unexpected char 1046 | if ( aCode[aPos] <> aChar ) then 1047 | Error(SParsingError, 'expected ' + aChar + ' got ' + aCode[aPos], IntToStr(aPos)); 1048 | // stop next to aChar 1049 | Result := aPos+1; 1050 | end; 1051 | 1052 | function TMcJsonItem.readKeyword(const aCode, aKeyword: string; aPos, aLen: Integer): Integer; 1053 | var 1054 | len: Integer; 1055 | sAux: string; 1056 | begin 1057 | len := Length(aKeyword); 1058 | // valid-JSON 1059 | if (aPos+len > aLen) then 1060 | Error(SParsingError, 'bad reserved keyword', IntToStr(aLen)); 1061 | sAux := System.Copy(aCode, aPos, len); 1062 | // valid-JSON 1063 | if (Lowercase(sAux) <> aKeyword) then 1064 | Error(SParsingError, 'invalid reserved keyword ' + sAux, IntToStr(aPos)); 1065 | // stop next to keyword last char 1066 | Result := aPos + len; 1067 | end; 1068 | 1069 | function TMcJsonItem.readValue(const aCode: string; aPos, aLen: Integer): Integer; 1070 | var 1071 | c: Integer; 1072 | sVal: string; 1073 | begin 1074 | // we got here because current symbol is '"' 1075 | c := aPos; 1076 | // parse a "value" -> value 1077 | c := readString(aCode, sVal, c, aLen); 1078 | // valid-JSON 1079 | if (c > aLen) then 1080 | Error(SParsingError, 'bad value', IntToStr(aLen)); 1081 | // set item and value types 1082 | Self.fSetType(jitValue); 1083 | Self.fValType := jvtString; 1084 | Self.fValue := sVal; 1085 | // stop next to '"' 1086 | Result := c; 1087 | end; 1088 | 1089 | function TMcJsonItem.readNumber(const aCode: string; aPos, aLen: Integer): Integer; 1090 | var 1091 | c, cEnd, ePos: Integer; 1092 | begin 1093 | // we got here because current symbol was '+/-' or Digit 1094 | c := aPos; 1095 | // 1. sign (optional) 1096 | if ( myCharInSet(aCode[c], SIGNS) ) 1097 | then Inc(c); 1098 | // 2. some digits but not leading zeros 1099 | while ( myCharInSet(aCode[c], DIGITS) ) do 1100 | Inc(c); 1101 | // 3. decimal dot (optional) 1102 | if aCode[c] = '.' 1103 | then Inc(c); 1104 | // 4. fractional digits (optional) 1105 | while ( myCharInSet(aCode[c], DIGITS) ) do 1106 | Inc(c); 1107 | // 5. scientific notation ...E-01 1108 | if LowerCase(aCode[c]) = 'e' then 1109 | begin 1110 | ePos := c; 1111 | Inc(c); 1112 | if ( myCharInSet(aCode[c], SIGNS) ) 1113 | then Inc(c); 1114 | while ( myCharInSet(aCode[c], DIGITS) ) do 1115 | Inc(c); 1116 | // valid-JSON: bad scientific number 1117 | if (ePos+1 = c) then 1118 | Error(SParsingError, 'bad scientific number', IntToStr(c)); 1119 | end; 1120 | // Result 1121 | Self.fSetType(jitValue); 1122 | Self.fValType := jvtNumber; 1123 | Self.fValue := System.Copy(aCode, aPos, c-aPos); 1124 | // last number pos. 1125 | cEnd := c; 1126 | // escape white spaces 1127 | Inc(c, escapeWS(aCode, c, aLen)); 1128 | // valid-JSON: not a number 1129 | if not ( (aCode[c] = ',' ) or 1130 | myCharInSet(aCode[c], CLOSES) ) then 1131 | Error(SParsingError, 'not a number', IntToStr(c)); 1132 | // valid-JSON: leading zero 1133 | if (aCode[aPos] = '0') and (aPos < aLen) and (cEnd-aPos > 1) and 1134 | (aCode[aPos+1] <> '.') then 1135 | Error(SParsingError, 'bad number, leading zero', IntToStr(c)); 1136 | // stop next to number last char 1137 | Result := c; 1138 | end; 1139 | 1140 | function TMcJsonItem.readBoolean(const aCode: string; aPos, aLen: Integer): Integer; 1141 | var 1142 | c: Integer; 1143 | begin 1144 | // we got here because current symbol was 't/T' or 'f/F' 1145 | c := aPos; 1146 | // check boolean value 'true' 1147 | if (aCode[aPos] = 't') or 1148 | (aCode[aPos] = 'T') then 1149 | begin 1150 | c := readKeyword(aCode, 'true', c, aLen); 1151 | Self.fValue := 'true'; 1152 | end 1153 | // check boolean value 'false' 1154 | else if (aCode[aPos] = 'f') or 1155 | (aCode[aPos] = 'F') then 1156 | begin 1157 | c := readKeyword(aCode, 'false', c, aLen); 1158 | Self.fValue := 'false'; 1159 | end; 1160 | // set item and value types 1161 | Self.fSetType(jitValue); 1162 | Self.fValType := jvtBoolean; 1163 | // stop next to keyword last char 1164 | Result := c; 1165 | end; 1166 | 1167 | function TMcJsonItem.readNull(const aCode: string; aPos, aLen: Integer): Integer; 1168 | var 1169 | c: Integer; 1170 | begin 1171 | // we got here because current symbol was 'n/N' 1172 | c := aPos; 1173 | // check if null 1174 | if (aCode[aPos] = 'n') or 1175 | (aCode[aPos] = 'N') then 1176 | begin 1177 | c := readKeyword(aCode, 'null', c, aLen); 1178 | Self.fValue := 'null'; 1179 | end; 1180 | // set item and value types 1181 | Self.fSetType(jitValue); 1182 | Self.fValType := jvtNull; 1183 | // stop next to keyword last char 1184 | Result := c; 1185 | end; 1186 | 1187 | function TMcJsonItem.sFormat(aHuman: Boolean): string; 1188 | var 1189 | strS: TStringStream; 1190 | sNL, sSp: string; 1191 | begin 1192 | strS := TStringStream.Create(''); 1193 | try 1194 | // new line 1195 | if aHuman 1196 | then sNL := #13#10 1197 | else sNL := ''; 1198 | // key value separator 1199 | if (aHuman) 1200 | then sSp := ': ' 1201 | else sSp := ':'; 1202 | // call format item recursively 1203 | SFormatItem(strS, '', sNL, sSp); 1204 | // final result; 1205 | Result := strS.DataString; 1206 | finally 1207 | strS.Free; 1208 | end; 1209 | end; 1210 | 1211 | function TMcJsonItem.sFormatItem(aStrS: TStringStream; const aIn, aNL, aSp: string): string; 1212 | var 1213 | k, len: Integer; 1214 | sGoIn: string; 1215 | begin 1216 | Result := ''; 1217 | sGoIn := ''; 1218 | 1219 | if (Self = nil) then 1220 | Exit; 1221 | 1222 | case Self.fType of 1223 | // format JSON object 1224 | jitObject: 1225 | begin 1226 | if (fKey <> '') then 1227 | aStrS.WriteString(QotKey(fKey) + aSp); 1228 | aStrS.WriteString('{' + aNL); 1229 | len := Self.Count - 1; 1230 | // use aSp to define if aHuman is true. 1231 | if (aSp <> ':') then sGoIn := aIn + ' '; 1232 | // mount recursively 1233 | for k := 0 to len do 1234 | begin 1235 | aStrS.WriteString(sGoIn); 1236 | aStrS.WriteString(TMcJsonItem(fChild[k]).sFormatItem(aStrS, sGoIn, aNL, aSP) ); 1237 | if ( k < len ) then 1238 | aStrS.WriteString(',' + aNL); 1239 | end; 1240 | aStrS.WriteString(aNL + aIn + '}'); 1241 | end; 1242 | // format JSON array 1243 | jitArray: 1244 | begin 1245 | if (fKey <> '') then 1246 | aStrS.WriteString(QotKey(fKey) + aSp); 1247 | aStrS.WriteString('[' + aNL); 1248 | len := Self.Count - 1; 1249 | // use aSp to define if aHuman is true. 1250 | if (aSp <> ':') then sGoIn := aIn + ' '; 1251 | // mount recursively 1252 | for k := 0 to len do 1253 | begin 1254 | aStrS.WriteString(sGoIn); 1255 | aStrS.WriteString(TMcJsonItem(fChild[k]).SFormatItem(aStrS, sGoIn, aNL, aSP) ); 1256 | if ( k < len ) then 1257 | aStrS.WriteString(','+ aNL); 1258 | end; 1259 | aStrS.WriteString(aNL + aIn + ']'); 1260 | end; 1261 | // format JSON key:value pair 1262 | jitValue: 1263 | begin 1264 | if (fKey <> '') then 1265 | aStrS.WriteString(QotKey(fKey) + aSp); 1266 | if (fValType = jvtString) 1267 | then aStrS.WriteString(Qot(fValue)) 1268 | else aStrS.WriteString( fValue ); 1269 | end; 1270 | // empty key and/or empty value 1271 | jitUnset: 1272 | begin 1273 | if (fKey <> '') then 1274 | begin 1275 | aStrS.WriteString(QotKey(fKey) + aSp); 1276 | if (fValType = jvtString) 1277 | then aStrS.WriteString(Qot(fValue)) 1278 | else aStrS.WriteString( fValue ); 1279 | end; 1280 | end; 1281 | end; 1282 | end; 1283 | 1284 | function TMcJsonItem.isIndexValid(aIdx: Integer): Boolean; 1285 | var 1286 | Ans: Boolean; 1287 | begin 1288 | if (fChild.Count <= 0) 1289 | then Ans := (AIdx = 0) 1290 | else Ans := (AIdx >= 0) and (AIdx < fChild.Count); 1291 | Result := Ans; 1292 | end; 1293 | 1294 | function TMcJsonItem.InternalFloatToStr(aValue: Extended): string; 1295 | var 1296 | Fmt: TFormatSettings; 1297 | begin 1298 | // internally, use "." as Decimal Separator. 1299 | Fmt.DecimalSeparator := '.'; 1300 | // will raize an exception if aValue not valid. 1301 | Result := FloatToStr(aValue, Fmt); 1302 | end; 1303 | 1304 | function TMcJsonItem.InternalStrToFloat(const aStr: string): Extended; 1305 | var 1306 | Fmt: TFormatSettings; 1307 | begin 1308 | // internally, use "." as Decimal Separator. 1309 | Fmt.DecimalSeparator := '.'; 1310 | // will raize an exception if aValue not valid. 1311 | Result := StrToFloat(aStr, Fmt); 1312 | end; 1313 | 1314 | { ---------------------------------------------------------------------------- } 1315 | { TMcJsonItem - Public methods } 1316 | { ---------------------------------------------------------------------------- } 1317 | 1318 | constructor TMcJsonItem.Create; 1319 | begin 1320 | fChild := nil; 1321 | fType := jitUnset; 1322 | end; 1323 | 1324 | constructor TMcJsonItem.Create(aJItemType: TJItemType); 1325 | begin 1326 | Create; 1327 | Self.ItemType := aJItemType; 1328 | end; 1329 | 1330 | constructor TMcJsonItem.Create(const aItem: TMcJsonItem); 1331 | begin 1332 | Create; 1333 | Self.AsJSON := aItem.AsJSON; 1334 | end; 1335 | 1336 | constructor TMcJsonItem.Create(const aCode: string); 1337 | begin 1338 | Create; 1339 | try 1340 | Self.AsJSON := aCode; 1341 | except 1342 | Self.AsJSON := ''; 1343 | end; 1344 | end; 1345 | 1346 | destructor TMcJsonItem.Destroy; 1347 | begin 1348 | Clear; 1349 | fChild.Free; 1350 | inherited Destroy; 1351 | end; 1352 | 1353 | procedure TMcJsonItem.Clear; 1354 | var 1355 | k: Integer; 1356 | begin 1357 | if (Self = nil) then Error(SItemNil, 'clear'); 1358 | if (Assigned(fChild)) then 1359 | begin 1360 | // free memory of all children (will be recursive) 1361 | for k := 0 to (fChild.Count - 1) do 1362 | TMcJsonItem(fChild[k]).Free; 1363 | // clear list 1364 | fChild.Clear; 1365 | end; 1366 | end; 1367 | 1368 | function TMcJsonItem.IndexOf(const aKey: string): Integer; 1369 | var 1370 | k, idx: Integer; 1371 | item: TMcJsonItem; 1372 | begin 1373 | idx := -1; 1374 | Result := idx; 1375 | // check 1376 | if (Self = nil) then Error(SItemNil, 'index of'); 1377 | if (not Assigned(fChild)) then Exit; 1378 | // if self is an object 1379 | if (Self.fType = jitObject) then 1380 | begin 1381 | // looking for an child element 1382 | for k := 0 to (fChild.Count - 1) do 1383 | begin 1384 | if (TMcJsonItem(fChild[k]).fKey = aKey) then 1385 | begin 1386 | idx := k; 1387 | Break; 1388 | end; 1389 | end; 1390 | end 1391 | else if (Self.fType = jitArray) then 1392 | begin 1393 | // looking for an child element: arrays items are "empty objects" 1394 | for k := 0 to (fChild.Count - 1) do 1395 | begin 1396 | item := TMcJsonItem(fChild[k]).Items[0]; 1397 | if (TMcJsonItem(item).fKey = aKey) then 1398 | begin 1399 | idx := k; 1400 | Break; 1401 | end; 1402 | end; 1403 | end; 1404 | // return the Result 1405 | if (idx >= 0 ) and 1406 | (idx < fChild.Count) then 1407 | Result := idx; 1408 | end; 1409 | 1410 | function TMcJsonItem.Path(const aPath: string): TMcJsonItem; 1411 | 1412 | function GetKeyByPath(const aPath: string; var aPos, aLen: Integer): string; 1413 | var 1414 | c: Integer; 1415 | begin 1416 | Result := ''; 1417 | // check start with sep 1418 | if ( myCharInSet(aPath[aPos], PATHSEPS) ) then 1419 | Inc(aPos); 1420 | c := aPos; 1421 | while ( (c <= aLen) and not myCharInSet(aPath[c], PATHSEPS) ) do 1422 | begin 1423 | Inc(c); 1424 | end; 1425 | // copy between seps 1426 | if (c-aPos >= 0) then 1427 | Result := System.Copy(aPath, aPos, c-aPos); 1428 | // move on 1429 | aPos := c; 1430 | end; 1431 | 1432 | var 1433 | aItem: TMcJsonItem; 1434 | c, len: Integer; 1435 | sKey: string; 1436 | begin 1437 | if (Self = nil) then Error(SItemNil, 'get by path ' + Qot(aPath)); 1438 | aItem := Self; 1439 | // parse path of keys using seps 1440 | c := 1; 1441 | len := Length(aPath); 1442 | while ( (aItem <> nil) and 1443 | (c <= len) ) do 1444 | begin 1445 | // get by key 1446 | sKey := GetKeyByPath(aPath, c, len); 1447 | if (sKey <> '') then 1448 | begin 1449 | if ( aItem.HasKey(sKey) ) 1450 | then aItem := aItem.fGetItemByKey(sKey) 1451 | else aItem := nil; 1452 | end; 1453 | end; 1454 | // result aItem to permit chain 1455 | Result := aItem; 1456 | end; 1457 | 1458 | function TMcJsonItem.Add(const aKey: string): TMcJsonItem; 1459 | var 1460 | aItem: TMcJsonItem; 1461 | begin 1462 | if (Self = nil) then Error(SItemNil, 'add using key ' + Qot(aKey)); 1463 | // check unset item 1464 | if (fType = jitUnset) then 1465 | fSetType(jitObject); 1466 | // create a new item and check its parent type. 1467 | aItem := TMcJsonItem.Create; 1468 | // parent is array 1469 | if (fType = jitArray) then 1470 | begin 1471 | // if not empty key, create object 1472 | if (aKey <> '') then 1473 | aItem.Add(aKey) 1474 | end 1475 | // parent is object or value 1476 | else 1477 | begin 1478 | // check empty key {"":"value"} 1479 | if (aKey = '') 1480 | then aItem.fKey := C_EMPTY_KEY 1481 | else aItem.fKey := aKey; 1482 | end; 1483 | // child on demand 1484 | if (not Assigned(fChild)) then 1485 | fChild := TList.Create; 1486 | fChild.Add(aItem); 1487 | // result aItem to permit chain 1488 | Result := aItem; 1489 | end; 1490 | 1491 | function TMcJsonItem.Add(const aKey: string; aItemType: TJItemType): TMcJsonItem; 1492 | var 1493 | aItem: TMcJsonItem; 1494 | begin 1495 | aItem := Self.Add(aKey); 1496 | aItem.ItemType := aItemType; 1497 | // result aItem to permit chain 1498 | Result := aItem; 1499 | end; 1500 | 1501 | function TMcJsonItem.Add(aItemType: TJItemType): TMcJsonItem; 1502 | var 1503 | aItem: TMcJsonItem; 1504 | begin 1505 | aItem := Self.Add(); 1506 | aItem.ItemType := aItemType; 1507 | // result aItem to permit chain 1508 | Result := aItem; 1509 | end; 1510 | 1511 | function TMcJsonItem.Add(const aItem: TMcJsonItem): TMcJsonItem; 1512 | var 1513 | aNewItem: TMcJsonItem; 1514 | begin 1515 | if (Self = nil) then Error(SItemNil, 'add using item'); 1516 | // check unset item 1517 | if (fType = jitUnset) then 1518 | fSetType(jitObject); 1519 | // check if self is an array 1520 | if (fType <> jitArray) then 1521 | Error(SItemTypeInvalid, 'array', GetTypeStr); 1522 | // create a new item copy of aItem and add it. 1523 | aNewItem := TMcJsonItem.Create(aItem); 1524 | // add item. 1525 | if (not Assigned(fChild)) then 1526 | fChild := TList.Create; 1527 | fChild.Add(aNewItem); 1528 | // result aNewItem to permit chain 1529 | Result := aNewItem; 1530 | end; 1531 | 1532 | function TMcJsonItem.AddPair(const aItem: TMcJsonItem): TMcJsonItem; 1533 | var 1534 | aPair: TMcJsonItem; 1535 | begin 1536 | aPair := Self.Add(aItem.Key); 1537 | aPair.ItemType := jitValue; 1538 | APair.Value := aItem.Value; 1539 | // result aItem to permit chain 1540 | Result := aPair; 1541 | end; 1542 | 1543 | function TMcJsonItem.Copy(const aItem: TMcJsonItem): TMcJsonItem; 1544 | begin 1545 | if (Self = nil) then Error(SItemNil, 'copy'); 1546 | // clear self and copy JSON from aItem 1547 | Self.Clear; 1548 | Self.AsJSON := aItem.AsJSON; 1549 | // result self to permit chain 1550 | Result := Self; 1551 | end; 1552 | 1553 | function TMcJsonItem.Clone: TMcJsonItem; 1554 | var 1555 | aItem: TMcJsonItem; 1556 | begin 1557 | if (Self = nil) then Error(SItemNil, 'clone'); 1558 | // create a new item using self 1559 | aItem := TMcJsonItem.Create(Self); 1560 | // result aItem to permit chain 1561 | Result := aItem; 1562 | end; 1563 | 1564 | function TMcJsonItem.Insert(const aKey: string; aIdx: Integer): TMcJsonItem; 1565 | var 1566 | aItem: TMcJsonItem; 1567 | begin 1568 | if (Self = nil ) then Error(SItemNil, 'insert using key ' + Qot(aKey)); 1569 | if (not isIndexValid(aIdx)) then Error(SIndexInvalid, 'insert index ' + IntToStr(aIdx)); 1570 | // check unset item 1571 | if (fType = jitUnset) then 1572 | fSetType(jitObject); 1573 | // create a new item with aKey and insert it. 1574 | aItem := TMcJsonItem.Create; 1575 | aItem.fKey := aKey; 1576 | if (not Assigned(fChild)) then 1577 | fChild := TList.Create; 1578 | fChild.Insert(aIdx, aItem); 1579 | // result aItem to permit chain 1580 | Result := aItem; 1581 | end; 1582 | 1583 | function TMcJsonItem.Insert(const aItem: TMcJsonItem; aIdx: Integer): TMcJsonItem; 1584 | var 1585 | aNewItem: TMcJsonItem; 1586 | begin 1587 | if (Self = nil ) then Error(SItemNil, 'insert using item'); 1588 | if (not isIndexValid(aIdx)) then Error(SIndexInvalid, 'insert index ' + IntToStr(aIdx)); 1589 | // check unset item 1590 | if (fType = jitUnset) then 1591 | fSetType(jitObject); 1592 | // check if self is an array 1593 | if (fType <> jitArray) then 1594 | Error(SItemTypeInvalid, 'array', GetTypeStr); 1595 | // create a new item copy of aItem and insert it. 1596 | aNewItem := TMcJsonItem.Create(aItem); 1597 | // insert item. 1598 | if (not Assigned(fChild)) then 1599 | fChild := TList.Create; 1600 | fChild.Insert(aIdx, aNewItem); 1601 | // result aNewItem to permit chain 1602 | Result := aNewItem; 1603 | end; 1604 | 1605 | function TMcJsonItem.Delete(aIdx: Integer): Boolean; 1606 | var 1607 | Size: Integer; 1608 | aItemDel: TMcJsonItem; 1609 | Ans: Boolean; 1610 | begin 1611 | Ans := False; 1612 | if (Self = nil) then Error(SItemNil, 'delete index ' + IntToStr(aIdx)); 1613 | // check idx and size 1614 | Size := fChild.Count; 1615 | if (not isIndexValid(aIdx)) or (Size <= 0) then 1616 | Ans := False 1617 | else 1618 | begin 1619 | // item to delete 1620 | aItemDel := TMcJsonItem(fChild[aIdx]); 1621 | // delete position and free memory. 1622 | if (aItemDel <> nil) then 1623 | begin 1624 | fChild.Delete(aIdx); 1625 | aItemDel.Free; 1626 | Ans := True; 1627 | end; 1628 | end; 1629 | Result := Ans; 1630 | end; 1631 | 1632 | function TMcJsonItem.Delete(const aKey: string): Boolean; 1633 | var 1634 | Ans: Boolean; 1635 | idx: Integer; 1636 | begin 1637 | Ans := False; 1638 | if (Self = nil) then Error(SItemNil, 'delete key ' + Qot(aKey)); 1639 | // find index of item with aKey 1640 | idx := Self.IndexOf(aKey); 1641 | if (idx >= 0) then 1642 | Ans := Self.Delete(idx); 1643 | Result := Ans; 1644 | end; 1645 | 1646 | function TMcJsonItem.HasKey(const aKey: string): Boolean; 1647 | begin 1648 | if (Self = nil) then Error(SItemNil, 'has key ' + Qot(aKey)); 1649 | // find index of item with aKey 1650 | Result := ( Self.IndexOf(aKey) >= 0 ); 1651 | end; 1652 | 1653 | function TMcJsonItem.IsEqual(const aItem: TMcJsonItem): Boolean; 1654 | begin 1655 | Result := False; 1656 | if (Self = nil) then Error(SItemNil, 'is equal item'); 1657 | if (aItem <> nil) then 1658 | Result := (Self.AsJSON = aItem.AsJSON); 1659 | end; 1660 | 1661 | function TMcJsonItem.Check(const aStr: string; aSpeed: Boolean): Boolean; 1662 | var 1663 | aItem: TMcJsonItem; 1664 | begin 1665 | if (Self = nil) then Error(SItemNil, 'check'); 1666 | aItem := TMcJsonItem.Create; 1667 | try 1668 | try 1669 | aItem.parse(aStr, aSpeed); 1670 | Result := (aItem.AsJSON = trimWS(aStr)); 1671 | except 1672 | Result := False; 1673 | end; 1674 | finally 1675 | aItem.Free; 1676 | end; 1677 | end; 1678 | 1679 | function TMcJsonItem.CheckException(const aStr: string; aSpeed: Boolean): Boolean; 1680 | var 1681 | aItem: TMcJsonItem; 1682 | begin 1683 | if (Self = nil) then Error(SItemNil, 'check exception'); 1684 | aItem := TMcJsonItem.Create; 1685 | try 1686 | aItem.parse(aStr, aSpeed); 1687 | Result := (aItem.AsJSON = trimWS(aStr)); 1688 | finally 1689 | aItem.Free; 1690 | end; 1691 | end; 1692 | 1693 | function TMcJsonItem.CountItems: Integer; 1694 | 1695 | function CountItemsRec(const aItem: TMcJsonItem): Integer; 1696 | var 1697 | i, sum: Integer; 1698 | begin 1699 | sum := aItem.Count; 1700 | for i := 0 to aItem.Count-1 do 1701 | sum := sum + CountItemsRec( TMcJsonItem(aItem.fChild[i]) ); 1702 | Result := sum; 1703 | end; 1704 | 1705 | begin 1706 | Result := CountItemsRec(Self); 1707 | end; 1708 | 1709 | function TMcJsonItem.At(aIdx: Integer; const aKey: string): TMcJsonItem; 1710 | var 1711 | aItem: TMcJsonItem; 1712 | begin 1713 | // get by index 1714 | aItem := fGetItemByIdx(aIdx); 1715 | // get by key 1716 | if ((aKey <> '') and (aItem <> nil)) then 1717 | aItem := aItem.fGetItemByKey(aKey); 1718 | Result := aItem; 1719 | end; 1720 | 1721 | function TMcJsonItem.At(const aKey: string; aIdx: Integer): TMcJsonItem; 1722 | var 1723 | aItem: TMcJsonItem; 1724 | begin 1725 | // get by key 1726 | aItem := fGetItemByKey(aKey); 1727 | // get by index 1728 | if ((aIdx >= 0) and (aItem <> nil)) then 1729 | aItem := aItem.fGetItemByIdx(aIdx); 1730 | Result := aItem; 1731 | end; 1732 | 1733 | function TMcJsonItem.ToString(aHuman: Boolean): string; 1734 | begin 1735 | Result := sFormat(aHuman); 1736 | end; 1737 | 1738 | function TMcJsonItem.Minify(const aCode: string): string; 1739 | begin 1740 | Result := trimWS(aCode); 1741 | end; 1742 | 1743 | procedure TMcJsonItem.LoadFromStream(Stream: TStream; asUTF8: Boolean); 1744 | var 1745 | sCode: AnsiString; 1746 | len : Int64; 1747 | begin 1748 | // check UTF-8 BOM 1749 | Stream.Position := findUtf8BOM(Stream); 1750 | // dimention and read stream to string 1751 | len := Stream.Size - Stream.Position; 1752 | sCode := ''; 1753 | SetLength(sCode, len); 1754 | Stream.Read(Pointer(sCode)^, len); 1755 | // asUTF8 has difference in behavior in Delphi(true)/Lazarus(false). 1756 | if (asUTF8) 1757 | then Self.AsJSON := Utf8ToAnsi(sCode) // UTF-8 to ANSI 1758 | else Self.AsJSON := string(sCode); // keep as read 1759 | end; 1760 | 1761 | procedure TMcJsonItem.SaveToStream(Stream: TStream; asHuman, asUTF8: Boolean); 1762 | var 1763 | sCode: UTF8String; 1764 | len : Int64; 1765 | begin 1766 | sCode := UTF8String(Self.ToString(asHuman)); // Why UTF8String cast? See W1057. 1767 | // asUTF8 has difference in behavior in Delphi(true)/Lazarus(false). 1768 | if (asUTF8) then 1769 | sCode := AnsiToUtf8(string(sCode)); // Why string cast? See W1057. 1770 | len := Length(sCode); 1771 | Stream.Write(Pointer(sCode)^, len); 1772 | end; 1773 | 1774 | procedure TMcJsonItem.LoadFromFile(const aFileName: string; asUTF8: Boolean); 1775 | var 1776 | fileStream: TFileStream; 1777 | begin 1778 | fileStream := nil; 1779 | try 1780 | fileStream := TFileStream.Create(aFileName, fmOpenRead or fmShareDenyWrite); 1781 | Clear; 1782 | LoadFromStream(fileStream, asUTF8); 1783 | finally 1784 | fileStream.Free; 1785 | end; 1786 | end; 1787 | 1788 | procedure TMcJsonItem.SaveToFile(const aFileName: string; asHuman, asUTF8: Boolean); 1789 | var 1790 | fileStream: TFileStream; 1791 | begin 1792 | fileStream := nil; 1793 | try 1794 | fileStream := TFileStream.Create(aFileName, fmCreate or fmShareDenyWrite); 1795 | SaveToStream(fileStream, asHuman, asUTF8); 1796 | finally 1797 | fileStream.Free; 1798 | end; 1799 | end; 1800 | 1801 | function TMcJsonItem.GetEnumerator: TMcJsonItemEnumerator; 1802 | var 1803 | enum: TMcJsonItemEnumerator; 1804 | begin 1805 | enum := TMcJsonItemEnumerator.Create(Self); 1806 | Result := enum; 1807 | end; 1808 | 1809 | function TMcJsonItem.GetTypeStr: string; 1810 | begin 1811 | if (Self = nil) then Error(SItemNil, 'get type description'); 1812 | Result := GetItemTypeStr(Self.fType); 1813 | end; 1814 | 1815 | function TMcJsonItem.GetValueStr: string; 1816 | begin 1817 | if (Self = nil) then Error(SItemNil, 'get value type description'); 1818 | Result := GetValueTypeStr(Self.fValType); 1819 | end; 1820 | 1821 | function TMcJsonItem.Qot(const aMsg: string): string; 1822 | begin 1823 | Result := '"' + aMsg + '"'; 1824 | end; 1825 | 1826 | function TMcJsonItem.QotKey(const aKey: string): string; 1827 | begin 1828 | Result := ''; 1829 | if (aKey = C_EMPTY_KEY) 1830 | then Result := Qot('') 1831 | else Result := Qot(aKey); 1832 | end; 1833 | 1834 | procedure TMcJsonItem.Error(const Msg: string; const S1: string; 1835 | const S2: string; 1836 | const S3: string); 1837 | var 1838 | aStr: string; 1839 | begin 1840 | aStr := Format(Msg, [S1, S2, S3]); 1841 | raise EMcJsonException.Create(aStr); 1842 | end; 1843 | 1844 | { ---------------------------------------------------------------------------- } 1845 | { TMcJsonItemEnumerator } 1846 | { ---------------------------------------------------------------------------- } 1847 | 1848 | constructor TMcJsonItemEnumerator.Create(aItem: TMcJsonItem); 1849 | begin 1850 | fItem := aItem; 1851 | FIndex := -1; 1852 | end; 1853 | 1854 | function TMcJsonItemEnumerator.GetCurrent: TMcJsonItem; 1855 | begin 1856 | if (not Assigned(fItem.fChild) ) then Result := nil 1857 | else if (fIndex < 0 ) then Result := nil 1858 | else if (fIndex < fItem.fChild.Count) then Result := TMcJsonItem(fItem.fChild[fIndex]) 1859 | else Result := nil; 1860 | end; 1861 | 1862 | function TMcJsonItemEnumerator.MoveNext: Boolean; 1863 | begin 1864 | Inc(fIndex); 1865 | if (fItem.fChild = nil) 1866 | then Result := False 1867 | else Result := (fIndex < fItem.fChild.Count); 1868 | end; 1869 | 1870 | { ---------------------------------------------------------------------------- } 1871 | { Auxiliary public functions } 1872 | { ---------------------------------------------------------------------------- } 1873 | function GetItemTypeStr(aType: TJItemType): string; 1874 | begin 1875 | Result := 'unknown'; 1876 | case aType of 1877 | jitValue : Result := 'value' ; 1878 | jitObject: Result := 'object'; 1879 | jitArray : Result := 'array' ; 1880 | jitUnset : Result := 'unset' ; 1881 | end; 1882 | end; 1883 | 1884 | function GetValueTypeStr(aType: TJValueType): string; 1885 | begin 1886 | Result := 'unknown'; 1887 | case aType of 1888 | jvtString : Result := 'string' ; 1889 | jvtNumber : Result := 'number' ; 1890 | jvtBoolean: Result := 'boolean'; 1891 | jvtNull : Result := 'null' ; 1892 | end; 1893 | end; 1894 | 1895 | function McJsonEscapeString(const aStr: string; aEsc: TJEscapeType): string; 1896 | var 1897 | i, len: Integer; 1898 | c: Char; 1899 | begin 1900 | Result := ''; 1901 | len := Length(aStr); 1902 | for i := 1 to len do 1903 | begin 1904 | c := aStr[i]; 1905 | case c of 1906 | ID_BACKSPACE: Result := Result + CHAR_ESCAPE + CHAR_BACKSPACE; 1907 | ID_H_TAB : Result := Result + CHAR_ESCAPE + CHAR_H_TAB ; 1908 | ID_NEW_LINE : Result := Result + CHAR_ESCAPE + CHAR_NEW_LINE ; 1909 | ID_FORM_FEED: Result := Result + CHAR_ESCAPE + CHAR_FORM_FEED; 1910 | ID_C_RETURN : Result := Result + CHAR_ESCAPE + CHAR_C_RETURN ; 1911 | ID_Q_MARK : Result := Result + CHAR_ESCAPE + CHAR_Q_MARK ; 1912 | ID_R_SOLIDUS: Result := Result + CHAR_ESCAPE + CHAR_R_SOLIDUS; 1913 | ID_SOLIDUS : if (aEsc >= jetStrict) 1914 | then Result := Result + CHAR_ESCAPE + CHAR_SOLIDUS 1915 | else Result := Result + c; 1916 | else 1917 | begin 1918 | if ( (aEsc >= jetUnicode) and 1919 | ((Integer(c) < 32) or 1920 | (Integer(c) > 126)) ) then // \uXXXX 1921 | Result := Result + CHAR_ESCAPE + CHAR_U_HEX + IntToHex(Integer(c), 4) 1922 | else 1923 | Result := Result + c; 1924 | end; 1925 | end; 1926 | end; 1927 | end; 1928 | 1929 | function McJsonUnEscapeString(const aStr: string): string; 1930 | var 1931 | cs, cd, len: Integer; 1932 | ndTrim: Boolean; 1933 | ans: string; 1934 | begin 1935 | cs := 1; // char in source 1936 | cd := 1; // char in destiny 1937 | ndTrim := False; // need trim 1938 | len := Length(aStr); 1939 | ans := ''; 1940 | SetLength(ans, len); 1941 | while (cs <= len) do 1942 | begin 1943 | // no escape, copy and move on 1944 | if (aStr[cs] <> '\') then 1945 | begin 1946 | ans[cd] := aStr[cs]; 1947 | Inc(cs); 1948 | Inc(cd); 1949 | end 1950 | // check bad ending escaped. Example: 'a\' -> 'a' 1951 | else if (cs = len) then 1952 | begin 1953 | ndTrim := True; // ignore it 1954 | Inc(cs); 1955 | end 1956 | // there are escapes 1957 | else 1958 | begin 1959 | ndTrim := True; 1960 | // move next to '\' 1961 | Inc(cs); 1962 | // unescape visible escaped chars 1963 | if ((aStr[cs] = CHAR_Q_MARK ) or 1964 | (aStr[cs] = CHAR_SOLIDUS ) or 1965 | (aStr[cs] = CHAR_R_SOLIDUS)) then 1966 | begin 1967 | ans[cd] := aStr[cs]; 1968 | Inc(cd); 1969 | Inc(cs); 1970 | end 1971 | // unescape u+(4 hexa) escaped chars 1972 | else if ( (aStr[cs] = CHAR_U_HEX ) and 1973 | (len-cs >= 4 ) and 1974 | myCharInSet(aStr[cs+1], HEXA) and 1975 | myCharInSet(aStr[cs+2], HEXA) and 1976 | myCharInSet(aStr[cs+3], HEXA) and 1977 | myCharInSet(aStr[cs+4], HEXA) ) then 1978 | begin 1979 | try 1980 | ans[cd] := Chr( StrToInt('$' + Copy(aStr, cs+1, 4)) ); 1981 | Inc(cd); 1982 | except 1983 | ; // invalid hexa, ignore and move on 1984 | end; 1985 | Inc(cs, 5); // uXXXX 1986 | end 1987 | // unescape other "invisible" escaped chars 1988 | else 1989 | begin 1990 | case aStr[cs] of 1991 | CHAR_BACKSPACE: ans[cd] := ID_BACKSPACE; 1992 | CHAR_H_TAB : ans[cd] := ID_H_TAB ; 1993 | CHAR_NEW_LINE : ans[cd] := ID_NEW_LINE ; 1994 | CHAR_FORM_FEED: ans[cd] := ID_FORM_FEED; 1995 | CHAR_C_RETURN : ans[cd] := ID_C_RETURN ; 1996 | end; 1997 | Inc(cd); 1998 | Inc(cs); 1999 | end; 2000 | end 2001 | end; 2002 | // trim extra size 2003 | if (ndTrim) then 2004 | SetLength(ans, cd-1); 2005 | // return the string unescaped 2006 | Result := ans; 2007 | end; 2008 | 2009 | end. 2010 | -------------------------------------------------------------------------------- /test/PrjTestMcJSON.dpr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hydrobyte/McJSON/0280d8b648f1b794cbf701018fc9a67d47915b64/test/PrjTestMcJSON.dpr -------------------------------------------------------------------------------- /test/PrjTestMcJSON.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | <UseAppBundle Value="False"/> 15 | <ResourceType Value="res"/> 16 | </General> 17 | <BuildModes> 18 | <Item Name="Default" Default="True"/> 19 | <Item Name="Debug"> 20 | <CompilerOptions> 21 | <Version Value="11"/> 22 | <PathDelim Value="\"/> 23 | <Target> 24 | <Filename Value="PrjTestMcJSON"/> 25 | </Target> 26 | <SearchPaths> 27 | <IncludeFiles Value="$(ProjOutDir)"/> 28 | <OtherUnitFiles Value="..\src"/> 29 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 30 | </SearchPaths> 31 | <Parsing> 32 | <SyntaxOptions> 33 | <IncludeAssertionCode Value="True"/> 34 | </SyntaxOptions> 35 | </Parsing> 36 | <CodeGeneration> 37 | <Checks> 38 | <IOChecks Value="True"/> 39 | <RangeChecks Value="True"/> 40 | <OverflowChecks Value="True"/> 41 | <StackChecks Value="True"/> 42 | </Checks> 43 | <VerifyObjMethodCallValidity Value="True"/> 44 | </CodeGeneration> 45 | <Linking> 46 | <Debugging> 47 | <DebugInfoType Value="dsDwarf3"/> 48 | <UseHeaptrc Value="True"/> 49 | <TrashVariables Value="True"/> 50 | <UseExternalDbgSyms Value="True"/> 51 | </Debugging> 52 | </Linking> 53 | </CompilerOptions> 54 | </Item> 55 | <Item Name="Release"> 56 | <CompilerOptions> 57 | <Version Value="11"/> 58 | <PathDelim Value="\"/> 59 | <Target> 60 | <Filename Value="PrjTestMcJSON"/> 61 | </Target> 62 | <SearchPaths> 63 | <IncludeFiles Value="$(ProjOutDir)"/> 64 | <OtherUnitFiles Value="..\src"/> 65 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 66 | </SearchPaths> 67 | <CodeGeneration> 68 | <SmartLinkUnit Value="True"/> 69 | <Optimizations> 70 | <OptimizationLevel Value="3"/> 71 | </Optimizations> 72 | </CodeGeneration> 73 | <Linking> 74 | <Debugging> 75 | <GenerateDebugInfo Value="False"/> 76 | </Debugging> 77 | <LinkSmart Value="True"/> 78 | </Linking> 79 | </CompilerOptions> 80 | </Item> 81 | <SharedMatrixOptions Count="1"> 82 | <Item1 ID="058240131054" Value="-dDisableUTF8RTL"/> 83 | </SharedMatrixOptions> 84 | </BuildModes> 85 | <PublishOptions> 86 | <Version Value="2"/> 87 | <UseFileFilters Value="True"/> 88 | </PublishOptions> 89 | <RunParams> 90 | <FormatVersion Value="2"/> 91 | </RunParams> 92 | <RequiredPackages> 93 | <Item> 94 | <PackageName Value="LazUtils"/> 95 | </Item> 96 | </RequiredPackages> 97 | <Units> 98 | <Unit> 99 | <Filename Value="PrjTestMcJSON.lpr"/> 100 | <IsPartOfProject Value="True"/> 101 | </Unit> 102 | <Unit> 103 | <Filename Value="..\src\McJSON.pas"/> 104 | <IsPartOfProject Value="True"/> 105 | </Unit> 106 | </Units> 107 | </ProjectOptions> 108 | <CompilerOptions> 109 | <Version Value="11"/> 110 | <PathDelim Value="\"/> 111 | <Target> 112 | <Filename Value="PrjTestMcJSON"/> 113 | </Target> 114 | <SearchPaths> 115 | <IncludeFiles Value="$(ProjOutDir)"/> 116 | <OtherUnitFiles Value="..\src"/> 117 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 118 | </SearchPaths> 119 | <Linking> 120 | <Debugging> 121 | <DebugInfoType Value="dsDwarf2Set"/> 122 | </Debugging> 123 | </Linking> 124 | </CompilerOptions> 125 | <Debugging> 126 | <Exceptions> 127 | <Item> 128 | <Name Value="EAbort"/> 129 | </Item> 130 | <Item> 131 | <Name Value="ECodetoolError"/> 132 | </Item> 133 | <Item> 134 | <Name Value="EFOpenError"/> 135 | </Item> 136 | <Item> 137 | <Name Value="EMcJsonException"/> 138 | </Item> 139 | <Item> 140 | <Name Value="EConvertError"/> 141 | </Item> 142 | </Exceptions> 143 | </Debugging> 144 | </CONFIG> 145 | -------------------------------------------------------------------------------- /test/PrjTestMcJSON.lpr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hydrobyte/McJSON/0280d8b648f1b794cbf701018fc9a67d47915b64/test/PrjTestMcJSON.lpr -------------------------------------------------------------------------------- /test/test13-Ansi.json: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hydrobyte/McJSON/0280d8b648f1b794cbf701018fc9a67d47915b64/test/test13-Ansi.json -------------------------------------------------------------------------------- /test/test13-UTF8-BOM.json: -------------------------------------------------------------------------------- 1 | {"utf8":"ãçüö"} -------------------------------------------------------------------------------- /test/test13-UTF8.json: -------------------------------------------------------------------------------- 1 | {"utf8":"ãçüö"} -------------------------------------------------------------------------------- /test/test13.json: -------------------------------------------------------------------------------- 1 | {"i":123,"array":[{"k1":"ç1"},{"k2":"ç2"}]} -------------------------------------------------------------------------------- /test/test99.json: -------------------------------------------------------------------------------- 1 | { 2 | "key1": 1, 3 | "key2": true, 4 | "key3": 1.234, 5 | "key4": "value 1", 6 | "array": [ 7 | 1, 8 | 2, 9 | 3 10 | ] 11 | } --------------------------------------------------------------------------------