json.pas

delphi2009 json 单元,了解delphi2009 json 的实现过程

          end;
          Inc(tok.st_pos);
        end;

        json_tokener_state_comment_start:
        begin
          if (c = '*') then
          begin
            TokRec^.state := json_tokener_state_comment;
          end else
          if (c = '/') then
          begin
            TokRec^.state := json_tokener_state_comment_eol;
          end else
          begin
            tok.err := json_tokener_error_parse_comment;
            goto out;
          end;
          tok.pb.Append(@c, 1);
        end;

        json_tokener_state_comment:
        begin
          if (c = '*') then
            TokRec^.state := json_tokener_state_comment_end;
          tok.pb.Append(@c, 1);
        end;

        json_tokener_state_comment_eol:
        begin
          if (c = #10) then
          begin
            //mc_debug("json_tokener_comment: %s\n", tok.pb.buf);
            TokRec^.state := json_tokener_state_eatws;
          end else
          begin
            tok.pb.Append(@c, 1);
          end;
        end;

        json_tokener_state_comment_end:
        begin
          tok.pb.Append(@c, 1);
          if (c = '/') then
          begin
            //mc_debug("json_tokener_comment: %s\n", tok.pb.buf);
            TokRec^.state := json_tokener_state_eatws;
          end else
          begin
            TokRec^.state := json_tokener_state_comment;
          end;
        end;

        json_tokener_state_string:
        begin
          if (c = tok.quote_char) then
          begin
            TokRec^.current     := TJsonObject.Create(tok.pb.Fbuf);
            TokRec^.saved_state := json_tokener_state_finish;
            TokRec^.state       := json_tokener_state_eatws;
          end else
          if (c = '\') then
          begin
            TokRec^.saved_state := json_tokener_state_string;
            TokRec^.state       := json_tokener_state_string_escape;
          end else
          begin
            tok.pb.Append(@c, 1);
          end;
        end;
{$IFDEF JSON_EXTENDED_SYNTAX}
        json_tokener_state_unquoted_string:
        begin
          if not (c in alphanum) then
          begin
            TokRec^.current     := TJsonObject.Create(tok.pb.Fbuf);
            TokRec^.saved_state := json_tokener_state_finish;
            TokRec^.state       := json_tokener_state_eatws;
            goto redo_char;
          end else
          begin
            tok.pb.Append(@c, 1);
          end;
        end;
{$ENDIF}

        json_tokener_state_string_escape:
          case c of
            '"',
            '\',
            '/':
            begin
              tok.pb.Append(@c, 1);
              TokRec^.state := TokRec^.saved_state;
            end;
            'b',
            'n',
            'r',
            't':
            begin
              if (c = 'b') then
                tok.pb.Append(#8, 1)
              else if (c = 'n') then
                tok.pb.Append(#10, 1)
              else if (c = 'r') then
                tok.pb.Append(#13, 1)
              else if (c = 't') then
                tok.pb.Append(#9, 1);
              TokRec^.state := TokRec^.saved_state;
            end;
            'u':
            begin
              tok.ucs_char  := 0;
              tok.st_pos    := 0;
              TokRec^.state := json_tokener_state_escape_unicode;
            end;
            else
              tok.err := json_tokener_error_parse_string;
              goto out;
          end;

        json_tokener_state_escape_unicode:
        begin
          if (c in json_hex_chars_set) then
          begin
            Inc(tok.ucs_char, (cardinal(hexdigit(c)) shl ((3 - tok.st_pos) * 4)));
            Inc(tok.st_pos);
            if (tok.st_pos = 4) then
            begin
              if (tok.ucs_char < $80) then
              begin
                utf_out[0] := tok.ucs_char;
                tok.pb.Append(@utf_out, 1);
              end else
              if (tok.ucs_char < $800) then
              begin
                utf_out[0] := $c0 or (tok.ucs_char shr 6);
                utf_out[1] := $80 or (tok.ucs_char and $3f);
                tok.pb.Append(@utf_out, 2);
              end else
              begin
                utf_out[0] := $e0 or (tok.ucs_char shr 12);
                utf_out[1] := $80 or ((tok.ucs_char shr 6) and $3f);
                utf_out[2] := $80 or (tok.ucs_char and $3f);
                tok.pb.Append(@utf_out, 3);
              end;
              TokRec^.state := TokRec^.saved_state;
            end;
          end else
          begin
            tok.err := json_tokener_error_parse_string;
            goto out;
          end;
        end;

        json_tokener_state_boolean:
        begin
          tok.pb.Append(@c, 1);
          if (StrLComp('true', tok.pb.FBuf, min(tok.st_pos + 1, 4)) = 0) then
          begin
            if (tok.st_pos = 4) then
{$IFDEF JSON_EXTENDED_SYNTAX}
              if (c in alphanum) then
                TokRec^.state := json_tokener_state_unquoted_string
              else
{$ENDIF}
              begin
                TokRec^.current     := TJsonObject.Create(True);
                TokRec^.saved_state := json_tokener_state_finish;
                TokRec^.state       := json_tokener_state_eatws;
                goto redo_char;
              end;
          end else
          if (StrLComp('false', tok.pb.FBuf, min(tok.st_pos + 1, 5)) = 0) then
          begin
            if (tok.st_pos = 5) then
{$IFDEF JSON_EXTENDED_SYNTAX}
              if (c in alphanum) then
                TokRec^.state := json_tokener_state_unquoted_string
              else
{$ENDIF}
              begin
                TokRec^.current     := TJsonObject.Create(False);
                TokRec^.saved_state := json_tokener_state_finish;
                TokRec^.state       := json_tokener_state_eatws;
                goto redo_char;
              end;
          end else
          begin
{$IFDEF JSON_EXTENDED_SYNTAX}
            TokRec^.state           := json_tokener_state_unquoted_string;
            tok.pb.FBuf[tok.st_pos] := #0;
            Dec(tok.pb.FBPos);
            goto redo_char;
{$ELSE}
          tok.err := json_tokener_error_parse_boolean;
          goto out;
{$ENDIF}
          end;
          Inc(tok.st_pos);
        end;

        json_tokener_state_number:
        begin
          if (c in json_number_chars_set) then
          begin
            tok.pb.Append(@c, 1);
            if (c in ['.', 'e']) then
              tok.is_double := 1;
          end else
          begin
            if (tok.is_double = 0) then
            begin
              val(tok.pb.FBuf, numi, code);
              TokRec^.current := TJsonObject.Create(numi);
            end else
            if (tok.is_double <> 0) then
            begin
              val(tok.pb.FBuf, numd, code);
              TokRec^.current := TJsonObject.Create(numd);
            end else
            begin
              tok.err := json_tokener_error_parse_number;
              goto out;
            end;
            TokRec^.saved_state := json_tokener_state_finish;
            TokRec^.state       := json_tokener_state_eatws;
            goto redo_char;
          end;
        end;

        json_tokener_state_array:
        begin
          if (c = ']') then
          begin
            TokRec^.saved_state := json_tokener_state_finish;
            TokRec^.state       := json_tokener_state_eatws;
          end else
          begin
            if (tok.depth >= JSON_TOKENER_MAX_DEPTH - 1) then
            begin
              tok.err := json_tokener_error_depth;
              goto out;
            end;
            TokRec^.state := json_tokener_state_array_add;
            Inc(tok.depth);
            tok.ResetLevel(tok.depth);
            TokRec := @tok.stack[tok.depth];
            goto redo_char;
          end;
        end;

        json_tokener_state_array_add:
        begin
          TokRec^.current.AsArray.Add(obj);
          TokRec^.saved_state := json_tokener_state_array_sep;
          TokRec^.state       := json_tokener_state_eatws;
          goto redo_char;
        end;

        json_tokener_state_array_sep:
        begin
          if (c = ']') then
          begin
            TokRec^.saved_state := json_tokener_state_finish;
            TokRec^.state       := json_tokener_state_eatws;
          end else
          if (c = ',') then
          begin
            TokRec^.saved_state := json_tokener_state_array;
            TokRec^.state       := json_tokener_state_eatws;
          end else
          begin
            tok.err := json_tokener_error_parse_array;
            goto out;
          end;
        end;

        json_tokener_state_object_field_start:
        begin
          if (c = '}') then
          begin
            TokRec^.saved_state := json_tokener_state_finish;
            TokRec^.state       := json_tokener_state_eatws;
          end else
          if (c in ['"', '''']) then
          begin
            tok.quote_char := c;
            tok.pb.Reset;
            TokRec^.state := json_tokener_state_object_field;
          end else
{$IFDEF JSON_EXTENDED_SYNTAX}
          if (c in alpha) then
          begin
            TokRec^.state := json_tokener_state_object_unquoted_field;
            tok.pb.Reset;
            goto redo_char;
          end else
{$ENDIF}
          begin
            tok.err := json_tokener_error_parse_object_key_name;
            goto out;
          end;
        end;

        json_tokener_state_object_field:
        begin
          if (c = tok.quote_char) then
          begin
            TokRec^.obj_field_name := strdup(tok.pb.FBuf);
            TokRec^.saved_state    := json_tokener_state_object_field_end;
            TokRec^.state          := json_tokener_state_eatws;
          end else
          if (c = '\') then
          begin
            TokRec^.saved_state := json_tokener_state_object_field;
            TokRec^.state       := json_tokener_state_string_escape;
          end else
          begin
            tok.pb.Append(@c, 1);
          end;
        end;

{$IFDEF JSON_EXTENDED_SYNTAX}
        json_tokener_state_object_unquoted_field:
        begin
          if not (c in alphanum) then
          begin
            TokRec^.obj_field_name := strdup(tok.pb.FBuf);
            TokRec^.saved_state    := json_tokener_state_object_field_end;
            TokRec^.state          := json_tokener_state_eatws;
            goto redo_char;
          end else
          if (c = '\') then
          begin
            TokRec^.saved_state := json_tokener_state_object_field;
            TokRec^.state       := json_tokener_state_string_escape;
          end else
          begin
            tok.pb.Append(@c, 1);
          end;
        end;
{$ENDIF}

        json_tokener_state_object_field_end:
        begin
          if (c = ':') then
          begin
            TokRec^.saved_state := json_tokener_state_object_value;
            TokRec^.state       := json_tokener_state_eatws;
          end else
          begin
            tok.err := json_tokener_error_parse_object_key_sep;
            goto out;
          end;
        end;

        json_tokener_state_object_value:
        begin
          if (tok.depth >= JSON_TOKENER_MAX_DEPTH - 1) then
          begin
            tok.err := json_tokener_error_depth;
            goto out;
          end;
          TokRec^.state := json_tokener_state_object_value_add;
          Inc(tok.depth);
          tok.ResetLevel(tok.depth);
          TokRec := @tok.stack[tok.depth];
          goto redo_char;
        end;

        json_tokener_state_object_value_add:
        begin
          TokRec^.current.AsObject.Put(TokRec^.obj_field_name, obj);
          FreeMem(TokRec^.obj_field_name);
          TokRec^.obj_field_name := nil;
          TokRec^.saved_state    := json_tokener_state_object_sep;
          TokRec^.state          := json_tokener_state_eatws;
          goto redo_char;
        end;

        json_tokener_state_object_sep:
        begin
          if (c = '}') then
          begin
            TokRec^.saved_state := json_tokener_state_finish;
            TokRec^.state       := json_tokener_state_eatws;
          end else
          if (c = ',') then
          begin
            TokRec^.saved_state := json_tokener_state_object_field_start;
            TokRec^.state       := json_tokener_state_eatws;
          end else
          begin
            tok.err := json_tokener_error_parse_object_value_sep;
            goto out;
          end;
        end;
      end;
    Inc(str);
    Inc(tok.char_offset);
  until c = #0;

  if (TokRec^.state <> json_tokener_state_finish) and
    (TokRec^.saved_state <> json_tokener_state_finish) then
    tok.err := json_tokener_error_parse_eof;

  out:
    if (tok.err = json_tokener_success) then
    begin
      TokRec^.current.AddRef;
      Result := TokRec^.current;
      Exit;
    end;
  //mc_debug("json_tokener_parse_ex: error %s at offset %d\n",
  //json_tokener_errors[tok.err], tok.char_offset);
  Result := nil;
end;

function TJsonObject.SaveTo(stream: TStream; format: boolean): integer;
var
  pb: TJsonWriterStream;
begin
  pb := TJsonWriterStream.Create(stream);
  if (pb.Write(self, format, 0) < 0) then
  begin
    pb.Reset;
    pb.Free;
    Result := 0;
    Exit;
  end;
  Result := stream.Size;
  pb.Free;
end;

function TJsonObject.CalcSize(format: boolean): integer;
var
  pb: TJsonWriterFake;
begin
  pb := TJsonWriterFake.Create;
  if (pb.Write(self, format, 0) < 0) then
  begin
    pb.Free;
    Result := 0;
    Exit;
  end;
  Result := pb.FSize;
  pb.Free;
end;

function TJsonObject.SaveTo(socket: integer; format: boolean): integer;
var
  pb: TJsonWriterSock;
begin
  pb := TJsonWriterSock.Create(socket);
  if (pb.Write(self, format, 0) < 0) then
  begin
    pb.Free;
    Result := 0;
    Exit;