Delphi 10.3 Обновление Sub-TObject из JSONObject - PullRequest
0 голосов
/ 14 февраля 2019

У меня есть файл JSON, подобный этому:

{"Gradient":[{
  "Points":[{}],
  "Style":"Linear",
  "StartPosition":[{"X":"0","Y":"0"}],
  "StopPosition":[{"X":"0","Y":"1"}]
  }]
}

, и я хотел бы создать процедуру автоматического разбора для обновления объекта и его подобъектов из этого JSON.(Я уже пробовал маршал и демаршал, но он не работает, потому что я смешал свой собственный объект и системные объекты, которые не маршализованы).

Поэтому я написал этот код с использованием RTTI, но у меня возникает проблема, когда я хочуобновить подобъект в этой процедуре:

uses
  REST.JSON, System.Generics.Collections, system.JSON, RTTI, TypInfo, System.Types;

...

class procedure TJSONUtils.FromJSON(aSender: TObject ; aJSONO : TJSONObject);
const
  SKIP_PROP_TYPES = [tkUnknown, tkInterface];
var
  vC : TRttiContext;
  vType : TRttiType;
  vProperty : TRttiProperty;
  vValue : TValue;
  vPropName : string;
  vJSONPair : TJSONPair;

begin
  // Get RTTI of aSender Object
  vC := TRttiContext.Create;
  vType := vC.GetType(aSender.ClassInfo);

  for vJSONPair in aJSONO do
  begin
    if vJSONPair.JsonValue is TJSONArray then
    begin
      // JSON contain object or Record data
      for vProperty in vType.GetProperties do
      begin
        if (vProperty.IsReadable) and not (vProperty.PropertyType.TypeKind in SKIP_PROP_TYPES) and (vProperty.Visibility = mvPublished ) then
        begin
          if vProperty.Name = vPropName then
          begin
            vValue := vProperty.GetValue(aSender);
            if vValue.IsObject then
            begin
              // IS OBJECT
              TJSONUtils.FromJSON((vProperty.GetValue(aSender) as vProperty.ClassType), vJSONPair);   // error here
            end
            else // if vValue.IsArray then
            begin
              // IS ARRAY or record ?
              TJSONUtils.FromJSON((vProperty.GetValue(aSender) as vProperty.ClassType), vJSONPair);   // error here
            end;
          end;
        end;
      end;
    end
    else
    begin
      // low level data (string, integer, real, etc...)
      vPropName := StringReplace(vJSONPair.JsonString.Value, '"', '', [rfReplaceAll]);
      for vProperty in vType.GetProperties do
      begin
        if (vProperty.IsReadable) and not (vProperty.PropertyType.TypeKind in SKIP_PROP_TYPES) and (vProperty.Visibility = mvPublished ) then
        begin
          if vProperty.Name = vPropName then
          begin
            vProperty.SetValue(aSender, stringReplace(stringReplace(vJSONPair.JsonValue.ToString, '"', '', [RfReplaceAll]), '''', '', [RfReplaceAll]));
          end;
        end;
      end;
    end;
  end;
end;

У меня ошибка при рекурсивном вызове процедуры.Я хотел бы передать подобъект в параметре, но способ, которым я написал это, не работает.Знаете ли вы, как заставить его работать правильно?(для подобъектов, подмассива или записи).

Примечание: оно должно быть динамическим, потому что я никогда не узнаю, какова структура объекта ...

...