Recent

Author Topic: Complex objects and JsonObjects  (Read 1036 times)

LeoBruno

  • Jr. Member
  • **
  • Posts: 61
Complex objects and JsonObjects
« on: July 27, 2022, 10:57:22 pm »
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  [Select][+][-]
  1. unit Model.ConfigProjeto.Scripts;
  2.  
  3. {$mode delphi}{$H+}{$M+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes,
  9.   SysUtils,
  10.   Generics.Collections
  11. ;
  12.  
  13. type
  14.  
  15.         { TModelParameroScript }
  16.  
  17.   TModelParameroScript = class(TObject)
  18.   private
  19.     FNomeParametro: string;
  20.     FTipoParametro: string;
  21.   public
  22.   published
  23.           property NomeParametro: string read FNomeParametro write FNomeParametro;
  24.           property TipoParametro: string read FTipoParametro write FTipoParametro;
  25.         end;
  26.  
  27.   TModelParameroScriptList = TObjectList<TModelParameroScript>;
  28.  
  29.         { TModelConfigProjetoScripts }
  30.  
  31.   TModelConfigProjetoScripts = class(TObject)
  32.   private
  33.     FScriptSelect: string;
  34.     FScriptProximoID: string;
  35.     FScriptNovoRegistro: string;
  36.     FListaParametrosNovoRegistro: TModelParameroScriptList;
  37.   public
  38.     constructor Create;
  39.     destructor Destroy; override;
  40.  
  41.     procedure Clear;
  42.   published
  43.     property ScriptSelect: string read FScriptSelect write FScriptSelect;
  44.     property ScriptProximoID: string read FScriptProximoID write FScriptProximoID;
  45.     property ScriptNovoRegistro: string read FScriptNovoRegistro write FScriptNovoRegistro;
  46.     property ListaParametrosNovoRegistro: TModelParameroScriptList read FListaParametrosNovoRegistro;
  47.         end;
  48.  
  49.  
  50. implementation
  51.  
  52. { TModelConfigProjetoScripts }
  53.  
  54. constructor TModelConfigProjetoScripts.Create;
  55. begin
  56.   inherited Create;
  57.   FListaParametrosNovoRegistro := TModelParameroScriptList.Create(true);
  58. end;
  59.  
  60. destructor TModelConfigProjetoScripts.Destroy;
  61. begin
  62.   FreeAndNil(FListaParametrosNovoRegistro);
  63.         inherited Destroy;
  64. end;
  65.  
  66. procedure TModelConfigProjetoScripts.Clear;
  67. begin
  68.   FScriptSelect := '';
  69.   FScriptProximoID := '';
  70.   FScriptNovoRegistro := '';
  71.   ListaParametrosNovoRegistro.Clear;
  72. end;
  73.  
  74.  
  75. end.
  76.  

This unit contains the main object

Code: Pascal  [Select][+][-]
  1.  
  2. unit Model.ConfigProjeto;
  3.  
  4. {$mode delphi}{$H+}{$M+}
  5.  
  6. interface
  7.  
  8. uses
  9.   Classes,
  10.   SysUtils,
  11.   Model.ConfigProjeto.PastasArquivos,
  12.   Model.ConfigProjeto.Scripts,
  13.   Model.ConfigProjeto.ConfigBD
  14. ;
  15.  
  16. type
  17.  
  18.         { TModelConfigProjeto }
  19.   TModelParameroScriptList = Model.ConfigProjeto.Scripts.TModelParameroScriptList;
  20.   TModelParameroScript = Model.ConfigProjeto.Scripts.TModelParameroScript;
  21.   TModelConfigProjetoScripts = Model.ConfigProjeto.Scripts.TModelConfigProjetoScripts;
  22.   TModelConfigProjetoConfigBD = Model.ConfigProjeto.ConfigBD.TModelConfigProjetoConfigBD;
  23.  
  24.   TModelConfigProjeto = class(TObject)
  25.   private
  26.     FNomeProjeto: string;
  27.         FArquivoProjeto: string;
  28.     FConfigBD: TModelConfigProjetoConfigBD;
  29.     FPastasArquivos: TModelConfigProjetoPastasArquivos;
  30.     FScriptsPermissoes: TModelConfigProjetoScripts;
  31.     FScriptsParametros: TModelConfigProjetoScripts;
  32.     FScriptsParametrosEmpresa: TModelConfigProjetoScripts;
  33.     FScriptsMenus: TModelConfigProjetoScripts;
  34.     FScriptsModulos: TModelConfigProjetoScripts;
  35.     FScriptsPermissoesModulos: TModelConfigProjetoScripts;
  36.  
  37.                 procedure SetNomeProjeto(aValue: string);
  38.  
  39.     class var FInstancia: TModelConfigProjeto;
  40.   public
  41.     constructor Create;
  42.     destructor Destroy; override;
  43.  
  44.     procedure ClearObjects;
  45.     procedure LoadFromFile;
  46.     procedure SaveToFile;
  47.     procedure DeleteProjectFile;
  48.  
  49.           class function GetInstancia: TModelConfigProjeto;
  50.   published
  51.     property NomeProjeto: string read FNomeProjeto write SetNomeProjeto;
  52.     property ArquivoProjeto: string read FArquivoProjeto;
  53.     property ConfigBD: TModelConfigProjetoConfigBD read FConfigBD write FConfigBD;
  54.     property PastasArquivos: TModelConfigProjetoPastasArquivos read FPastasArquivos write FPastasArquivos;
  55.     property ScriptsPermissoes: TModelConfigProjetoScripts read FScriptsPermissoes write FScriptsPermissoes;
  56.     property ScriptsParametros: TModelConfigProjetoScripts read FScriptsParametros write FScriptsParametros;
  57.     property ScriptsParametrosEmpresa: TModelConfigProjetoScripts read FScriptsParametrosEmpresa write FScriptsParametrosEmpresa;
  58.     property ScriptsMenus: TModelConfigProjetoScripts read FScriptsMenus write FScriptsMenus;
  59.     property ScriptsModulos: TModelConfigProjetoScripts read FScriptsModulos write FScriptsModulos;
  60.     property ScriptsPermissoesModulos: TModelConfigProjetoScripts read FScriptsPermissoesModulos write FScriptsPermissoesModulos;
  61.   end;
  62.  
  63. implementation
  64.  
  65. uses
  66.  Model.FileUtils,
  67.  DAO.JsonUtils,
  68.  Dialogs,
  69.  fpjson,
  70.  fpjsonrtti
  71. ;
  72.  
  73. { TModelConfigProjeto }
  74.  
  75. constructor TModelConfigProjeto.Create;
  76. begin
  77.   inherited Create;
  78.  
  79.   FConfigBD := TModelConfigProjetoConfigBD.Create;
  80.   FPastasArquivos := TModelConfigProjetoPastasArquivos.Create;
  81.   FScriptsPermissoes := TModelConfigProjetoScripts.Create;
  82.   FScriptsParametros := TModelConfigProjetoScripts.Create;
  83.   FScriptsParametrosEmpresa := TModelConfigProjetoScripts.Create;
  84.   FScriptsMenus := TModelConfigProjetoScripts.Create;
  85.   FScriptsModulos := TModelConfigProjetoScripts.Create;
  86.   FScriptsPermissoesModulos := TModelConfigProjetoScripts.Create;
  87. end;
  88.  
  89. destructor TModelConfigProjeto.Destroy;
  90. begin
  91.   FreeAndNil(FConfigBD);
  92.   FreeAndNil(FPastasArquivos);
  93.   FreeAndNil(FScriptsPermissoes);
  94.   FreeAndNil(FScriptsParametros);
  95.   FreeAndNil(FScriptsParametrosEmpresa);
  96.   FreeAndNil(FScriptsMenus);
  97.   FreeAndNil(FScriptsModulos);
  98.   FreeAndNil(FScriptsPermissoesModulos);
  99.  
  100.         inherited Destroy;
  101. end;
  102.  
  103. procedure TModelConfigProjeto.ClearObjects;
  104. begin
  105.   FConfigBD.Clear;
  106.   FPastasArquivos.Clear;
  107.   FScriptsPermissoes.Clear;
  108.   FScriptsParametros.Clear;
  109.   FScriptsParametrosEmpresa.Clear;
  110.   FScriptsMenus.Clear;
  111.   FScriptsModulos.Clear;
  112.   FScriptsPermissoesModulos.Clear;
  113. end;
  114.  
  115. procedure TModelConfigProjeto.LoadFromFile;
  116. begin
  117.  
  118. end;
  119.  
  120. procedure TModelConfigProjeto.SaveToFile;
  121. var
  122.   _Json: TJSONStreamer;
  123.   _Arquivo: TMemoryStream;
  124.   _Conteudo: string;
  125. begin
  126.   _Json := TJSONStreamer.Create(nil);
  127.   try
  128.           _Arquivo := TMemoryStream.Create;
  129.     try
  130.       _Conteudo := _Json.ObjectToJSONString(Self);
  131.                   _Arquivo.Write(_Conteudo[1], Length(_Conteudo));
  132.       _Arquivo.SaveToFile(FArquivoProjeto);
  133.                 finally
  134.       _Arquivo.Free;
  135.                 end;
  136.         finally
  137.     _Json.Free;
  138.         end;
  139. end;
  140.  
  141. procedure TModelConfigProjeto.DeleteProjectFile;
  142. begin
  143.         if FileExists(FArquivoProjeto) then
  144.         DeleteFile(FArquivoProjeto);
  145.  
  146.   FNomeProjeto := '';
  147.         Self.ClearObjects;
  148. end;
  149.  
  150. procedure TModelConfigProjeto.SetNomeProjeto(aValue: string);
  151. begin
  152.         if FNomeProjeto <> aValue then
  153.           FNomeProjeto := aValue;
  154.  
  155.   FArquivoProjeto := TModelFileUtils.GetProjectFileName(FNomeProjeto);
  156. end;
  157.  
  158. class function TModelConfigProjeto.GetInstancia: TModelConfigProjeto;
  159. begin
  160.         if FInstancia = nil then
  161.         FInstancia := TModelConfigProjeto.Create;
  162.  
  163.   result := FInstancia;
  164. end;
  165.  
  166. initialization
  167.         TModelConfigProjeto.FInstancia := nil;
  168.  
  169. finalization
  170.         if TModelConfigProjeto.FInstancia <> nil then
  171.         FreeAndNil(TModelConfigProjeto.FInstancia);
  172.  
  173. end.
  174.  
  175. Thank's in advance
  176.  
  177.  


Lazarus 2.2.2 FPC 3.2.2 Windows (qt5) Anchor Docking

PascalDragon

  • Hero Member
  • *****
  • Posts: 4540
  • Compiler Developer
Re: Complex objects and JsonObjects
« Reply #1 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  [Select][+][-]
  1. program tgenrtti;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. uses
  6.   SysUtils, Generics.Collections, fpjsonrtti, fpjson;
  7.  
  8. type
  9.   {$push}
  10.   {$M+}
  11.   TTestObject = class
  12.   private
  13.     fField1: LongInt;
  14.     fField2: String;
  15.   published
  16.     property Field1: LongInt read fField1 write fField1;
  17.     property Field2: String read fField2 write fField2;
  18.   end;
  19.  
  20.   TObjectListTestObject = specialize TObjectList<TTestObject>;
  21.  
  22.   TTestContainer = class
  23.   private
  24.     fContainer: TObjectListTestObject;
  25.     fField1: String;
  26.   public
  27.     constructor Create;
  28.     destructor Destroy; override;
  29.   published
  30.     property Field1: String read fField1 write fField1;
  31.     property Container: TObjectListTestObject read fContainer;
  32.   end;
  33.   {$pop}
  34.  
  35.   TMyStreamer = class(TJSONStreamer)
  36.   protected
  37.     function StreamClassProperty(const aObject: TObject): TJSONData; override;
  38.   end;
  39.  
  40. { TMyStreamer }
  41.  
  42. function TMyStreamer.StreamClassProperty(const aObject: TObject): TJSONData;
  43. var
  44.   arr: TJSONArray absolute Result;
  45.   olTestObject: TObjectListTestObject absolute aObject;
  46.   i: SizeInt;
  47. begin
  48.   if aObject is TObjectListTestObject then begin
  49.     Result := TJSONArray.Create;
  50.     for i := 0 to olTestObject.Count - 1 do begin
  51.       arr.Add(ObjectToJSON(olTestObject[i]));
  52.     end;
  53.   end else
  54.     Result := inherited StreamClassProperty(AObject);
  55. end;
  56.  
  57. { TTestContainer }
  58.  
  59. constructor TTestContainer.Create;
  60. begin
  61.   fContainer := TObjectListTestObject.Create;
  62. end;
  63.  
  64. destructor TTestContainer.Destroy;
  65. begin
  66.   fContainer.Free;
  67.   inherited Destroy;
  68. end;
  69.  
  70. var
  71.   c: TTestContainer;
  72.   o: TTestObject;
  73.   s: TJSONStreamer;
  74. begin
  75.   c := TTestContainer.Create;
  76.   try
  77.     c.Field1 := 'My Container';
  78.  
  79.     o := TTestObject.Create;
  80.     o.Field1 := 42;
  81.     o.Field2 := 'Hello World';
  82.     c.Container.Add(o);
  83.  
  84.     o := TTestObject.Create;
  85.     o.Field1 := 21;
  86.     o.Field2 := 'Foobar';
  87.     c.Container.Add(o);
  88.  
  89.     s := TMyStreamer.Create(Nil);
  90.     try
  91.       Writeln(s.ObjectToJSONString(c));
  92.     finally
  93.       s.Free;
  94.     end;
  95.   finally
  96.     c.Free;
  97.   end;
  98. end.

The result will be this:

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

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  [Select][+][-]
  1. function TMyStreamer.StreamClassProperty(const aObject: TObject): TJSONData;
  2. type
  3.   TObjectObjectList = specialize TObjectList<TObject>;
  4. var
  5.   arr: TJSONArray absolute Result;
  6.   ol: TObjectObjectList absolute aObject;
  7.   i: SizeInt;
  8. begin
  9.   if (aObject is TObjectListTestObject) or
  10.       (aObject is TObjectListWhatever) or
  11.       (aObject is TObjectListFoobar) then begin
  12.     Result := TJSONArray.Create;
  13.     for i := 0 to ol.Count - 1 do begin
  14.       arr.Add(ObjectToJSON(ol[i]));
  15.     end;
  16.   end else
  17.     Result := inherited StreamClassProperty(AObject);
  18. end;

LeoBruno

  • Jr. Member
  • **
  • Posts: 61
Re: Complex objects and JsonObjects
« Reply #2 on: July 29, 2022, 09:14:32 pm »
Thank you very much!
Lazarus 2.2.2 FPC 3.2.2 Windows (qt5) Anchor Docking

LeoBruno

  • Jr. Member
  • **
  • Posts: 61
Re: Complex objects and JsonObjects
« Reply #3 on: July 30, 2022, 06:25:21 pm »
I also need to load the object from Json string.

Can you help me?

Is the extended rtti far from completion?

Thanx again.


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  [Select][+][-]
  1. program tgenrtti;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. uses
  6.   SysUtils, Generics.Collections, fpjsonrtti, fpjson;
  7.  
  8. type
  9.   {$push}
  10.   {$M+}
  11.   TTestObject = class
  12.   private
  13.     fField1: LongInt;
  14.     fField2: String;
  15.   published
  16.     property Field1: LongInt read fField1 write fField1;
  17.     property Field2: String read fField2 write fField2;
  18.   end;
  19.  
  20.   TObjectListTestObject = specialize TObjectList<TTestObject>;
  21.  
  22.   TTestContainer = class
  23.   private
  24.     fContainer: TObjectListTestObject;
  25.     fField1: String;
  26.   public
  27.     constructor Create;
  28.     destructor Destroy; override;
  29.   published
  30.     property Field1: String read fField1 write fField1;
  31.     property Container: TObjectListTestObject read fContainer;
  32.   end;
  33.   {$pop}
  34.  
  35.   TMyStreamer = class(TJSONStreamer)
  36.   protected
  37.     function StreamClassProperty(const aObject: TObject): TJSONData; override;
  38.   end;
  39.  
  40. { TMyStreamer }
  41.  
  42. function TMyStreamer.StreamClassProperty(const aObject: TObject): TJSONData;
  43. var
  44.   arr: TJSONArray absolute Result;
  45.   olTestObject: TObjectListTestObject absolute aObject;
  46.   i: SizeInt;
  47. begin
  48.   if aObject is TObjectListTestObject then begin
  49.     Result := TJSONArray.Create;
  50.     for i := 0 to olTestObject.Count - 1 do begin
  51.       arr.Add(ObjectToJSON(olTestObject[i]));
  52.     end;
  53.   end else
  54.     Result := inherited StreamClassProperty(AObject);
  55. end;
  56.  
  57. { TTestContainer }
  58.  
  59. constructor TTestContainer.Create;
  60. begin
  61.   fContainer := TObjectListTestObject.Create;
  62. end;
  63.  
  64. destructor TTestContainer.Destroy;
  65. begin
  66.   fContainer.Free;
  67.   inherited Destroy;
  68. end;
  69.  
  70. var
  71.   c: TTestContainer;
  72.   o: TTestObject;
  73.   s: TJSONStreamer;
  74. begin
  75.   c := TTestContainer.Create;
  76.   try
  77.     c.Field1 := 'My Container';
  78.  
  79.     o := TTestObject.Create;
  80.     o.Field1 := 42;
  81.     o.Field2 := 'Hello World';
  82.     c.Container.Add(o);
  83.  
  84.     o := TTestObject.Create;
  85.     o.Field1 := 21;
  86.     o.Field2 := 'Foobar';
  87.     c.Container.Add(o);
  88.  
  89.     s := TMyStreamer.Create(Nil);
  90.     try
  91.       Writeln(s.ObjectToJSONString(c));
  92.     finally
  93.       s.Free;
  94.     end;
  95.   finally
  96.     c.Free;
  97.   end;
  98. end.

The result will be this:

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

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  [Select][+][-]
  1. function TMyStreamer.StreamClassProperty(const aObject: TObject): TJSONData;
  2. type
  3.   TObjectObjectList = specialize TObjectList<TObject>;
  4. var
  5.   arr: TJSONArray absolute Result;
  6.   ol: TObjectObjectList absolute aObject;
  7.   i: SizeInt;
  8. begin
  9.   if (aObject is TObjectListTestObject) or
  10.       (aObject is TObjectListWhatever) or
  11.       (aObject is TObjectListFoobar) then begin
  12.     Result := TJSONArray.Create;
  13.     for i := 0 to ol.Count - 1 do begin
  14.       arr.Add(ObjectToJSON(ol[i]));
  15.     end;
  16.   end else
  17.     Result := inherited StreamClassProperty(AObject);
  18. end;
Lazarus 2.2.2 FPC 3.2.2 Windows (qt5) Anchor Docking

PascalDragon

  • Hero Member
  • *****
  • Posts: 4540
  • Compiler Developer
Re: Complex objects and JsonObjects
« Reply #4 on: July 31, 2022, 02:13:16 pm »
I also need to load the object from Json string.

Can you help me?

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

Is the extended rtti far from completion?

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  [Select][+][-]
  1. program tgenrtti;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. uses
  6.   SysUtils, Generics.Collections, fpjsonrtti, typinfo, fpjson;
  7.  
  8. type
  9.   {$push}
  10.   {$M+}
  11.   TTestObject = class
  12.   private
  13.     fField1: LongInt;
  14.     fField2: String;
  15.   published
  16.     property Field1: LongInt read fField1 write fField1;
  17.     property Field2: String read fField2 write fField2;
  18.   end;
  19.  
  20.   TObjectListTestObject = specialize TObjectList<TTestObject>;
  21.  
  22.   TTestContainer = class
  23.   private
  24.     fContainer: TObjectListTestObject;
  25.     fField1: String;
  26.   public
  27.     constructor Create;
  28.     destructor Destroy; override;
  29.   published
  30.     property Field1: String read fField1 write fField1;
  31.     property Container: TObjectListTestObject read fContainer;
  32.   end;
  33.   {$pop}
  34.  
  35.   TMyStreamer = class(TJSONStreamer)
  36.   protected
  37.     function StreamClassProperty(const aObject: TObject): TJSONData; override;
  38.   end;
  39.  
  40.   { THandler }
  41.  
  42.   THandler = class
  43.     procedure HandleRestoreProperty(aSender: TObject; aObject: TObject; aInfo: PPropInfo; aValue: TJSONData; var aHandled: Boolean);
  44.     procedure HandleGetObject(aSender: TObject; aObject: TObject; aInfo: PPropInfo; aData: TJSONObject; aDataName: TJSONStringType; var aValue: TObject);
  45.   end;
  46.  
  47. { THandler }
  48.  
  49. procedure THandler.HandleRestoreProperty(aSender: TObject; aObject: TObject;
  50.   aInfo: PPropInfo; aValue: TJSONData; var aHandled: Boolean);
  51. var
  52.   destrm: TJSONDeStreamer absolute aSender;
  53.   arr: TJSONArray absolute aValue;
  54.   list: TObjectListTestObject;
  55.   o: TTestObject;
  56.   i: SizeInt;
  57. begin
  58.   if not (aSender is TJSONDeStreamer) then
  59.     raise EJSONRTTI.Create('Sender has invalid type');
  60.  
  61.   if aInfo^.PropType = TObjectListTestObject.ClassInfo then begin
  62.     if aValue is TJSONArray then begin
  63.       list := TObjectListTestObject(GetObjectProp(aObject, aInfo));
  64.       for i := 0 to arr.Count - 1 do begin
  65.         o := TTestObject.Create;
  66.         if not (arr[i] is TJSONObject) then
  67.           raise EJSONRTTI.CreateFmt('Element %d is not an object', [i]);
  68.         destrm.JSONToObject(TJSONObject(arr[i]), o);
  69.         list.Add(o);
  70.       end;
  71.       aHandled := True;
  72.     end;
  73.   end;
  74. end;
  75.  
  76. procedure THandler.HandleGetObject(aSender: TObject; aObject: TObject;
  77.   aInfo: PPropInfo; aData: TJSONObject; aDataName: TJSONStringType;
  78.   var aValue: TObject);
  79. var
  80.   destrm: TJSONDeStreamer absolute aSender;
  81. begin
  82.   if not (aSender is TJSONDeStreamer) then
  83.     raise EJSONRTTI.Create('Sender has invalid type');
  84.  
  85.   if aInfo^.PropType = TTestObject.ClassInfo then
  86.     aValue := TTestObject.Create;
  87.  
  88.   if Assigned(aValue) then
  89.     destrm.JSONToObject(aData, aValue);
  90. end;
  91.  
  92. { TMyStreamer }
  93.  
  94. function TMyStreamer.StreamClassProperty(const aObject: TObject): TJSONData;
  95. var
  96.   arr: TJSONArray absolute Result;
  97.   olTestObject: TObjectListTestObject absolute aObject;
  98.   i: SizeInt;
  99. begin
  100.   if aObject is TObjectListTestObject then begin
  101.     Result := TJSONArray.Create;
  102.     for i := 0 to olTestObject.Count - 1 do begin
  103.       arr.Add(ObjectToJSON(olTestObject[i]));
  104.     end;
  105.   end else
  106.     Result := inherited StreamClassProperty(AObject);
  107. end;
  108.  
  109. { TTestContainer }
  110.  
  111. constructor TTestContainer.Create;
  112. begin
  113.   fContainer := TObjectListTestObject.Create;
  114. end;
  115.  
  116. destructor TTestContainer.Destroy;
  117. begin
  118.   fContainer.Free;
  119.   inherited Destroy;
  120. end;
  121.  
  122. var
  123.   c: TTestContainer;
  124.   o: TTestObject;
  125.   s: TJSONStreamer;
  126.   d: TJSONDeStreamer;
  127.   j: TJSONStringType;
  128.   i: SizeInt;
  129.   handler: THandler;
  130. begin
  131.   c := TTestContainer.Create;
  132.   try
  133.     c.Field1 := 'My Container';
  134.  
  135.     o := TTestObject.Create;
  136.     o.Field1 := 42;
  137.     o.Field2 := 'Hello World';
  138.     c.Container.Add(o);
  139.  
  140.     o := TTestObject.Create;
  141.     o.Field1 := 21;
  142.     o.Field2 := 'Foobar';
  143.     c.Container.Add(o);
  144.  
  145.     s := TMyStreamer.Create(Nil);
  146.     try
  147.       j := s.ObjectToJSONString(c);
  148.       Writeln(j);
  149.     finally
  150.       s.Free;
  151.     end;
  152.  
  153.     c.Free;
  154.     c := TTestContainer.Create;
  155.  
  156.     handler := Nil;
  157.     d := TJSONDeStreamer.Create(Nil);
  158.     try
  159.       handler := THandler.Create;
  160.  
  161.       { this is only needed if you have class type properties instead of only
  162.         primitive types as well }
  163.       //d.OnGetObject := @handler.HandleGetObject;
  164.       d.OnRestoreProperty := @handler.HandleRestoreProperty;
  165.  
  166.       d.JSONToObject(j, c);
  167.     finally
  168.       handler.Free;
  169.       d.Free;
  170.     end;
  171.  
  172.     Writeln('Field1: ', c.Field1);
  173.     Writeln('Count: ', c.Container.Count);
  174.     for i := 0 to c.Container.Count - 1 do begin
  175.       o := c.Container[i];
  176.       Writeln('   Element ', i, ':');
  177.       Writeln('      Field1: ', o.Field1);
  178.       Writeln('      Field2: ', o.Field2);
  179.     end;
  180.   finally
  181.     c.Free;
  182.   end;
  183. end.

LeoBruno

  • Jr. Member
  • **
  • Posts: 61
Re: Complex objects and JsonObjects
« Reply #5 on: July 31, 2022, 07:44:39 pm »
This is amazing!

Thank you very much!

When I asked about the completion of the extended RTTI, I was not thinking about this issue specifically.

Regards....

I also need to load the object from Json string.

Can you help me?

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

Is the extended rtti far from completion?

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  [Select][+][-]
  1. program tgenrtti;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. uses
  6.   SysUtils, Generics.Collections, fpjsonrtti, typinfo, fpjson;
  7.  
  8. type
  9.   {$push}
  10.   {$M+}
  11.   TTestObject = class
  12.   private
  13.     fField1: LongInt;
  14.     fField2: String;
  15.   published
  16.     property Field1: LongInt read fField1 write fField1;
  17.     property Field2: String read fField2 write fField2;
  18.   end;
  19.  
  20.   TObjectListTestObject = specialize TObjectList<TTestObject>;
  21.  
  22.   TTestContainer = class
  23.   private
  24.     fContainer: TObjectListTestObject;
  25.     fField1: String;
  26.   public
  27.     constructor Create;
  28.     destructor Destroy; override;
  29.   published
  30.     property Field1: String read fField1 write fField1;
  31.     property Container: TObjectListTestObject read fContainer;
  32.   end;
  33.   {$pop}
  34.  
  35.   TMyStreamer = class(TJSONStreamer)
  36.   protected
  37.     function StreamClassProperty(const aObject: TObject): TJSONData; override;
  38.   end;
  39.  
  40.   { THandler }
  41.  
  42.   THandler = class
  43.     procedure HandleRestoreProperty(aSender: TObject; aObject: TObject; aInfo: PPropInfo; aValue: TJSONData; var aHandled: Boolean);
  44.     procedure HandleGetObject(aSender: TObject; aObject: TObject; aInfo: PPropInfo; aData: TJSONObject; aDataName: TJSONStringType; var aValue: TObject);
  45.   end;
  46.  
  47. { THandler }
  48.  
  49. procedure THandler.HandleRestoreProperty(aSender: TObject; aObject: TObject;
  50.   aInfo: PPropInfo; aValue: TJSONData; var aHandled: Boolean);
  51. var
  52.   destrm: TJSONDeStreamer absolute aSender;
  53.   arr: TJSONArray absolute aValue;
  54.   list: TObjectListTestObject;
  55.   o: TTestObject;
  56.   i: SizeInt;
  57. begin
  58.   if not (aSender is TJSONDeStreamer) then
  59.     raise EJSONRTTI.Create('Sender has invalid type');
  60.  
  61.   if aInfo^.PropType = TObjectListTestObject.ClassInfo then begin
  62.     if aValue is TJSONArray then begin
  63.       list := TObjectListTestObject(GetObjectProp(aObject, aInfo));
  64.       for i := 0 to arr.Count - 1 do begin
  65.         o := TTestObject.Create;
  66.         if not (arr[i] is TJSONObject) then
  67.           raise EJSONRTTI.CreateFmt('Element %d is not an object', [i]);
  68.         destrm.JSONToObject(TJSONObject(arr[i]), o);
  69.         list.Add(o);
  70.       end;
  71.       aHandled := True;
  72.     end;
  73.   end;
  74. end;
  75.  
  76. procedure THandler.HandleGetObject(aSender: TObject; aObject: TObject;
  77.   aInfo: PPropInfo; aData: TJSONObject; aDataName: TJSONStringType;
  78.   var aValue: TObject);
  79. var
  80.   destrm: TJSONDeStreamer absolute aSender;
  81. begin
  82.   if not (aSender is TJSONDeStreamer) then
  83.     raise EJSONRTTI.Create('Sender has invalid type');
  84.  
  85.   if aInfo^.PropType = TTestObject.ClassInfo then
  86.     aValue := TTestObject.Create;
  87.  
  88.   if Assigned(aValue) then
  89.     destrm.JSONToObject(aData, aValue);
  90. end;
  91.  
  92. { TMyStreamer }
  93.  
  94. function TMyStreamer.StreamClassProperty(const aObject: TObject): TJSONData;
  95. var
  96.   arr: TJSONArray absolute Result;
  97.   olTestObject: TObjectListTestObject absolute aObject;
  98.   i: SizeInt;
  99. begin
  100.   if aObject is TObjectListTestObject then begin
  101.     Result := TJSONArray.Create;
  102.     for i := 0 to olTestObject.Count - 1 do begin
  103.       arr.Add(ObjectToJSON(olTestObject[i]));
  104.     end;
  105.   end else
  106.     Result := inherited StreamClassProperty(AObject);
  107. end;
  108.  
  109. { TTestContainer }
  110.  
  111. constructor TTestContainer.Create;
  112. begin
  113.   fContainer := TObjectListTestObject.Create;
  114. end;
  115.  
  116. destructor TTestContainer.Destroy;
  117. begin
  118.   fContainer.Free;
  119.   inherited Destroy;
  120. end;
  121.  
  122. var
  123.   c: TTestContainer;
  124.   o: TTestObject;
  125.   s: TJSONStreamer;
  126.   d: TJSONDeStreamer;
  127.   j: TJSONStringType;
  128.   i: SizeInt;
  129.   handler: THandler;
  130. begin
  131.   c := TTestContainer.Create;
  132.   try
  133.     c.Field1 := 'My Container';
  134.  
  135.     o := TTestObject.Create;
  136.     o.Field1 := 42;
  137.     o.Field2 := 'Hello World';
  138.     c.Container.Add(o);
  139.  
  140.     o := TTestObject.Create;
  141.     o.Field1 := 21;
  142.     o.Field2 := 'Foobar';
  143.     c.Container.Add(o);
  144.  
  145.     s := TMyStreamer.Create(Nil);
  146.     try
  147.       j := s.ObjectToJSONString(c);
  148.       Writeln(j);
  149.     finally
  150.       s.Free;
  151.     end;
  152.  
  153.     c.Free;
  154.     c := TTestContainer.Create;
  155.  
  156.     handler := Nil;
  157.     d := TJSONDeStreamer.Create(Nil);
  158.     try
  159.       handler := THandler.Create;
  160.  
  161.       { this is only needed if you have class type properties instead of only
  162.         primitive types as well }
  163.       //d.OnGetObject := @handler.HandleGetObject;
  164.       d.OnRestoreProperty := @handler.HandleRestoreProperty;
  165.  
  166.       d.JSONToObject(j, c);
  167.     finally
  168.       handler.Free;
  169.       d.Free;
  170.     end;
  171.  
  172.     Writeln('Field1: ', c.Field1);
  173.     Writeln('Count: ', c.Container.Count);
  174.     for i := 0 to c.Container.Count - 1 do begin
  175.       o := c.Container[i];
  176.       Writeln('   Element ', i, ':');
  177.       Writeln('      Field1: ', o.Field1);
  178.       Writeln('      Field2: ', o.Field2);
  179.     end;
  180.   finally
  181.     c.Free;
  182.   end;
  183. end.
Lazarus 2.2.2 FPC 3.2.2 Windows (qt5) Anchor Docking

PascalDragon

  • Hero Member
  • *****
  • Posts: 4540
  • Compiler Developer
Re: Complex objects and JsonObjects
« Reply #6 on: August 01, 2022, 01:10:47 pm »
When I asked about the completion of the extended RTTI, I was not thinking about this issue specifically.

There already exists a finished merge request for it, but I need to find the time to review it.

 

TinyPortal © 2005-2018