SuperObject TSuperRttiContext.AsType的问题及解决方法

问题是这样的。
在我的程序中,我用json存放用户的设置,保存到文件中。
当我的程序版本升级时,我往用户的设置中增加了新的Fields。当我从用户的机器中读取老版本的设置时,会出现错误。我的读取与写入代码如下:

procedure ReadFromStream<T>(Stream: TStream; var O: T);

var

  CTX:TSuperRttiContext;

  Size:Cardinal;

  StrStream:TStringStream;

begin

  CTX:=TSuperRttiContext.Create;

  StrStream:=TStringStream.Create;

  try

    Stream.Read(Size,SizeOf(Size));

    StrStream.CopyFrom(Stream,Size);

    O:=CTX.AsType<T>(SO(StrStream.DataString));

  finally

    CTX.Free;

    StrStream.Free;

  end;

end;



procedure WriteToStream<T>(Stream: TStream; O: T);

var

  CTX:TSuperRttiContext;

  Size:Cardinal;

  StrStream:TStringStream;

begin

  CTX:=TSuperRttiContext.Create;

  StrStream:=TStringStream.Create;

  try

    StrStream.WriteString(CTX.AsJson<T>(O).AsJSon);

    Size:=StrStream.Size;

    StrStream.Position:=0;

    Stream.Write(Size,SizeOf(Size));

    Stream.CopyFrom(StrStream,Size);

  finally

    CTX.Free;

    StrStream.Free;

  end;

end;

 

当我调用  ReadFromStream 去读取用户设置时, 在这行将发生错误Marshalling error :O:=CTX.AsType<T>(SO(StrStream.DataString)) .

为了解决这个问题,我对TSuperRttiContext.FromJson方法进行了修改:

 

procedure FromRecord;

  var

    f: TRttiField;

    p: Pointer;

    v: TValue;

  begin

    Result := True;

    TValue.Make(nil, TypeInfo, Value);

    for f in Context.GetType(TypeInfo).GetFields do

    begin

      if ObjectIsType(obj, stObject) and (f.FieldType <> nil) then

      begin

        p := IValueData(TValueData(Value).FHeapData).GetReferenceToRawData;

        Result := FromJson(f.FieldType.Handle, GetFieldDefault(f, obj.AsObject[GetFieldName(f)]), v);

  //modified start

        if not Result then

          TValue.Make(nil, f.FieldType.Handle, v);

        f.SetValue(p, v);

        Exit;

 // modified end

      end else

      begin

        Result := False;

        Exit;

      end;

    end;

  end;



procedure FromClass;

  var

    f: TRttiField;

    v: TValue;

  begin

    case ObjectGetType(obj) of

      stObject:

        begin

          Result := True;

          if Value.Kind <> tkClass then

            Value := GetTypeData(TypeInfo).ClassType.Create;

          for f in Context.GetType(Value.AsObject.ClassType).GetFields do

            if f.FieldType <> nil then

            begin

              Result := FromJson(f.FieldType.Handle, GetFieldDefault(f, obj.AsObject[GetFieldName(f)]), v);

             {Modified by neugls 2011/4/5}

             //modified start

              if not Result then

                TValue.Make(nil, f.FieldType.Handle, v);

             

              f.SetValue(Value.AsObject, v);

              Exit;

             //modified end

            end;

        end;

      stNull:

        begin

          Value := nil;

          Result := True;

        end

    else

      // error

      Value := nil;

      Result := False;

    end;

  end;

 

总结:问题的根源在于,如果ISuperObject 实例中没有与TypeInfo对应的field话,就会失败,而我的修改就是绕过了这个!

你可能感兴趣的:(context)