Delphi的JSON库 - DJSON- JSONTokener（下）

Delphi的JSON库 - DJSON- JSONTokener（下）2010-11-07 博客园杨芹勍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;