json.pas

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

            begin
              Result := Result and CheckRange(o, p, objpath);
            end;
            else
              if assigned(callback) then
                callback(Sender, veInvalidDataType, objpath);
              Result := False;
          end;
        dtMap:
          case o.JsonType of
            json_type_object:
            begin
              // all objects have and match a rule ?
              ite := TJsonAvlIterator.Create(o.o.c_object);
              try
                ite.First;
                ent := ite.GetIter;
                while ent <> nil do
                begin
                  p2 := FindInheritedField(ent.Name, p);
                  if p2.IsType(json_type_object) then
                    Result :=
                      process(TJsonObject(ent.Obj), p2.o.c_object, objpath + '.' + ent.Name) and Result
                  else
                  begin
                    if assigned(callback) then
                      callback(Sender, veUnexpectedField, objpath + '.' + ent.Name);
                    Result := False; // field have no rule
                  end;
                  ite.Next;
                  ent := ite.GetIter;
                end;
              finally
                ite.Free;
              end;

              // all expected field exists ?
              Result := InheritedFieldExist(o, p, objpath) and Result;
            end;
            json_type_null: {nop};
            else
              Result := False;
              if assigned(callback) then
                callback(Sender, veRuleMalformated, objpath);
          end;
        dtSeq:
          case o.JsonType of
            json_type_array:
            begin
              sequence := FindInheritedProperty('sequence', p);
              if sequence <> nil then
                case sequence.JsonType of
                  json_type_object:
                  begin
                    for i := 0 to o.o.c_array.Length - 1 do
                      Result :=
                        process(o.o.c_array.Get(i), sequence.o.c_object, objpath + '[' +
                        IntToStr(i) + ']') and Result;
                    if getInheritedBool('unique', sequence.o.c_object) then
                    begin
                      // type is unique ?
                      uniquelist := TJsonAvlTree.Create;
                      try
                        for i := 0 to o.o.c_array.Length - 1 do
                        begin
                          s := o.o.c_array.Get(i).AsString;
                          if s <> nil then
                          begin
                            if uniquelist.Search(s) = nil then
                              uniquelist.Insert(TJsonAvlEntry.Create(s, nil))
                            else
                            begin
                              Result := False;
                              if Assigned(callback) then
                                callback(Sender, veDuplicateEntry,
                                  objpath + '[' + IntToStr(i) + ']');
                            end;
                          end;
                        end;
                      finally
                        uniquelist.Free;
                      end;
                    end;

                    // field is unique ?
                    if (GetDataType(sequence.o.c_object) = dtMap) then
                    begin
                      fieldlist := TJsonAvlTree.Create;
                      try
                        GetInheritedFieldList(fieldlist, sequence.o.c_object);
                        ite := TJsonAvlIterator.Create(fieldlist);
                        try
                          ite.First;
                          ent := ite.GetIter;
                          while ent <> nil do
                          begin
                            if getInheritedBool('unique',
                              TJsonObject(ent.Obj).o.c_object) then
                            begin
                              uniquelist := TJsonAvlTree.Create;
                              try
                                for i := 0 to o.o.c_array.Length - 1 do
                                begin
                                  o2 := o.o.c_array.Get(i);
                                  if o2 <> nil then
                                  begin
                                    s := o2.o.c_object.Get(ent.Name).AsString;
                                    if s <> nil then
                                      if uniquelist.Search(s) = nil then
                                        uniquelist.Insert(TJsonAvlEntry.Create(s, nil))
                                      else
                                      begin
                                        Result := False;
                                        if Assigned(callback) then
                                          callback(Sender, veDuplicateEntry,
                                            objpath + '[' + IntToStr(i) + '].' + ent.Name);
                                      end;
                                  end;
                                end;
                              finally
                                uniquelist.Free;
                              end;
                            end;
                            ite.Next;
                            ent := ite.GetIter;
                          end;
                        finally
                          ite.Free;
                        end;
                      finally
                        fieldlist.Free;
                      end;
                    end;

                  end;
                  json_type_null: {nop};
                  else
                    Result := False;
                    if assigned(callback) then
                      callback(Sender, veRuleMalformated, objpath);
                end;
              Result := Result and CheckLength(o.o.c_array.Length, p, objpath);

            end;
            else
              Result := False;
              if assigned(callback) then
                callback(Sender, veRuleMalformated, objpath);
          end;
        dtNumber:
          case o.JsonType of
            json_type_int,
            json_type_double:
            begin
              Result := Result and CheckRange(o, p, objpath);
            end;
            else
              if assigned(callback) then
                callback(Sender, veInvalidDataType, objpath);
              Result := False;
          end;
        dtText:
          case o.JsonType of
            json_type_int,
            json_type_double,
            json_type_string:
            begin
              Result := Result and CheckLength(strlen(o.AsString), p, objpath);
              Result := Result and CheckRange(o, p, objpath);
            end;
            else
              if assigned(callback) then
                callback(Sender, veInvalidDataType, objpath);
              Result := False;
          end;
        dtScalar:
          case o.JsonType of
            json_type_boolean,
            json_type_double,
            json_type_int,
            json_type_string:
            begin
              Result := Result and CheckLength(strlen(o.AsString), p, objpath);
              Result := Result and CheckRange(o, p, objpath);
            end;
            else
              if assigned(callback) then
                callback(Sender, veInvalidDataType, objpath);
              Result := False;
          end;
        dtAny: ;
        else
          if assigned(callback) then
            callback(Sender, veRuleMalformated, objpath);
          Result := False;
      end;
    Result := Result and CheckEnum(o, p, objpath);

  end;

var
  i: integer;

begin
  Result    := False;
  datatypes := TJsonAvlTree.Create;
  names     := TJsonAvlTree.Create;
  try
    datatypes.Insert(TJsonAvlEntry.Create('str', Pointer(dtStr)));
    datatypes.Insert(TJsonAvlEntry.Create('int', Pointer(dtInt)));
    datatypes.Insert(TJsonAvlEntry.Create('float', Pointer(dtFloat)));
    datatypes.Insert(TJsonAvlEntry.Create('number', Pointer(dtNumber)));
    datatypes.Insert(TJsonAvlEntry.Create('text', Pointer(dtText)));
    datatypes.Insert(TJsonAvlEntry.Create('bool', Pointer(dtBool)));
    datatypes.Insert(TJsonAvlEntry.Create('map', Pointer(dtMap)));
    datatypes.Insert(TJsonAvlEntry.Create('seq', Pointer(dtSeq)));
    datatypes.Insert(TJsonAvlEntry.Create('scalar', Pointer(dtScalar)));
    datatypes.Insert(TJsonAvlEntry.Create('any', Pointer(dtAny)));

    if defs.IsType(json_type_array) then
      for i := 0 to defs.o.c_array.Length - 1 do
        if defs.o.c_array[i].IsType(json_type_object) then
          GetNames(defs.o.c_array[i].o.c_object)
        else
        begin
          if assigned(callback) then
            callback(Sender, veRuleMalformated, '');
          Exit;
        end;


    if rules.IsType(json_type_object) then
      GetNames(rules.AsObject)
    else
    begin
      if assigned(callback) then
        callback(Sender, veRuleMalformated, '');
      Exit;
    end;

    Result := process(self, rules.AsObject);

  finally
    datatypes.Free;
    names.Free;
  end;
end;


function TJsonObject.Compare(obj: TJsonObject): TJsonCompareResult;

  function GetIntCompResult(const i: int64): TJsonCompareResult;
  begin
    if i < 0 then
      Result := cpLess
    else
    if i = 0 then
      Result := cpEqu
    else
      Result := cpGreat;
  end;

  function GetDblCompResult(const d: double): TJsonCompareResult;
  begin
    if d < 0 then
      Result := cpLess
    else
    if d = 0 then
      Result := cpEqu
    else
      Result := cpGreat;
  end;

begin
  case jsontype of
    json_type_boolean:
      case obj.jsontype of
        json_type_boolean: Result :=
            GetIntCompResult(Ord(o.c_boolean) - Ord(obj.o.c_boolean));
        json_type_double: Result  := GetDblCompResult(Ord(o.c_boolean) - obj.o.c_double);
        json_type_int: Result     := GetIntCompResult(Ord(o.c_boolean) - obj.o.c_int);
        json_type_string: Result  := GetIntCompResult(StrComp(AsString, obj.AsString));
        else
          Result := cpError;
      end;
    json_type_double:
      case obj.jsontype of
        json_type_boolean: Result := GetDblCompResult(o.c_double - Ord(obj.o.c_boolean));
        json_type_double: Result  := GetDblCompResult(o.c_double - obj.o.c_double);
        json_type_int: Result     := GetDblCompResult(o.c_double - obj.o.c_int);
        json_type_string: Result  := GetIntCompResult(StrComp(AsString, obj.AsString));
        else
          Result := cpError;
      end;
    json_type_int:
      case obj.jsontype of
        json_type_boolean: Result := GetIntCompResult(o.c_int - Ord(obj.o.c_boolean));
        json_type_double: Result  := GetDblCompResult(o.c_int - obj.o.c_double);
        json_type_int: Result     := GetIntCompResult(o.c_int - obj.o.c_int);
        json_type_string: Result  := GetIntCompResult(StrComp(AsString, obj.AsString));
        else
          Result := cpError;
      end;
    json_type_string:
      case obj.jsontype of
        json_type_boolean,
        json_type_double,
        json_type_int,
        json_type_string: Result := GetIntCompResult(StrComp(AsString, obj.AsString));
        else
          Result := cpError;
      end;
    else
      Result := cpError;
  end;
end;

{ TJsonArray }

function TJsonArray.Add(Data: TJsonObject): integer;
begin
  Result := FLength;
  Put(Result, Data);
end;

constructor TJsonArray.Create;
begin
  inherited Create;
  FSize   := JSON_ARRAY_LIST_DEFAULT_SIZE;
  FLength := 0;
  GetMem(FArray, sizeof(Pointer) * FSize);
  FillChar(FArray^, sizeof(Pointer) * FSize, 0);
end;

destructor TJsonArray.Destroy;
var
  i: integer;
begin
  for i := 0 to FLength - 1 do
    if FArray^[i] <> nil then
      FArray^[i].Release;
  FreeMem(FArray);
  inherited;
end;

function TJsonArray.Expand(max: integer): integer;
var
  new_size: integer;
begin
  if (max < FSize) then
  begin
    Result := 0;
    Exit;
  end;
  if max < FSize shl 1 then
    new_size := FSize shl 1
  else
    new_size := max;
  ReallocMem(FArray, new_size * sizeof(Pointer));

  FillChar(
    Pointer(PtrInt(FArray) + (FSize * sizeof(Pointer)))^,
    ((new_size - FSize) * sizeof(Pointer)),
    0);
  FSize  := new_size;
  Result := 0;
end;

function TJsonArray.Get(i: integer): TJsonObject;
begin
  if (i >= FLength) then
    Result := nil
  else
    Result := FArray^[i];
end;

procedure TJsonArray.Put(i: integer; Data: TJsonObject);
begin
  if (Expand(i) <> 0) then
    Exit;
  if (FArray^[i] <> nil) then
    TJsonObject(FArray^[i]).Release;
  FArray^[i] := Data;
  if (FLength <= i) then
    FLength := i + 1;
end;

{ TJsonWriterString }

function TJsonWriterString.Append(buf: PChar; Size: integer): integer;

  function max(a, b: integer): integer;
  begin
    if a > b then
      Result := a
    else
      Result := b;
  end;

begin
  Result := size;
  if Size > 0 then
  begin
    if (FSize - FBPos <= size) then
    begin
      FSize := max(FSize * 2, FBPos + size + 8);
      ReallocMem(FBuf, FSize);
    end;
    // fast move
    case size of
      1: FBuf[FBPos]           := buf^;
      2: PWord(@FBuf[FBPos])^  := PWord(buf)^;
      4: PInteger(@FBuf[FBPos])^ := PInteger(buf)^;
      8: PInt64(@FBuf[FBPos])^ := PInt64(buf)^;
      else
        move(buf^, FBuf[FBPos], size);
    end;
    Inc(FBPos, size);
    FBuf[FBPos] := #0;
  end;
end;

function TJsonWriterString.Append(buf: PChar): integer;
begin
  Result := Append(buf, strlen(buf));
end;

constructor TJsonWriterString.Create;
begin
  inherited;
  FSize := 32;
  FBPos := 0;
  GetMem(FBuf, FSize);
end;

destructor TJsonWriterString.Destroy;
begin
  if FBuf <> nil then
    FreeMem(FBuf, FSize);
  inherited;
end;

procedure TJsonWriterString.Reset;
begin
  FBuf[0] := #0;
  FBPos   := 0;
end;

{ TJsonWriterStream }

function TJsonWriterStream.Append(buf: PChar; Size: integer): integer;
begin
  Result := FStream.Write(buf^, Size);
end;

function TJsonWriterStream.Append(buf: PChar): integer;
begin
  Result := FStr