(原创)Delphi的JSON库-DJSON(1)-JSONTokener

OGeek|极客世界-中国程序员成长平台 › 门户 › 编程›综合其他

原作者: [db:作者] 来自: [db:来源] 收藏邀请

今天开始翻译JSON-RPC。在翻译的过程中，碰到一些语言方面的问题，如：

1、Java支持垃圾回收，Delphi不支持，在此我使用Delphi中的智能指针替代。

2、Java中有Boolean、Integer、Long等类，Delphi没有，我便按照Java的方法分别创建了TBooleanObject、TIntegerObject、TLongObject等类。

3、在C语法和Pascal语法之间切换，头有点疼……

但我已下定决心把DJson做完！

现在用Delphi的人不多，原因有两点：

1、公司管理层的问题。

2、关于Delphi相关成熟的库太少。

既然第一点已经无法挽回，那就让我们在第二点上做努力吧！

首先贴出Java源代码：

}

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