Question

我有一个“父”类，它有一个通用函数，可以将JSON字符串加载到名为 loadVals 的实例属性中。我有两个孩子有自己的属性，其中一个道具是一个记录。该函数成功设置了主实例的所有道具，但未能在记录的道具上设置值，没有错误，我可以看到它通过记录的道具成功循环但不设置值。写了一个小的测试控制台应用程序，在那里你可以看到行为。

uses
  System.SysUtils, System.TypInfo, RTTI, Data.DBXJSON;

type
  TFieldValLoader = reference to procedure (const new_val: TValue);

  tRec1 = record
    x: integer;
    y: String;
  end;

  tRec2 = record
    a: integer;
    b: String;
    c: integer;
  end;

  TMyParent = class(TObject)
    procedure loadVals(json_obj: TJSONObject);
  end;

  TMyChild1 = class(TMyParent)
    h: integer;
    my_rec: tRec1;
  end;

  TMyChild2 = class(TMyParent)
    j: string;
    my_rec: tRec2;
  end;

{ TMyParent }
procedure TMyParent.loadVals(json_obj: TJSONObject);
   procedure loadObj(Obj : TObject; my_json_obj: TJSONObject); forward;
  procedure loadRecord(Obj : TValue; my_json_obj: TJSONObject);forward;

  Procedure loadField( my_json_val: TJSONPair; _val: TValue; _loader: TFieldValLoader );
  Begin
    case _val.TypeInfo.Kind of
      tkInteger:
        _loader( TValue.From<integer>(StrToInt(my_json_val.JsonValue.Value)));
      tkWChar, tkUString, tkVariant:
        _loader( TValue.From(my_json_val.JsonValue.Value));
      tkRecord:
        loadRecord(_val, my_json_val.JsonValue as TJSONObject);
    end;
  End;

  procedure loadRecord(obj : TValue; my_json_obj: TJSONObject);
  var
    i: Integer;
    json_pair: TJSONPair;

    ctx: TRttiContext;
    obj_type: TRttiType;
    my_field: TRttiField;
  begin
    ctx := TRttiContext.Create;
    obj_type := ctx.GetType(obj.TypeInfo);
    for I := 0 to my_json_obj.Size - 1 do
    Begin
      json_pair := my_json_obj.get(i);
      my_field := obj_type.GetField(json_pair.JsonString.value);
      WriteLn('    - '+ my_field.Name);
      loadField(json_pair, my_field.GetValue(obj.GetReferenceToRawData),
        procedure( const new_val: TValue )
        Begin
        // This does not work. (no feedback)!!!!
          my_field.SetValue(obj.GetReferenceToRawData, new_val);
        End
      );
    End;
  End;

  procedure loadObj(Obj : TObject; my_json_obj: TJSONObject);
  var
    i: Integer;
    json_pair: TJSONPair;

    ctx: TRttiContext;
    obj_type: TRttiType;
    my_field: TRttiField;
  begin
    ctx := TRttiContext.Create;
    obj_type := ctx.GetType(obj.ClassInfo);
    for I := 0 to my_json_obj.Size - 1 do
    Begin
      json_pair := my_json_obj.get(i);
      my_field := obj_type.GetField(json_pair.JsonString.value);
      WriteLn('* '+ my_field.Name);
      loadField(json_pair, my_field.GetValue(obj),
        procedure( const new_val: TValue )
        Begin
        // This does work
          my_field.SetValue(obj, new_val);
        End
      );
    End;
  End;
begin
  WriteLn('Loading  '+ self.ClassName);
  loadObj(self, json_obj);
end;

{ main Test Procedure }
var
  my_child1: TMyChild1;
  my_child2: TMyChild2;
begin
  try
    my_child1:= TMyChild1.Create;
    my_child2:= TMyChild2.Create;
    try
    // load the json objs
      my_child1.loadVals(TJSONObject.ParseJSONValue('{"h": 2, "my_rec": {"x": 4, "y": "test"}}') as TJSONObject);
      my_child2.loadVals(TJSONObject.ParseJSONValue('{"j": "some", "my_rec": {"a": 8, "b": "any", "c": 9}}') as TJSONObject);

    // print the loaded values
      WriteLn('child 1 vals are: h: '+ intToStr(my_child1.h) +'  my_rec.y= "'+ my_child1.my_rec.y +'" should equal to "test"');
      WriteLn('child 2 vals are: j: '+ my_child2.j +'  my_rec.b= "'+ my_child2.my_rec.b +'" should equal to "any"');

    finally
      my_child1.Free;
      my_child2.Free;
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  // don't close the window, wait for [Enter]
  Readln;
end.

我知道记录与类不同，我找不到让这个功能起作用的方法;我非常感谢任何帮助。感谢

Answer 1

您的问题是记录是值类型。

这一行

loadField(json_pair, my_field.GetValue(obj),

获取记录字段的值。请注意，它是一个值类型，因此我们得到了副本。现在，您要在该副本上设置属性/字段。但是你永远不会把它分配回你对象的领域。

所以你在这里做的基本上是这样的：

my_child1:= TMyChild1.Create;
my_rec1 := my_child1.my_rec;
my_rec1.x := 4;
my_rec1.y := 'test';

因此，您可以看到my_child1.my_rec永远不会将值设置为my_rec1。

您需要按如下方式修复loadField：

procedure loadField( my_json_val: TJSONPair; _val: TValue; _loader: TFieldValLoader );
begin
  case _val.TypeInfo.Kind of
    tkInteger:
      _loader( TValue.From<integer>(StrToInt(my_json_val.JsonValue.Value)));
    tkWChar, tkUString, tkVariant:
      _loader( TValue.From(my_json_val.JsonValue.Value));
    tkRecord:
    begin
      loadRecord(_val, my_json_val.JsonValue as TJSONObject);
      _loader( _val); // <- set the record back to the field
    end;
  end;
end;

记录中的TRttiField SetValue不起作用的通用递归函数

1 个答案: