Delphi源代碼：
{
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 do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
The Software shall be 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 FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 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 do
begin
c := Next;
if Ord(c) = Ord('/') then
begin
case Next of
'/':
begin
repeat
c := Next;
until (Ord(c) = 13) or (Ord(c) = 10) or (Ord(c) = 0);
end;
'*':
begin
while True do
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) = 13) or (Ord(c) = 10) 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 do
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 do
begin
c := Next;
if (Pos(c, delimiters) >= 1) or (Ord(c) = 0) or
(Ord(c) = 13) or (Ord(c) = 10) 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<TObject>.New(TStringObject.Create(NextString(c))));
'{':
begin
Back;
Exit(TAutoPtr<TObject>.New(TJSONObject.Create(Self)));
end;
'[', '(':
begin
Back;
Exit(TAutoPtr<TObject>.New(TJSONArray.Create(Self)));
end;
end;
{
/*
* Handle unquoted text. This could be 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<TObject>.New(TBooleanObject.TRUE));
if LowerCase(s) = 'false' then
Exit(TAutoPtr<TObject>.New(TBooleanObject.FALSE));
if LowerCase(s) = 'null' then
Exit(TAutoPtr<TObject>.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 will just
* be a string. Note that the 0-, 0x-, plus, and implied string
* conventions are non-standard. A JSON parser is 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<TObject>.New(TIntegerObject.Create(
StrToInt('$' + SubString(s, 2)))));
except
// Ignore the error
end;
end
else
begin
try
Exit(TAutoPtr<TObject>.New(TIntegerObject.Create(
Utils.Base8(s))));
except
end;
end;
end;
try
Exit(TAutoPtr<TObject>.New(TIntegerObject.Create(
StrToInt(s))));
except
try
Exit(TAutoPtr<TObject>.New(TLongObject.Create(
StrToInt64(s))));
except
try
Exit(TAutoPtr<TObject>.New(TDoubleObject.Create(
StrToFloat(s))));
except
Exit(TAutoPtr<TObject>.New(TStringObject.Create(s)));
end;
end;
end;
end;
Exit(TAutoPtr<TObject>.New(TStringObject.Create(s)));
end;
function TJSONTokener.NextTo(d: Char): string;
var
c: Char;
begin
while True do
begin
c := Next;
if (Ord(c) = Ord(d)) or (Ord(c) = 0) or (Ord(c) = 13) or (Ord(c) = 10) 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;
