Complex objects and JsonObjects

[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  [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.  

[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  [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]

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.

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;

[PascalDragon]

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]

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.

[PascalDragon]

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.

[Flea]

Hi, has this change been implemented/checked yet? Or is it due to be ?
Many Thanks