记录的简单 JSON 反序列化不正确（Delphi Sydney [10.4.1]）答案

【问题标题】：Simple JSON deserialization of records incorrect (Delphi Sydney [10.4.1])记录的简单 JSON 反序列化不正确（Delphi Sydney [10.4.1]）
【发布时间】：2021-01-27 13:15:17
【问题描述】：

Delphi Sydney (10.4.1) 的 JSON 反序列化器发生了什么变化？从 Delphi 西雅图迁移到悉尼后，标准 marshal 对简单记录的反序列化存在问题。

这是我的问题的一个示例和简化表示：

数据结构 - 交互 1：

TAnalysisAdditionalData=record {order important for marshaling}
  ExampleData0:Real;   {00}
  ExampleData1:Real;   {01}
  ExampleData2:String; {02} 
end;

JSON 表示：

"AnalysisAdditionalData":[0,1,"ExampleString"]

数据结构 - Interation x，5 年后：

TAnalysisAdditionalData=record {order important for marshaling}
  ExampleData0:Real;   {00}
  ExampleData1:Real;   {01}
  ExampleData2:String; {02} 
  ExampleData3:String; {03} {since version 2016-01-01}  
  ExampleData4:String; {04} {since version 2018-01-01}  
  ExampleData5:String; {05} 
end;

JSON 表示：

"AnalysisAdditionalData":[0,1,"ExampleString0","ExampleString1","ExampleString2","ExampleString3"]

第一次交互后，增加了三个字符串字段。

如果我现在用旧数据集面对 Delphi Sydney 的标准元帅（没有自定义转换器、还原器等），那么具体来说，对于数据 "AnalysisAdditionalData":[0,1, "ExampleString"]，Sydney 会抛出 EArgumentOutOfBoundsException，因为预计会有 3 个字符串 -反序列化失败。

退出点位于方法TJSONUnMarshal.JSONToTValue 中的Data.DBXJSONReflect - 位置标记如下：

function TJSONUnMarshal.JSONToTValue(JsonValue: TJSONValue;
  rttiType: TRttiType): TValue;
var
  tvArray: array of TValue;
  Value: string;
  I: Integer;
  elementType: TRttiType;
  Data: TValue;
  recField: TRTTIField;
  attrRev: TJSONInterceptor;
  jsonFieldVal: TJSONValue;
  ClassType: TClass;
  Instance: Pointer;
begin
  // null or nil returns empty
  if (JsonValue = nil) or (JsonValue is TJSONNull) then
    Exit(TValue.Empty);

  // for each JSON value type
  if JsonValue is TJSONNumber then
    // get data "as is"
    Value := TJSONNumber(JsonValue).ToString
  else if JsonValue is TJSONString then
    Value := TJSONString(JsonValue).Value
  else if JsonValue is TJSONTrue then
    Exit(True)
  else if JsonValue is TJSONFalse then
    Exit(False)
  else if JsonValue is TJSONObject then
    // object...
    Exit(CreateObject(TJSONObject(JsonValue)))
  else
  begin
    case rttiType.TypeKind of
      TTypeKind.tkDynArray, TTypeKind.tkArray:
        begin
          // array
          SetLength(tvArray, TJSONArray(JsonValue).Count);
          if rttiType is TRttiArrayType then
            elementType := TRttiArrayType(rttiType).elementType
          else
            elementType := TRttiDynamicArrayType(rttiType).elementType;
          for I := 0 to Length(tvArray) - 1 do
            tvArray[I] := JSONToTValue(TJSONArray(JsonValue).Items[I],
              elementType);
          Exit(TValue.FromArray(rttiType.Handle, tvArray));
        end;
      TTypeKind.tkRecord, TTypeKind.tkMRecord:
        begin
          TValue.Make(nil, rttiType.Handle, Data);
          // match the fields with the array elements
          I := 0;
          for recField in rttiType.GetFields do
          begin
            Instance := Data.GetReferenceToRawData;
            jsonFieldVal := TJSONArray(JsonValue).Items[I]; <<<--- Exception here (EArgumentOutOfBoundsException)
            // check for type reverter
            ClassType := nil;
            if recField.FieldType.IsInstance then
              ClassType := recField.FieldType.AsInstance.MetaclassType;
            if (ClassType <> nil) then
            begin
              if HasReverter(ClassType, FIELD_ANY) then
                RevertType(recField, Instance,
                  Reverter(ClassType, FIELD_ANY),
                  jsonFieldVal)
              else
              begin
                attrRev := FieldTypeReverter(recField.FieldType);
                if attrRev = nil then
                   attrRev := FieldReverter(recField);
                if attrRev <> nil then
                  try
                    RevertType(recField, Instance, attrRev, jsonFieldVal)
                  finally
                    attrRev.Free
                  end
                else
                 recField.SetValue(Instance, JSONToTValue(jsonFieldVal,
                      recField.FieldType));
              end
            end
            else
              recField.SetValue(Instance, JSONToTValue(jsonFieldVal,
                  recField.FieldType));
            Inc(I);
          end;
          Exit(Data);
        end;
    end;
  end;

  // transform value string into TValue based on type info
  Exit(StringToTValue(Value, rttiType.Handle));
end;

当然，这对于仅使用悉尼，或至少使用西雅图以上的 Delphi 版本，或已开始使用这些版本的人来说可能是有意义的。另一方面，我最近才能够从西雅图过渡到悉尼（更新 1）。

Delphi Seattle 对于缺少的记录字段没有任何问题。当它们可以默认保持不变时，为什么要这样做？然而，荒谬的是，悉尼没有过多数据的问题。

这是一个已知的 Delphi Sydney 错误吗？我们可以期待修复吗？或者可以通过其他方式解决问题，即编译器指令、Data.DBXJSONReflect.TCustomAttribute 等？或者，是否可以为记录编写转换器/还原器？如果是这样，是否有有用的指南或资源来说明如何执行此操作？

就我而言，不幸的是，在这方面没有找到任何有用的信息，只有许多记录不充分的类描述。

附录： 是的，它看起来像是一个 Delphi 错误，在我看来是一个非常危险的错误。幸运的是，我正要部署一个主要版本，我在移植到悉尼后进行测试时发现了这个错误。但这只是偶然，因为我必须处理旧数据集。我很容易忽略了这个缺陷。

您应该检查您的项目是否也受到影响。对我来说，问题是现在很容易被打破。

我刚刚为 Embarcadero 支持团队编写了一个非常简单的测试程序。如果你愿意，你可以看看它并测试你的代码是否也受到影响。

下面是说明和代码：

创建一个新项目。
在主窗体上创建两个按钮和一个备忘录。
为按钮分配两个 OnClick 事件以进行相应的加载和保存
运行程序并单击保存按钮。
在应用程序目录中打开 .TXT 并删除例如记录的最后一个条目。
单击加载按钮并抛出 EArgumentOutOfBoundsException。

unit main;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Memo.Types, FMX.StdCtrls, FMX.Controls.Presentation, FMX.ScrollBox,
  FMX.Memo;

type
  TAnalysisAdditionalData=record {order important for marshaling}
    ExampleData0:Real;   {00}
    ExampleData1:Real;   {01}
    ExampleData2:String; {02}
    ExampleData3:String; {03} {since version 2016-01-01}
    ExampleData4:String; {04} {since version 2018-01-01}
    ExampleData5:String; {05}
  end;

  TSHCustomEntity=class(TPersistent)
  private
  protected
  public
    GUID:String;
  end;

  TSHAnalysis=class(TSHCustomEntity)
  private
  protected
  public
    AnalysisResult:String;
    AnalysisAdditionalData:TAnalysisAdditionalData;
  end;

  TMainform = class(TForm)
    Memo_Output: TMemo;
    Button_Save: TButton;
    Button_Load: TButton;
    procedure Button_SaveClick(Sender: TObject);
    procedure Button_LoadClick(Sender: TObject);
  private
    Analysis:TSHAnalysis;
    procedure Marshal(Filename:String);
    procedure Unmarshal(Filename:String);
    function GetApplicationPath: String;
    function GetFilename: String;
  protected
    procedure AfterConstruction;override;
  public
    Destructor Destroy;override;

    property ApplicationPath:String read GetApplicationPath;
    property Filename:String read GetFilename;
  end;

var
  Mainform: TMainform;

implementation

{$R *.fmx}

uses
  DBXJSON,
  DBXJSONReflect,
  System.JSON;

{ TMainform }

procedure TMainform.AfterConstruction;
begin
  inherited;
  self.Analysis:=TSHAnalysis.Create;
  self.Analysis.GUID:='6ed61388-cdd4-28dd-6efe-24461c4df3cd';
  self.Analysis.AnalysisAdditionalData.ExampleData0:=0.5;
  self.Analysis.AnalysisAdditionalData.ExampleData1:=0.9;
  self.Analysis.AnalysisAdditionalData.ExampleData2:='ExampleString0';
  self.Analysis.AnalysisAdditionalData.ExampleData3:='ExampleString1';
  self.Analysis.AnalysisAdditionalData.ExampleData4:='ExampleString2';
  self.Analysis.AnalysisAdditionalData.ExampleData5:='ExampleString3';
end;

destructor TMainform.Destroy;
begin
  self.Analysis.free;
  inherited;
end;

function TMainform.GetApplicationPath: String;
begin
  RESULT:=IncludeTrailingPathDelimiter(ExtractFilePath(paramStr(0)));
end;

function TMainform.GetFilename: String;
begin
  RESULT:=self.ApplicationPath+'6ed61388-cdd4-28dd-6efe-24461c4df3cd.txt';
end;

procedure TMainform.Button_SaveClick(Sender: TObject);
begin
  self.Marshal(self.Filename);
end;

procedure TMainform.Button_LoadClick(Sender: TObject);
begin
  if Analysis<>NIL then
    FreeAndNil(Analysis);
  self.Unmarshal(self.Filename);

  self.Memo_Output.Text:=
    self.Analysis.GUID+#13#10+
    FloatToStr(self.Analysis.AnalysisAdditionalData.ExampleData0)+#13#10+
    FloatToStr(self.Analysis.AnalysisAdditionalData.ExampleData1)+#13#10+
    self.Analysis.AnalysisAdditionalData.ExampleData2+#13#10+
    self.Analysis.AnalysisAdditionalData.ExampleData3+#13#10+
    self.Analysis.AnalysisAdditionalData.ExampleData4+#13#10+
    self.Analysis.AnalysisAdditionalData.ExampleData5;
end;

procedure TMainform.Marshal(Filename:String);
var
  _Marshal:TJSONMarshal;
  _Strings:TStringlist;
  _Value:TJSONValue;
begin
  _Strings:=TStringlist.Create;
  try
    _Marshal:=TJSONMarshal.Create;
    try
      _Value:=_Marshal.Marshal(Analysis);
      _Strings.text:=_Value.ToString;
    finally
      if _Value<>NIL then
        _Value.free;
      _Marshal.free;
    end;
    _Strings.SaveToFile(Filename);
  finally
    _Strings.free;
  end;
end;

procedure TMainform.Unmarshal(Filename:String);
var
  _Strings:TStrings;
  _UnMarshal:TJSONUnMarshal;
  _Value:TJSONValue;
begin
  if FileExists(Filename) then begin
    _Strings:=TStringlist.create;
    try
      _Strings.LoadFromFile(Filename);
      try
        _Value:=TJSONObject.ParseJSONValue(_Strings.Text);
        _UnMarshal:=TJSONUnMarshal.Create;
        try
          try
            self.Analysis:=_UnMarshal.Unmarshal(_Value) as TSHAnalysis;
          except
            on e:Exception do
              self.Memo_Output.text:=e.Message;
          end;
        finally
          _UnMarshal.free;
        end;
      finally
        if _Value<>NIL then
          _Value.free;
      end;
    finally
      _Strings.free;
    end;
  end;
end;

end.

【问题讨论】：

请提交错误报告。
感谢您的回复。为了安全起见，我刚刚做了 (RSP-32285)。

标签： json delphi reflection json-deserialization unmarshalling

【解决方案1】：

为了暂时解决问题，我有以下快速解决方案给你：

复制标准库Data.DBXJSONReflect 并将其命名为例如Data.TempFix.DBXJSONReflect。
相应地更改项目中的所有包含/使用。

然后在 Data.TempFix.DBXJSONReflect 中导航到第 2993 行：

jsonFieldVal := TJSONArray(JsonValue).Items[I];

并将其替换为以下代码：

try
  jsonFieldVal := TJSONArray(JsonValue).Items[I];
except
  on e:Exception do
    if e is EArgumentOutOfRangeException then
      continue
    else
      raise;
end;

之后整个方法应该是这样的：

function TJSONUnMarshal.JSONToTValue(JsonValue: TJSONValue; rttiType: TRttiType): TValue;
var
  tvArray: array of TValue;
  Value: string;
  I: Integer;
  elementType: TRttiType;
  Data: TValue;
  recField: TRTTIField;
  attrRev: TJSONInterceptor;
  jsonFieldVal: TJSONValue;
  ClassType: TClass;
  Instance: Pointer;
begin
  // null or nil returns empty
  if (JsonValue = nil) or (JsonValue is TJSONNull) then
    Exit(TValue.Empty);

  // for each JSON value type
  if JsonValue is TJSONNumber then
    // get data "as is"
    Value := TJSONNumber(JsonValue).ToString
  else if JsonValue is TJSONString then
    Value := TJSONString(JsonValue).Value
  else if JsonValue is TJSONTrue then
    Exit(True)
  else if JsonValue is TJSONFalse then
    Exit(False)
  else if JsonValue is TJSONObject then
    // object...
    Exit(CreateObject(TJSONObject(JsonValue)))
  else
  begin
    case rttiType.TypeKind of
      TTypeKind.tkDynArray, TTypeKind.tkArray:
        begin
          // array
          SetLength(tvArray, TJSONArray(JsonValue).Count);
          if rttiType is TRttiArrayType then
            elementType := TRttiArrayType(rttiType).elementType
          else
            elementType := TRttiDynamicArrayType(rttiType).elementType;
          for I := 0 to Length(tvArray) - 1 do
            tvArray[I] := JSONToTValue(TJSONArray(JsonValue).Items[I],
              elementType);
          Exit(TValue.FromArray(rttiType.Handle, tvArray));
        end;
      TTypeKind.tkRecord, TTypeKind.tkMRecord:
        begin
          TValue.Make(nil, rttiType.Handle, Data);
          // match the fields with the array elements
          I := 0;
          for recField in rttiType.GetFields do
          begin
            Instance := Data.GetReferenceToRawData;
            try
              jsonFieldVal := TJSONArray(JsonValue).Items[I];
            except
              on e:Exception do
                if e is EArgumentOutOfRangeException then
                  continue
                else
                  raise;
            end;
            // check for type reverter
            ClassType := nil;
            if recField.FieldType.IsInstance then
              ClassType := recField.FieldType.AsInstance.MetaclassType;
            if (ClassType <> nil) then
            begin
              if HasReverter(ClassType, FIELD_ANY) then
                RevertType(recField, Instance,
                  Reverter(ClassType, FIELD_ANY),
                  jsonFieldVal)
              else
              begin
                attrRev := FieldTypeReverter(recField.FieldType);
                if attrRev = nil then
                   attrRev := FieldReverter(recField);
                if attrRev <> nil then
                  try
                    RevertType(recField, Instance, attrRev, jsonFieldVal)
                  finally
                    attrRev.Free
                  end
                else
                 recField.SetValue(Instance, JSONToTValue(jsonFieldVal,
                      recField.FieldType));
              end
            end
            else
              recField.SetValue(Instance, JSONToTValue(jsonFieldVal,
                  recField.FieldType));
            Inc(I);
          end;
          Exit(Data);
        end;
    end;
  end;

  // transform value string into TValue based on type info
  Exit(StringToTValue(Value, rttiType.Handle));
end;

【讨论】：