The JSON Library of Delphi

Delphi Source Code:

{
Copyright (c) 2002 json.org
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "software") to deal
In the Software without restriction, including without limitation the rights
To use, copy, modify, merge, publish, distribute, sublicense, and/or sell
Copies of the Software, and to permit persons to whom the Software is
Furnished to did so, subject to the following conditions:
The above copyright notice and this permission notice shall is included in all
Copies or substantial portions of the Software.
The Software shall is used for good, not Evil.
The SOFTWARE is provided ' as is ', without WARRANTY of any KIND, EXPRESS OR
Implied, including BUT not LIMITED to the warranties of merchantability,
FITNESS for A particular purpose and noninfringement. In NO EVENT SHALL the
AUTHORS or COPYRIGHT holders be liable to any CLAIM, damages or other
Liability, WHETHER in a ACTION of CONTRACT, TORT OR Otherwise, arising from,
Out of or in CONNECTION with the SOFTWARE or the and other dealings in the
SOFTWARE.
}
{
* A jsontokener takes a source string and extracts characters and tokens from
* it. It is used by the Jsonobject and Jsonarray constructors to parse
* JSON source strings.
* @author json.org
* @version 2
}
Unit Jsontokener;
Interface
Uses
Sysutils,
Strutils,
Autoptr,
Jsonexception;
Type
Tjsontokener = Class
Private
Fmyindex:integer;
fmysource:string;
Public
Constructor Create (amysource:string); Virtual
Procedure back;
class function Dehexchar (C:char): Integer;
function More:boolean;
function Next:char; overload;
function Next (C:char): Char; overload;
function Next (N:integer): string; overload;
function SyntaxError (amsg:string): ejsonexception;
function tostring:string; Override
function Nextclean:char;
function nextstring (Quote:char): string;
function NextTo (D:char): string; overload;
function NextTo (delimiters:string): string; overload;
function nextvalue:iautoptr<tobject>;
function Skipto (Toc:char): Char;
function Skippast (tos:string): Boolean;
End
Implementation
Uses
Stringobject,
Booleanobject,
Integerobject,
Longobject,
Doubleobject,
Utils,
Jsonobject,
Jsonarray;
{Tjsontokener}
Procedure Tjsontokener.back;
Begin
If Fmyindex > 0 Then
Dec (Fmyindex);
End
Constructor Tjsontokener.create (amysource:string);
Begin
Inherited Create;
Fmyindex: = 0;
Fmysource: = Amysource;
End
class function Tjsontokener.dehexchar (C:char): Integer;
Begin
if (c >= ' 0 ') and (c <= ' 9 ') then
Exit (Ord (c)-Ord (' 0 '));
if (c >= ' A ') and (c <= ' F ') then
Exit (Ord (c)-(Ord (' A ')-10));
if (c >= ' a ') and (C <= ' F ') then
Exit (Ord (c)-(Ord (' a ')-10));
Result: =-1;
End
function TJSONTokener.More:Boolean;
Begin
Result: = Fmyindex < Length (Fmysource);
End
function Tjsontokener.next (N:integer): string;
Var
I, J:integer;
Begin
I: = Fmyindex;
J: = i + ORD (n);
If J >= Length (Fmysource) Then
Raise SyntaxError (' Substring bounds error ');
Inc. (Fmyindex, N);
Result: = SubString (Fmysource, I, J);
End
function TJSONTokener.NextClean:Char;
Var
C:char;
Begin
While True
Begin
c: = Next;
If Ord (c) = Ord ('/') then
Begin
Case Next of
'/':
Begin
Repeat
c: = Next;
Until (ORD (c) = () or (Ord (c) = ten) or (Ord (c) = 0);
End
'*':
Begin
While True
Begin
c: = Next;
If Ord (c) = 0 Then
Raise SyntaxError (' unclosed comment ');
If Ord (c) = Ord (' * ') then
Begin
If Ord (Next) = Ord ('/') then
break;
back;
End
End
End
ELSE begin
back;
Exit ('/');
End
End
End
else if Ord (c) = Ord (' # ') then
Begin
Repeat
c: = Next;
Until (ORD (c) = () or (Ord (c) = ten) or (Ord (c) = 0);
End
else if (Ord (c) = 0) or (ORD (c) > Ord (")") Then
Begin
Exit (c);
End
End
End
function tjsontokener.nextstring (Quote:char): string;
Var
C:char;
Begin
While True
Begin
c: = Next;
Case C of
#0, #13, #10:
Begin
Raise SyntaxError (' unterminated string ');
End
#92://' \ \ '
Begin
c: = Next;
Case C of
' B ': result: = result + #8;
' t ': result: = result + #9;
' n ': Result: = result + #10;
' F ': result: = result + #12;
' R ': Result: = result + #13;
' U ': result: = result + Char (strtoint (' $ ' + Next (4));
' x ': Result: = result + Char (strtoint (' $ ' + Next (2));
ELSE begin
Result: = result + C;
End
End
End
ELSE begin
If Ord (c) = Ord (quote) Then
Exit;
Result: = result + C;
End
End
End
End
function Tjsontokener.nextto (delimiters:string): string;
Var
C:char;
Begin
While True
Begin
c: = Next;
if (Pos (c, delimiters) >= 1) or (ORD (c) = 0) or
(Ord (c) = () or (Ord (c) = ten) Then
Begin
If Ord (c) <> 0 Then
break;
Exit (Trim (result));
End
Result: = result + C;
End
End
function tjsontokener.nextvalue:iautoptr<tobject>;
Var
C, B:char;
S, sb:string;
Begin
c: = Nextclean;
Case C of
' ', ', ': Exit (TAUTOPTR&LT;TOBJECT&GT;. New (Tstringobject.create (nextstring (c)));
'{':
Begin
back;
Exit (TAUTOPTR&LT;TOBJECT&GT;. New (Tjsonobject.create (Self));
End
'[', '(':
Begin
back;
Exit (TAUTOPTR&LT;TOBJECT&GT;. New (Tjsonarray.create (Self));
End
End
{
/*
* Handle unquoted text. This could is the values true, false, or
* NULL, or it can be a number. An implementation (such as this one)
* is allowed to also accept non-standard forms.
*
* Accumulate characters until we reach the "end of" the text or a
* Formatting character.
*/
}
b: = C;
while (Ord (c) >= Ord (")) and (Pos (C, ',:]}/\" [{; =# ') < 1] Do
Begin
SB: = SB + C;
c: = Next;
End
back;
If It is true, false, or NULL, return the proper value.
S: = Trim (SB);
If Length (s) = 0 Then
Raise SyntaxError (' Missing value ');
If lowercase (s) = ' true ' Then
Exit (TAUTOPTR&LT;TOBJECT&GT;. New (tbooleanobject.true));
If lowercase (s) = ' false ' Then
Exit (TAUTOPTR&LT;TOBJECT&GT;. New (Tbooleanobject.false));
If lowercase (s) = ' null ' Then
Exit (TAUTOPTR&LT;TOBJECT&GT;. New (Tjsonobject.null));
{
/*
* If It might be a number, try converting it. We support the 0-and 0x-
* conventions. If A number cannot be produced, then the value would just
* Be a string. The 0-, 0x-, plus, and implied string
* Conventions are non-standard. A JSON parser are free to accept
* Non-json forms as long as it accepts all correct JSON forms.
*/
}
if ((Ord (b) >= Ord (' 0 ')) and (Ord (b) <= Ord (' 9 '))
or (Ord (b) = Ord ('. '))
or (Ord (b) = Ord ('-'))
or (Ord (b) = Ord (' + ')) then
Begin
If Ord (b) = Ord (' 0 ') then
Begin
if (Length (s) > 2) and ((s[2] = ' x ') or (s[2] = ' x ') then
Begin
Try
Exit (TAUTOPTR&LT;TOBJECT&GT;. New (Tintegerobject.create (
Strtoint (' $ ' + SubString (S, 2))));
Except
Ignore the error
End
End
Else
Begin
Try
Exit (TAUTOPTR&LT;TOBJECT&GT;. New (Tintegerobject.create (
Utils.base8 (s)));
Except
End
End
End
Try
Exit (TAUTOPTR&LT;TOBJECT&GT;. New (Tintegerobject.create (
Strtoint (s)));
Except
Try
Exit (TAUTOPTR&LT;TOBJECT&GT;. New (Tlongobject.create (
StrToInt64 (s)));
Except
Try
Exit (TAUTOPTR&LT;TOBJECT&GT;. New (Tdoubleobject.create (
Strtofloat (s)));
Except
Exit (TAUTOPTR&LT;TOBJECT&GT;. New (Tstringobject.create (s)));
End
End
End
End
Exit (TAUTOPTR&LT;TOBJECT&GT;. New (Tstringobject.create (s)));
End
function Tjsontokener.nextto (D:char): string;
Var
C:char;
Begin
While True
Begin
c: = Next;
if (Ord (c) = Ord (d)) or (Ord (c) = 0) or (Ord (c) = a) or (Ord (c) = ten) Then
Begin
If Ord (c) <> 0 Then
break;
Exit (Trim (result));
End
Result: = result + C;
End
End
function Tjsontokener.skippast (tos:string): Boolean;
Begin
Fmyindex: = Posex (tos, Fmysource, Fmyindex)-1;
If Fmyindex < 0 Then
Begin
Fmyindex: = Length (Fmysource);
Exit (False);
End
INC (Fmyindex, Length (TOS));
Result: = True;
End
function Tjsontokener.skipto (Toc:char): Char;
Var
C:char;
Index:integer;
Begin
Index: = Fmyindex;
Repeat
c: = Next;
If Ord (c) = 0 Then
Begin
Fmyindex: = index;
Exit (c);
End
Until Ord (c) = Ord (TOC);
back;
Result: = C;
End
function Tjsontokener.syntaxerror (amsg:string): ejsonexception;
Begin
Result: = Ejsonexception.create (amsg + ToString);
End
function TJSONTokener.ToString:string;
Begin
Result: = ' at character ' + inttostr (fmyindex) + ' of ' + fmysource;
End
function Tjsontokener.next (C:char): Char;
Var
N:char;
Begin
N: = Next;
If ORD (n) <> Ord (c) Then
Raise Ejsonexception.create (' expected ' + C + ' ' and instead saw ' + n + ' ');
Result: = N;
End
function TJSONTokener.Next:Char;
Var
C:char;
Begin
If more then
Begin
c: = Fmysource[fmyindex];
INC (Fmyindex);
Exit (c);
End
Result: = #0;
End