Forum > General

Complex objects and JsonObjects

(1/2) > >>

LeoBruno:
Hi:

I´m new to FPC Lazarus, and I´m having problems with complex Objects and Json.

The Root Object is composed of some nested Objects that have one Nested Object List (generics.collections).

1st problem:

Converting the Object to JsonString with fpjsonrtti, results Nested objects OK but one Empty Object that should be an Object Array.

2nd problem:

Converting the Object to TJsonObject results Nested Objects OK but empty TJsonArray.

For this project, converting to text, should be fine, because what i need is to save it to a file.
But very soon I´ll need to use complex TObject to TJsonObject and vice versa.

First Question:

TJSONStreamer.ObjectToJSONString should be able to convert correctly the Generics.Collections.TObjectList?

Second Question:

What About TJSONStreamer.ObjectToJSON??

This unit contains the classes that are used as nested objects


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Model.ConfigProjeto.Scripts; {$mode delphi}{$H+}{$M+} interface uses  Classes,  SysUtils,  Generics.Collections; type         { TModelParameroScript }   TModelParameroScript = class(TObject)  private    FNomeParametro: string;    FTipoParametro: string;  public  published          property NomeParametro: string read FNomeParametro write FNomeParametro;          property TipoParametro: string read FTipoParametro write FTipoParametro;        end;   TModelParameroScriptList = TObjectList<TModelParameroScript>;         { TModelConfigProjetoScripts }   TModelConfigProjetoScripts = class(TObject)  private    FScriptSelect: string;    FScriptProximoID: string;    FScriptNovoRegistro: string;    FListaParametrosNovoRegistro: TModelParameroScriptList;  public    constructor Create;    destructor Destroy; override;     procedure Clear;  published    property ScriptSelect: string read FScriptSelect write FScriptSelect;    property ScriptProximoID: string read FScriptProximoID write FScriptProximoID;    property ScriptNovoRegistro: string read FScriptNovoRegistro write FScriptNovoRegistro;    property ListaParametrosNovoRegistro: TModelParameroScriptList read FListaParametrosNovoRegistro;        end;  implementation { TModelConfigProjetoScripts } constructor TModelConfigProjetoScripts.Create;begin  inherited Create;  FListaParametrosNovoRegistro := TModelParameroScriptList.Create(true);end; destructor TModelConfigProjetoScripts.Destroy;begin  FreeAndNil(FListaParametrosNovoRegistro);        inherited Destroy;end; procedure TModelConfigProjetoScripts.Clear;begin  FScriptSelect := '';  FScriptProximoID := '';  FScriptNovoRegistro := '';  ListaParametrosNovoRegistro.Clear;end;  end. 
This unit contains the main object


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} --- unit Model.ConfigProjeto; {$mode delphi}{$H+}{$M+} interface uses  Classes,  SysUtils,  Model.ConfigProjeto.PastasArquivos,  Model.ConfigProjeto.Scripts,  Model.ConfigProjeto.ConfigBD; type         { TModelConfigProjeto }  TModelParameroScriptList = Model.ConfigProjeto.Scripts.TModelParameroScriptList;  TModelParameroScript = Model.ConfigProjeto.Scripts.TModelParameroScript;  TModelConfigProjetoScripts = Model.ConfigProjeto.Scripts.TModelConfigProjetoScripts;  TModelConfigProjetoConfigBD = Model.ConfigProjeto.ConfigBD.TModelConfigProjetoConfigBD;   TModelConfigProjeto = class(TObject)  private    FNomeProjeto: string;        FArquivoProjeto: string;    FConfigBD: TModelConfigProjetoConfigBD;    FPastasArquivos: TModelConfigProjetoPastasArquivos;    FScriptsPermissoes: TModelConfigProjetoScripts;    FScriptsParametros: TModelConfigProjetoScripts;    FScriptsParametrosEmpresa: TModelConfigProjetoScripts;    FScriptsMenus: TModelConfigProjetoScripts;    FScriptsModulos: TModelConfigProjetoScripts;    FScriptsPermissoesModulos: TModelConfigProjetoScripts;                 procedure SetNomeProjeto(aValue: string);     class var FInstancia: TModelConfigProjeto;  public    constructor Create;    destructor Destroy; override;     procedure ClearObjects;    procedure LoadFromFile;    procedure SaveToFile;    procedure DeleteProjectFile;           class function GetInstancia: TModelConfigProjeto;  published    property NomeProjeto: string read FNomeProjeto write SetNomeProjeto;    property ArquivoProjeto: string read FArquivoProjeto;    property ConfigBD: TModelConfigProjetoConfigBD read FConfigBD write FConfigBD;    property PastasArquivos: TModelConfigProjetoPastasArquivos read FPastasArquivos write FPastasArquivos;    property ScriptsPermissoes: TModelConfigProjetoScripts read FScriptsPermissoes write FScriptsPermissoes;    property ScriptsParametros: TModelConfigProjetoScripts read FScriptsParametros write FScriptsParametros;    property ScriptsParametrosEmpresa: TModelConfigProjetoScripts read FScriptsParametrosEmpresa write FScriptsParametrosEmpresa;    property ScriptsMenus: TModelConfigProjetoScripts read FScriptsMenus write FScriptsMenus;    property ScriptsModulos: TModelConfigProjetoScripts read FScriptsModulos write FScriptsModulos;    property ScriptsPermissoesModulos: TModelConfigProjetoScripts read FScriptsPermissoesModulos write FScriptsPermissoesModulos;  end; implementation uses Model.FileUtils, DAO.JsonUtils, Dialogs, fpjson, fpjsonrtti; { TModelConfigProjeto } constructor TModelConfigProjeto.Create;begin  inherited Create;   FConfigBD := TModelConfigProjetoConfigBD.Create;  FPastasArquivos := TModelConfigProjetoPastasArquivos.Create;  FScriptsPermissoes := TModelConfigProjetoScripts.Create;  FScriptsParametros := TModelConfigProjetoScripts.Create;  FScriptsParametrosEmpresa := TModelConfigProjetoScripts.Create;  FScriptsMenus := TModelConfigProjetoScripts.Create;  FScriptsModulos := TModelConfigProjetoScripts.Create;  FScriptsPermissoesModulos := TModelConfigProjetoScripts.Create;end; destructor TModelConfigProjeto.Destroy;begin  FreeAndNil(FConfigBD);  FreeAndNil(FPastasArquivos);  FreeAndNil(FScriptsPermissoes);  FreeAndNil(FScriptsParametros);  FreeAndNil(FScriptsParametrosEmpresa);  FreeAndNil(FScriptsMenus);  FreeAndNil(FScriptsModulos);  FreeAndNil(FScriptsPermissoesModulos);         inherited Destroy;end; procedure TModelConfigProjeto.ClearObjects;begin  FConfigBD.Clear;  FPastasArquivos.Clear;  FScriptsPermissoes.Clear;  FScriptsParametros.Clear;  FScriptsParametrosEmpresa.Clear;  FScriptsMenus.Clear;  FScriptsModulos.Clear;  FScriptsPermissoesModulos.Clear;end; procedure TModelConfigProjeto.LoadFromFile;begin end; procedure TModelConfigProjeto.SaveToFile;var  _Json: TJSONStreamer;  _Arquivo: TMemoryStream;  _Conteudo: string;begin  _Json := TJSONStreamer.Create(nil);  try          _Arquivo := TMemoryStream.Create;    try      _Conteudo := _Json.ObjectToJSONString(Self);                  _Arquivo.Write(_Conteudo[1], Length(_Conteudo));      _Arquivo.SaveToFile(FArquivoProjeto);                finally      _Arquivo.Free;                end;        finally    _Json.Free;        end;end; procedure TModelConfigProjeto.DeleteProjectFile;begin        if FileExists(FArquivoProjeto) then        DeleteFile(FArquivoProjeto);   FNomeProjeto := '';        Self.ClearObjects;end; procedure TModelConfigProjeto.SetNomeProjeto(aValue: string);begin        if FNomeProjeto <> aValue then          FNomeProjeto := aValue;   FArquivoProjeto := TModelFileUtils.GetProjectFileName(FNomeProjeto);end; class function TModelConfigProjeto.GetInstancia: TModelConfigProjeto;begin        if FInstancia = nil then        FInstancia := TModelConfigProjeto.Create;   result := FInstancia;end; initialization        TModelConfigProjeto.FInstancia := nil; finalization        if TModelConfigProjeto.FInstancia <> nil then        FreeAndNil(TModelConfigProjeto.FInstancia); end. Thank's in advance  

PascalDragon:
With the RTTI one can (currently) only access properties that are declared as published. While the list objects themselves are declared as such in your code the Items and Count properties of the Generics.Collections.TObjectList<> are not. As such the RTTI is not enable to enumerate any sub objects in those lists. Even if you would declare a child class of TObjectList<> and declare the properties in question as published this still wouldn't work, because the streamer would have no way of knowing that the Count property describes the amount of elements in Items.

However not all hope is lost: TJSONStreamer contains the virtual method StreamClassProperty which you can use to hook in handling for custom types. Take the following example:


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---program tgenrtti; {$mode objfpc}{$H+} uses  SysUtils, Generics.Collections, fpjsonrtti, fpjson; type  {$push}  {$M+}  TTestObject = class  private    fField1: LongInt;    fField2: String;  published    property Field1: LongInt read fField1 write fField1;    property Field2: String read fField2 write fField2;  end;   TObjectListTestObject = specialize TObjectList<TTestObject>;   TTestContainer = class  private    fContainer: TObjectListTestObject;    fField1: String;  public    constructor Create;    destructor Destroy; override;  published    property Field1: String read fField1 write fField1;    property Container: TObjectListTestObject read fContainer;  end;  {$pop}   TMyStreamer = class(TJSONStreamer)  protected    function StreamClassProperty(const aObject: TObject): TJSONData; override;  end; { TMyStreamer } function TMyStreamer.StreamClassProperty(const aObject: TObject): TJSONData;var  arr: TJSONArray absolute Result;  olTestObject: TObjectListTestObject absolute aObject;  i: SizeInt;begin  if aObject is TObjectListTestObject then begin    Result := TJSONArray.Create;    for i := 0 to olTestObject.Count - 1 do begin      arr.Add(ObjectToJSON(olTestObject[i]));    end;  end else    Result := inherited StreamClassProperty(AObject);end; { TTestContainer } constructor TTestContainer.Create;begin  fContainer := TObjectListTestObject.Create;end; destructor TTestContainer.Destroy;begin  fContainer.Free;  inherited Destroy;end; var  c: TTestContainer;  o: TTestObject;  s: TJSONStreamer;begin  c := TTestContainer.Create;  try    c.Field1 := 'My Container';     o := TTestObject.Create;    o.Field1 := 42;    o.Field2 := 'Hello World';    c.Container.Add(o);     o := TTestObject.Create;    o.Field1 := 21;    o.Field2 := 'Foobar';    c.Container.Add(o);     s := TMyStreamer.Create(Nil);    try      Writeln(s.ObjectToJSONString(c));    finally      s.Free;    end;  finally    c.Free;  end;end.
The result will be this:


--- Code: ---PS D:\fpc\git> .\testoutput\tgenrtti.exe
{ "Container" : [{ "Field1" : 42, "Field2" : "Hello World" }, { "Field1" : 21, "Field2" : "Foobar" }], "Field1" : "My Container" }
--- End code ---

You'll need to do this for each specialization of TObjectList<> you have, though assuming you have no class that reimplements Free you could also simply cast to a TObjectList<TObject> and have the assignment code only once and only the is for each class:


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---function TMyStreamer.StreamClassProperty(const aObject: TObject): TJSONData;type  TObjectObjectList = specialize TObjectList<TObject>;var  arr: TJSONArray absolute Result;  ol: TObjectObjectList absolute aObject;  i: SizeInt;begin  if (aObject is TObjectListTestObject) or      (aObject is TObjectListWhatever) or      (aObject is TObjectListFoobar) then begin    Result := TJSONArray.Create;    for i := 0 to ol.Count - 1 do begin      arr.Add(ObjectToJSON(ol[i]));    end;  end else    Result := inherited StreamClassProperty(AObject);end;

LeoBruno:
Thank you very much!

LeoBruno:
I also need to load the object from Json string.

Can you help me?

Is the extended rtti far from completion?

Thanx again.



--- Quote from: PascalDragon on July 28, 2022, 09:40:09 am ---With the RTTI one can (currently) only access properties that are declared as published. While the list objects themselves are declared as such in your code the Items and Count properties of the Generics.Collections.TObjectList<> are not. As such the RTTI is not enable to enumerate any sub objects in those lists. Even if you would declare a child class of TObjectList<> and declare the properties in question as published this still wouldn't work, because the streamer would have no way of knowing that the Count property describes the amount of elements in Items.

However not all hope is lost: TJSONStreamer contains the virtual method StreamClassProperty which you can use to hook in handling for custom types. Take the following example:


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---program tgenrtti; {$mode objfpc}{$H+} uses  SysUtils, Generics.Collections, fpjsonrtti, fpjson; type  {$push}  {$M+}  TTestObject = class  private    fField1: LongInt;    fField2: String;  published    property Field1: LongInt read fField1 write fField1;    property Field2: String read fField2 write fField2;  end;   TObjectListTestObject = specialize TObjectList<TTestObject>;   TTestContainer = class  private    fContainer: TObjectListTestObject;    fField1: String;  public    constructor Create;    destructor Destroy; override;  published    property Field1: String read fField1 write fField1;    property Container: TObjectListTestObject read fContainer;  end;  {$pop}   TMyStreamer = class(TJSONStreamer)  protected    function StreamClassProperty(const aObject: TObject): TJSONData; override;  end; { TMyStreamer } function TMyStreamer.StreamClassProperty(const aObject: TObject): TJSONData;var  arr: TJSONArray absolute Result;  olTestObject: TObjectListTestObject absolute aObject;  i: SizeInt;begin  if aObject is TObjectListTestObject then begin    Result := TJSONArray.Create;    for i := 0 to olTestObject.Count - 1 do begin      arr.Add(ObjectToJSON(olTestObject[i]));    end;  end else    Result := inherited StreamClassProperty(AObject);end; { TTestContainer } constructor TTestContainer.Create;begin  fContainer := TObjectListTestObject.Create;end; destructor TTestContainer.Destroy;begin  fContainer.Free;  inherited Destroy;end; var  c: TTestContainer;  o: TTestObject;  s: TJSONStreamer;begin  c := TTestContainer.Create;  try    c.Field1 := 'My Container';     o := TTestObject.Create;    o.Field1 := 42;    o.Field2 := 'Hello World';    c.Container.Add(o);     o := TTestObject.Create;    o.Field1 := 21;    o.Field2 := 'Foobar';    c.Container.Add(o);     s := TMyStreamer.Create(Nil);    try      Writeln(s.ObjectToJSONString(c));    finally      s.Free;    end;  finally    c.Free;  end;end.
The result will be this:


--- Code: ---PS D:\fpc\git> .\testoutput\tgenrtti.exe
{ "Container" : [{ "Field1" : 42, "Field2" : "Hello World" }, { "Field1" : 21, "Field2" : "Foobar" }], "Field1" : "My Container" }
--- End code ---

You'll need to do this for each specialization of TObjectList<> you have, though assuming you have no class that reimplements Free you could also simply cast to a TObjectList<TObject> and have the assignment code only once and only the is for each class:


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---function TMyStreamer.StreamClassProperty(const aObject: TObject): TJSONData;type  TObjectObjectList = specialize TObjectList<TObject>;var  arr: TJSONArray absolute Result;  ol: TObjectObjectList absolute aObject;  i: SizeInt;begin  if (aObject is TObjectListTestObject) or      (aObject is TObjectListWhatever) or      (aObject is TObjectListFoobar) then begin    Result := TJSONArray.Create;    for i := 0 to ol.Count - 1 do begin      arr.Add(ObjectToJSON(ol[i]));    end;  end else    Result := inherited StreamClassProperty(AObject);end;
--- End quote ---

PascalDragon:

--- Quote from: LeoBruno on July 30, 2022, 06:25:21 pm ---I also need to load the object from Json string.

Can you help me?
--- End quote ---

For this you need to use TJSONDeStreamer correctly (see extended example below).


--- Quote from: LeoBruno on July 30, 2022, 06:25:21 pm ---Is the extended rtti far from completion?
--- End quote ---

The Extended RTTI wouldn't help here, also it's not even needed here, because everything you can stream with the normal RTTI you can destream with it as well (you just need to know how).


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---program tgenrtti; {$mode objfpc}{$H+} uses  SysUtils, Generics.Collections, fpjsonrtti, typinfo, fpjson; type  {$push}  {$M+}  TTestObject = class  private    fField1: LongInt;    fField2: String;  published    property Field1: LongInt read fField1 write fField1;    property Field2: String read fField2 write fField2;  end;   TObjectListTestObject = specialize TObjectList<TTestObject>;   TTestContainer = class  private    fContainer: TObjectListTestObject;    fField1: String;  public    constructor Create;    destructor Destroy; override;  published    property Field1: String read fField1 write fField1;    property Container: TObjectListTestObject read fContainer;  end;  {$pop}   TMyStreamer = class(TJSONStreamer)  protected    function StreamClassProperty(const aObject: TObject): TJSONData; override;  end;   { THandler }   THandler = class    procedure HandleRestoreProperty(aSender: TObject; aObject: TObject; aInfo: PPropInfo; aValue: TJSONData; var aHandled: Boolean);    procedure HandleGetObject(aSender: TObject; aObject: TObject; aInfo: PPropInfo; aData: TJSONObject; aDataName: TJSONStringType; var aValue: TObject);  end; { THandler } procedure THandler.HandleRestoreProperty(aSender: TObject; aObject: TObject;  aInfo: PPropInfo; aValue: TJSONData; var aHandled: Boolean);var  destrm: TJSONDeStreamer absolute aSender;  arr: TJSONArray absolute aValue;  list: TObjectListTestObject;  o: TTestObject;  i: SizeInt;begin  if not (aSender is TJSONDeStreamer) then    raise EJSONRTTI.Create('Sender has invalid type');   if aInfo^.PropType = TObjectListTestObject.ClassInfo then begin    if aValue is TJSONArray then begin      list := TObjectListTestObject(GetObjectProp(aObject, aInfo));      for i := 0 to arr.Count - 1 do begin        o := TTestObject.Create;        if not (arr[i] is TJSONObject) then          raise EJSONRTTI.CreateFmt('Element %d is not an object', [i]);        destrm.JSONToObject(TJSONObject(arr[i]), o);        list.Add(o);      end;      aHandled := True;    end;  end;end; procedure THandler.HandleGetObject(aSender: TObject; aObject: TObject;  aInfo: PPropInfo; aData: TJSONObject; aDataName: TJSONStringType;  var aValue: TObject);var  destrm: TJSONDeStreamer absolute aSender;begin  if not (aSender is TJSONDeStreamer) then    raise EJSONRTTI.Create('Sender has invalid type');   if aInfo^.PropType = TTestObject.ClassInfo then    aValue := TTestObject.Create;   if Assigned(aValue) then    destrm.JSONToObject(aData, aValue);end; { TMyStreamer } function TMyStreamer.StreamClassProperty(const aObject: TObject): TJSONData;var  arr: TJSONArray absolute Result;  olTestObject: TObjectListTestObject absolute aObject;  i: SizeInt;begin  if aObject is TObjectListTestObject then begin    Result := TJSONArray.Create;    for i := 0 to olTestObject.Count - 1 do begin      arr.Add(ObjectToJSON(olTestObject[i]));    end;  end else    Result := inherited StreamClassProperty(AObject);end; { TTestContainer } constructor TTestContainer.Create;begin  fContainer := TObjectListTestObject.Create;end; destructor TTestContainer.Destroy;begin  fContainer.Free;  inherited Destroy;end; var  c: TTestContainer;  o: TTestObject;  s: TJSONStreamer;  d: TJSONDeStreamer;  j: TJSONStringType;  i: SizeInt;  handler: THandler;begin  c := TTestContainer.Create;  try    c.Field1 := 'My Container';     o := TTestObject.Create;    o.Field1 := 42;    o.Field2 := 'Hello World';    c.Container.Add(o);     o := TTestObject.Create;    o.Field1 := 21;    o.Field2 := 'Foobar';    c.Container.Add(o);     s := TMyStreamer.Create(Nil);    try      j := s.ObjectToJSONString(c);      Writeln(j);    finally      s.Free;    end;     c.Free;    c := TTestContainer.Create;     handler := Nil;    d := TJSONDeStreamer.Create(Nil);    try      handler := THandler.Create;       { this is only needed if you have class type properties instead of only        primitive types as well }      //d.OnGetObject := @handler.HandleGetObject;      d.OnRestoreProperty := @handler.HandleRestoreProperty;       d.JSONToObject(j, c);    finally      handler.Free;      d.Free;    end;     Writeln('Field1: ', c.Field1);    Writeln('Count: ', c.Container.Count);    for i := 0 to c.Container.Count - 1 do begin      o := c.Container[i];      Writeln('   Element ', i, ':');      Writeln('      Field1: ', o.Field1);      Writeln('      Field2: ', o.Field2);    end;  finally    c.Free;  end;end.

Navigation

[0] Message Index

[#] Next page

Go to full version