Delphi 11.3中TJSON.ObjectToJsonString转换类型化对象触发EInsufficientRtti异常求助

我有一组TSignalBox对象，需要将其基础数据转换为JSON字符串，但调用TJSON.ObjectToJSONstring()时触发了EInsufficientRtti异常。单独创建TSignalBox或TSignalBoxBase实例并调用ToJson()方法可以正常工作，但从集合中取出TSignalBox对象后调用ToJson()就会失败。

注：仅寻求针对该RTTI异常的解决方法，不讨论其他JSON构建方案

使用环境：Delphi 11.3

相关代码：

type
  ESignalBox = class(Exception);
  ESignalBoxList = class(Exception);

  TSignalBoxBase = class(TObject)
  private
    FName : string;
    FHost : string;
    FPort : string;
    FMac : string;
    FPassword : string;

    FFirmwareVersion: integer;
    FModuleId: integer;
    FHardwareVersion: integer;

    function GetName: string;
    procedure SetName(const Value: string);
    function GetPassword: string;
    procedure SetPassword(const Value: string);
    function GetMac: string;
    procedure SetMac(const Value: string);

    procedure SetFirmwareVersion(const Value: integer);
    procedure SetHardwareVersion(const Value: integer);
    procedure SetModuleId(const Value: integer);


  public
    property Host: string read FHost write FHost;
    property Port: string read FPort write FPort;

    property Name: string read GetName write SetName;
    property Mac: string read GetMac write SetMac;
    property Password: string read GetPassword write SetPassword;

    property ModuleId : integer read FModuleId write SetModuleId;
    property HardwareVersion : integer read FHardwareVersion write SetHardwareVersion;
    property FirmwareVersion : integer read FFirmwareVersion write SetFirmwareVersion;

    function ToJson : string;
  end;



  TSignalBox = class(TSignalBoxBase)
  private
    FTCPClient : TidTcpClient;

    FState : TStates;
    FRelays : Integer;
    FRelayStates : array of Boolean;

    function GetState: TStates;
    procedure SetState(const Value: TStates);
    function GetRelays(index: Integer): Boolean;
    procedure SetRelay(index: Integer; const Value: Boolean);

    function GetHost: string;
    procedure SetHost(const Value: string);
    function GetPort: string;
    procedure SetPort(const Value: string);


    constructor Create; overload;
    procedure IdTCPClientConnected(Sender: TObject);
    procedure IdTCPClientDisconnected(Sender: TObject);
    procedure IdTCPClientStatus(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
  public
    function UpdateRelays : Boolean;
    function UpdateModuleInfo : Boolean;

    property State: TStates read GetState write SetState;
    property Relay[index : Integer] : Boolean read GetRelays write SetRelay;

    property Host: string read GetHost write SetHost;
    property Port: string read GetPort write SetPort;

    constructor Create(AName, AHost, AMac, APort, APassword: string); overload;
    destructor Destroy; override;
  end;

   TSignalBoxList = class(TObjectList<TSignalBox>)
   private
   public
     function ToJson : string;
  end;




  // 测试：正常工作
function JsonTest : string;
var
  ASignalBox : TSignalBox;
begin
  Result := '';
  ASignalBox := TSignalBox.Create;
  try
    ASignalBox.Host := 'localhost';
    ASignalBox.Port := '2000';
    ASignalBox.Name := 'test wifi484';
    ASignalBox.Mac := '12:34:56:78' ;
    ASignalBox.Password := 'secret';
    ASignalBox.ModuleId := 1;
    ASignalBox.HardwareVersion := 4;
    ASignalBox.FirmwareVersion := 2;
    result := ASignalBox.ToJson;
  finally
    ASignalBox.Free;
  end;
end;

// 测试：正常工作
function JsonTestBase : string;
var
  ASignalBox : TSignalBoxBase;
begin
  Result := '';
  ASignalBox := TSignalBoxBase.Create;
  try
    ASignalBox.Host := 'localhost';
    ASignalBox.Port := '2000';
    ASignalBox.Name := 'test wifi484';
    ASignalBox.Mac := '12:34:56:78' ;
    ASignalBox.Password := 'secret';
    ASignalBox.ModuleId := 1;
    ASignalBox.HardwareVersion := 4;
    ASignalBox.FirmwareVersion := 2;
    result := ASignalBox.ToJson;
  finally
    ASignalBox.Free;
  end;
end;


function TSignalBoxList.ToJson: string;
var
  ASignalBox : TSignalBox;
begin
  Result := '';

  result := JsonTest; // 正常工作
  result := JsonTestBase; // 正常工作


  for ASignalbox in self do
  begin
     result := result + ASignalBox.ToJson; // 触发EInsufficientRtti异常
  end;
end;

{ TSignalBoxBase }

function TSignalBoxBase.ToJson: string;
begin
  Result := TJSON.ObjectToJsonString(TSignalBoxBase(self));  // 触发EInsufficientRtti异常
end;

当从集合中取出TSignalBox对象调用ToJson()时，TJSON.ObjectToJsonString会尝试解析整个对象的所有RTTI可见属性，包括TSignalBox子类新增的属性：

1. FTCPClient是TIdTCPClient类型，该类未生成足够的公开RTTI信息，无法被JSON序列化器处理；
2. 动态数组FRelayStates和索引属性Relay也可能因为RTTI限制导致序列化失败；
3. 你在TSignalBoxBase.ToJson中强制转换TSignalBoxBase(self)并不能阻止RTTI解析子类的实际类型属性，因为序列化器会根据对象的实际类型（TSignalBox）扫描所有属性。

而单独测试时，TSignalBox的无参构造函数可能未初始化FTCPClient（或该属性为nil），序列化器可能跳过了对未初始化对象的RTTI解析，所以未触发异常。

核心思路是让RTTI序列化器忽略TSignalBox中不需要序列化的属性（尤其是无法被RTTI处理的类型），有两种实现方式：

方式1：给子类中不需要序列化的成员添加[RTTIExclude]属性 #

首先确保单元引用System.Rtti，然后给TSignalBox中不需要序列化的字段和属性添加排除标记：

uses
  System.Rtti;

type
  TSignalBox = class(TSignalBoxBase)
  private
    [RTTIExclude]
    FTCPClient : TidTcpClient;

    [RTTIExclude]
    FState : TStates;
    [RTTIExclude]
    FRelays : Integer;
    [RTTIExclude]
    FRelayStates : array of Boolean;

    // 私有方法保持不变
    function GetState: TStates;
    procedure SetState(const Value: TStates);
    function GetRelays(index: Integer): Boolean;
    procedure SetRelay(index: Integer; const Value: Boolean);

    function GetHost: string;
    procedure SetHost(const Value: string);
    function GetPort: string;
    procedure SetPort(const Value: string);

    constructor Create; overload;
    procedure IdTCPClientConnected(Sender: TObject);
    procedure IdTCPClientDisconnected(Sender: TObject);
    procedure IdTCPClientStatus(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
  public
    [RTTIExclude]
    function UpdateRelays : Boolean;
    [RTTIExclude]
    function UpdateModuleInfo : Boolean;

    [RTTIExclude]
    property State: TStates read GetState write SetState;
    [RTTIExclude]
    property Relay[index : Integer] : Boolean read GetRelays write SetRelay;

    [RTTIExclude]
    property Host: string read GetHost write SetHost;
    [RTTIExclude]
    property Port: string read GetPort write SetPort;

    constructor Create(AName, AHost, AMac, APort, APassword: string); overload;
    destructor Destroy; override;
  end;

同时修改TSignalBoxBase.ToJson方法，去掉不必要的强制转换：

function TSignalBoxBase.ToJson: string;
begin
  Result := TJSON.ObjectToJsonString(self);
end;

方式2：在子类中重写ToJson方法，仅序列化基类属性 #

直接在TSignalBox中重写ToJson，明确调用父类的实现，避免序列化器扫描子类属性：

function TSignalBox.ToJson: string;
begin
  // 仅序列化基类TSignalBoxBase的属性
  Result := inherited ToJson;
end;

同时修改TSignalBoxBase.ToJson，确保序列化器只处理基类类型：

function TSignalBoxBase.ToJson: string;
var
  LContext: TRttiContext;
  LType: TRttiType;
  LJSONObj: TJSONObject;
  LProp: TRttiProperty;
  LValue: TValue;
begin
  LJSONObj := TJSONObject.Create;
  try
    LContext := TRttiContext.Create;
    try
      // 明确获取TSignalBoxBase的RTTI类型，而非实际对象类型
      LType := LContext.GetType(TypeInfo(TSignalBoxBase));
      for LProp in LType.GetProperties do
      begin
        if LProp.IsReadable then
        begin
          LValue := LProp.GetValue(self);
          case LValue.Kind of
            tkString, tkLString, tkWString, tkUString:
              LJSONObj.AddPair(LProp.Name, LValue.AsString);
            tkInteger:
              LJSONObj.AddPair(LProp.Name, TJSONNumber.Create(LValue.AsInteger));
          end;
        end;
      end;
      Result := LJSONObj.ToString;
    finally
      LContext.Free;
    end;
  finally
    LJSONObj.Free;
  end;
end;

这种方式通过手动遍历基类的RTTI属性，完全避免了对子类属性的解析，从根源上解决了RTTI不足的问题。

内容的提问来源于stack exchange，提问作者hhaumann