Json 一般递归函数，记录上的TRttiField SetValue不'；行不通

我有一个“parent”类，它有一个通用函数，用于将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.

使用
System.SysUtils、System.TypInfo、RTTI、Data.DBXJSON；
类型
TFieldValLoader=程序参考（常量新值：TValue）；
tRec1=记录
x：整数；
y：字符串；
结束；
tRec2=记录
a：整数；
b:弦；
c：整数；
结束；
TMyParent=类（TObject）
过程loadVals（json_obj:TJSONObject）；
结束；
TMyChild1=类（TMyParent）
h：整数；
我的建议：tRec1；
结束；
TMyChild2=类（TMyParent）
j:弦；
我的建议：tRec2；
结束；
{TMyParent}
程序TMyParent.loadVals（json_obj:TJSONObject）；
过程loadObj（Obj:TObject；my_json_Obj:TJSONObject）；向前地
过程加载记录（Obj:TValue；my_json_Obj:TJSONObject）；向前地
过程加载字段（my_json_val:TJSONPair；_val:TValue；_loader:TFieldValLoader）；
开始
案例_val.TypeInfo.king
特金泰格：
_loader（TValue.From（stroint（my_json_val.JsonValue.Value））；
tkWChar、tkUString、tkVariant：
_loader（TValue.From（my_json_val.JsonValue.Value））；
tkRecord：
loadRecord（_val，my_json_val.JsonValue作为TJSONObject）；
结束；
结束；
过程加载记录（obj:TValue；my_json_obj:TJSONObject）；
变量
i：整数；
json_对：TJSONPair；
ctx:trtti上下文；
obj_型：TRTTI型；
my_字段：TRttiField；
开始
ctx:=TRttiContext.Create；
对象类型：=ctx.GetType（对象类型信息）；
对于I:=0到my_json_obj.Size-1 do
开始
json_pair:=my_json_obj.get（i）；
my_字段：=obj_type.GetField（json_pair.JsonString.value）；
WriteLn（'-'+my_field.Name）；
loadField（json_对，my_field.GetValue（obj.GetReferenceToRawData），
程序（常数新值：TValue）
开始
//这不起作用。（没有反馈）！！！！
my_field.SetValue（obj.GetReferenceToRawData，new_val）；
终点
);
结束；
结束；
过程loadObj（Obj:TObject；my_json_Obj:TJSONObject）；
变量
i：整数；
json_对：TJSONPair；
ctx:trtti上下文；
obj_型：TRTTI型；
my_字段：TRttiField；
开始
ctx:=TRttiContext.Create；
对象类型：=ctx.GetType（obj.ClassInfo）；
对于I:=0到my_json_obj.Size-1 do
开始
json_pair:=my_json_obj.get（i）；
my_字段：=obj_type.GetField（json_pair.JsonString.value）；
WriteLn（“*”+my_field.Name）；
loadField（json_对，my_field.GetValue（obj），
程序（常数新值：TValue）
开始
//这确实有效
my_field.SetValue（对象，新值）；
终点
);
结束；
结束；
开始
WriteLn（'Loading'+self.ClassName）；
loadObj（self，json_obj）；
结束；
{主要测试程序}
变量
我的孩子1:TMyChild1；
我的孩子2:TMyChild2；
开始
尝试
my_child1:=TMyChild1.Create；
my_child2:=TMyChild2.Create；
尝试
//加载json对象
my_child1.loadVals（TJSONObject.ParseJSONValue（“{”h“：2，“my_rec:{”x“：4，“y:“test”}”）作为TJSONObject）；
my_child2.loadVals（TJSONObject.ParseJSONValue（'{“j”：“some”，“my_rec”：{“a”：8，“b”：“any”，“c”：9}'）作为TJSONObject）；
//打印加载的值
WriteLn（'child 1 vals:h:'+intToStr（my_child 1.h）+'my_rec.y=“'+my_child 1.my_rec.y+'”应等于“test”）；
WriteLn（'child 2 vals:j:'+my_child 2.j+'my_rec.b=“'+my_child 2.my_rec.b+'”应等于“any”）；
最后
我的孩子1.自由；
我的孩子2.自由；
结束；
除了
关于E:Exception-do
Writeln（E.ClassName，“：”，E.Message）；
结束；
//不要关闭窗口，等待[Enter]
Readln；
结束。

---

我知道记录和类是不同的，我找不到让这个函数工作的方法；我真的很感谢你的帮助。谢谢

您的问题是记录是一种值类型

这条线

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;

过程加载字段（my_json_val:TJSONPair；_val:TValue；_loader:TFieldValLoader）；
开始
案例_val.TypeInfo.king
特金泰格：
_loader（TValue.From（stroint（my_json_val.JsonValue.Value））；
tkWChar、tkUString、tkVariant：
_loader（TValue.From（my_json_val.JsonValue.Value））；
tkRecord：
开始
loadRecord（_val，my_json_val.JsonValue作为TJSONObject）；
_装载机（_val）//