📜 ⬆️ ⬇️

MindStream. How do we write software under FireMonkey. Part 4 Serialization

Part 1 .
Part 2 .
Part 3. DUnit + FireMonkey .
Part 3.1. Based on GUIRunner .

Back at the beginning of my hobbies, I liked working with files. The job, however, was mainly to read the input data and record the results. Next was the work with the database, the files I used less and less. Maximum IniFile sometimes. Therefore, the serialization task was quite interesting for me.

Today I will talk about how we added serialization to our program, what difficulties arose and how we overcame them. Since the material is no longer new, it is more likely for beginners. Although some tricks will be able to draw criticize everything.
')
image



The very concept of “serialization” is very well spelled out by gunsmoker in his blog .

I stopped on serialization in a JSON format . Why json? It is readable (I use the plug-in for Notepad ++), it allows you to describe complex data structures, and finally, Rad Studio XE7 has support for JSON from the “box”.

To begin with, we will write a small prototype whose task will be to save an object:
... type TmsShape = class private fInt: integer; fStr: String; public constructor Create(const aInt: integer; const aStr: String); end; constructor TmsShape.Create(const aInt: integer; const aStr: String); begin inherited fInt := aInt; fStr := aStr; end; procedure TForm2.btSaveJsonClick(Sender: TObject); var l_Marshal: TJSONMarshal; l_Json: TJSONObject; l_Shape1: TmsShape; l_StringList: TStringList; begin try l_Shape1 := TmsShape.Create(1, 'First'); l_Marshal := TJSONMarshal.Create; l_StringList := TStringList.Create; l_Json := l_Marshal.Marshal(l_Shape1) as TJSONObject; Memo1.Lines.Text := l_Json.tostring; l_StringList.Add(l_Json.tostring); l_StringList.SaveToFile(_FileNameSave); finally FreeAndNil(l_Marshal); FreeAndNil(l_StringList); FreeAndNil(l_Json); FreeAndNil(l_Shape1); end; end; 

As a result, we get the following file:
 { "type": "uMain.TmsShape", "id": 1, "fields": { "fInt": 1, "fStr": "First" } } 

The next step is to serialize the list of TmsShape shapes; for this we will add a new class, which will have a “list” field:
 ... type TmsShapeContainer = class private fList: TList<TmsShape>; public constructor Create; destructor Destroy; end; constructor TmsShapeContainer.Create; begin inherited; fList := TList<TmsShape>.Create; end; destructor TmsShapeContainer.Destroy; begin FreeAndNil(fList); inherited; end; 

Add the creation of the container to the save code and add 2 objects to it, and also change the marshaling call parameter (the difference between marshaling and serialization is described in GunSmoker’s article):
 … l_msShapeContainer := TmsShapeContainer.Create; l_msShapeContainer.fList.Add(l_Shape1); l_msShapeContainer.fList.Add(l_Shape2); … l_Json := l_Marshal.Marshal(l_msShapeContainer) as TJSONObject; ... 

The rest of the code has not changed.
At the output we get the following file:
 { "type": "uMain.TmsShapeContainer", "id": 1, "fields": { "fList": { "type": "System.Generics.Collections.TList<uMain.TmsShape>", "id": 2, "fields": { "FItems": [{ "type": "uMain.TmsShape", "id": 3, "fields": { "fInt": 1, "fStr": "First" } }, { "type": "uMain.TmsShape", "id": 4, "fields": { "fInt": 2, "fStr": "Second" } }], "FCount": 2, "FArrayManager": { "type": "System.Generics.Collections.TMoveArrayManager<uMain.TmsShape>", "id": 5, "fields": { } } } } } } 

As you can see, the file got too much unnecessary information. This is due to the peculiarities of the implementation of processing objects for marshaling in the standard Json library for XE7. The fact is that in the standard library for this are described 8 types of standard converters (converter):
  //Convert a field in an object array TObjectsConverter = reference to function(Data: TObject; Field: String): TListOfObjects; //Convert a field in a strings array TStringsConverter = reference to function(Data: TObject; Field: string): TListOfStrings; //Convert a type in an objects array TTypeObjectsConverter = reference to function(Data: TObject): TListOfObjects; //Convert a type in a strings array TTypeStringsConverter = reference to function(Data: TObject): TListOfStrings; //Convert a field in an object TObjectConverter = reference to function(Data: TObject; Field: String): TObject; //Convert a field in a string TStringConverter = reference to function(Data: TObject; Field: string): string; //Convert specified type in an object TTypeObjectConverter = reference to function(Data: TObject): TObject; //Convert specified type in a string TTypeStringConverter = reference to function(Data: TObject): string; 

More detailed work with converters described here .
Translation, however, with the lack of formatting here .

In a nutshell, there are 8 functions that can handle standard data structures. However, no one bothers to override these functions (they may be anonymous).

Let's try?
 … l_Marshal.RegisterConverter(TmsShapeContainer, 'fList', function(Data: TObject; Field: string): TListOfObjects var l_Shape : TmsShape; l_Index: integer; begin SetLength(Result, (Data As TmsShapeContainer).fList.Count); l_Index := 0; for l_Shape in (Data As TmsShapeContainer).fList do begin Result[l_Index] := l_Shape; Inc(l_Index); end; end ); ... 

At the output we get a slightly optimal version:
 { "type": "uMain.TmsShapeContainer", "id": 1, "fields": { "fList": [{ "type": "uMain.TmsShape", "id": 2, "fields": { "fInt": 1, "fStr": "First" } }, { "type": "uMain.TmsShape", "id": 3, "fields": { "fInt": 2, "fStr": "Second" } }] } } 

Everything is already quite good. But let's imagine that we need to save the string and not save the number. To do this, we use the attributes .
 type TmsShape = class private [JSONMarshalled(False)] fInt: integer; [JSONMarshalled(True)] fStr: String; public constructor Create(const aInt: integer; const aStr: String); end; 

At the output we get:
 { "type": "uMain.TmsShapeContainer", "id": 1, "fields": { "fList": [{ "type": "uMain.TmsShape", "id": 2, "fields": { "fStr": "First" } }, { "type": "uMain.TmsShape", "id": 3, "fields": { "fStr": "Second" } }] } } 

Full module code:
 unit uMain; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, FMX.Layouts, FMX.Memo, Generics.Collections, Data.DBXJSONReflect ; type TForm2 = class(TForm) SaveDialog1: TSaveDialog; Memo1: TMemo; btSaveJson: TButton; btSaveEMB_Example: TButton; procedure btSaveJsonClick(Sender: TObject); procedure btSaveEMB_ExampleClick(Sender: TObject); private { Private declarations } public { Public declarations } end; type TmsShape = class private [JSONMarshalled(False)] fInt: integer; [JSONMarshalled(True)] fStr: String; public constructor Create(const aInt: integer; const aStr: String); end; TmsShapeContainer = class private fList: TList<TmsShape>; public constructor Create; destructor Destroy; end; var Form2: TForm2; implementation uses json, uFromEmbarcadero; const _FileNameSave = 'D:\TestingJson.ms'; {$R *.fmx} { TmsShape } constructor TmsShape.Create(const aInt: integer; const aStr: String); begin fInt := aInt; fStr := aStr; end; procedure TForm2.btSaveEMB_ExampleClick(Sender: TObject); begin Memo1.Lines.Assign(mainproc); end; procedure TForm2.btSaveJsonClick(Sender: TObject); var l_Marshal: TJSONMarshal; l_Json: TJSONObject; l_Shape1, l_Shape2: TmsShape; l_msShapeContainer: TmsShapeContainer; l_StringList: TStringList; begin try l_Shape1 := TmsShape.Create(1, 'First'); l_Shape2 := TmsShape.Create(2, 'Second'); l_msShapeContainer := TmsShapeContainer.Create; l_msShapeContainer.fList.Add(l_Shape1); l_msShapeContainer.fList.Add(l_Shape2); l_Marshal := TJSONMarshal.Create; l_StringList := TStringList.Create; l_Marshal.RegisterConverter(TmsShapeContainer, 'fList', function(Data: TObject; Field: string): TListOfObjects var l_Shape : TmsShape; l_Index: integer; begin SetLength(Result, (Data As TmsShapeContainer).fList.Count); l_Index := 0; for l_Shape in (Data As TmsShapeContainer).fList do begin Result[l_Index] := l_Shape; Inc(l_Index); end; end ); l_Json := l_Marshal.Marshal(l_msShapeContainer) as TJSONObject; Memo1.Lines.Text := l_Json.tostring; l_StringList.Add(l_Json.tostring); l_StringList.SaveToFile(_FileNameSave); finally FreeAndNil(l_Marshal); FreeAndNil(l_StringList); FreeAndNil(l_Json); FreeAndNil(l_Shape1); FreeAndNil(l_Shape2); FreeAndNil(l_msShapeContainer); end; end; { TmsShapeContainer } constructor TmsShapeContainer.Create; begin inherited; fList := TList<TmsShape>.Create; end; destructor TmsShapeContainer.Destroy; begin FreeAndNil(fList); inherited; end; end. 

It's time to add serialization to our application.
Let me remind readers how the application looks like:

image


As well as the UML diagram:

image


We need to serialize the TmsDiagramm class. But not all. We only need a list of the figures on the diagram and the name of the diagram.
 ... type TmsShapeList = class(TList<ImsShape>) public function ShapeByPt(const aPoint: TPointF): ImsShape; end; // TmsShapeList TmsDiagramm = class(TmsInterfacedNonRefcounted, ImsShapeByPt, ImsShapesController, IInvokable) private [JSONMarshalled(True)] FShapeList: TmsShapeList; [JSONMarshalled(False)] FCurrentClass: RmsShape; [JSONMarshalled(False)] FCurrentAddedShape: ImsShape; [JSONMarshalled(False)] FMovingShape: TmsShape; [JSONMarshalled(False)] FCanvas: TCanvas; [JSONMarshalled(False)] FOrigin: TPointF; f_Name: String; ... 

Add a serialization class that has 2 static functions:
 type TmsSerializeController = class(TObject) public class procedure Serialize(const aFileName: string; const aDiagramm: TmsDiagramm); class function DeSerialize(const aFileName: string): TmsDiagramm; end; // TmsDiagrammsController 

The serialization function is the same as in the example above. But instead of the output file, I got exception:

image


Debager was pleased with the limitations of the library function:
image


And the thing is that our list:
 type TmsShapeList = class(TList<ImsShape>) public function ShapeByPt(const aPoint: TPointF): ImsShape; end; // TmsShapeList 

This is a list of interfaces that Json does not “eat” from the box. Sadly, you have to do something.
Once the list is interfaced, but the objects in it are real, and not to serialize us just the list of objects?
No sooner said than done.
 var l_SaveDialog: TSaveDialog; l_Marshal: TJSONMarshal; // Serializer l_Json: TJSONObject; l_JsonArray: TJSONArray; l_StringList: TStringList; l_msShape: ImsShape; begin l_SaveDialog := TSaveDialog.Create(nil); if l_SaveDialog.Execute then begin try l_Marshal := TJSONMarshal.Create; l_StringList := TStringList.Create; l_JsonArray := TJSONArray.Create; for l_msShape in FShapeList do begin l_Json := l_Marshal.Marshal(TObject(l_msShape)) as TJSONObject; l_JsonArray.Add(l_Json); end; l_Json := TJSONObject.Create(TJSONPair.Create('MindStream', l_JsonArray)); l_StringList.Add(l_Json.tostring); l_StringList.SaveToFile(l_SaveDialog.FileName); finally FreeAndNil(l_Json); FreeAndNil(l_StringList); FreeAndNil(l_Marshal); end; end else assert(false); FreeAndNil(l_SaveDialog); end; 

The idea is, in general, to go through the list and save each object.
Presented his decision to the project manager. AND?
Generally.
I got a “hand”. For amateur. And he himself understood that deserialization is now the same “manual” is obtained.
Does not fit.
The manager, intervening, advised to add to each object the HackInstance method, which later will acquire the sane name ToObject:
 function TmsShape.HackInstance : TObject; begin Result := Self; end; 

Having taught the serialization controller to work correctly with objects, we get the following module:
unit msSerializeController;
 unit msSerializeController; interface uses JSON, msDiagramm, Data.DBXJSONReflect; type TmsSerializeController = class(TObject) public class procedure Serialize(const aFileName: string; const aDiagramm: TmsDiagramm); class function DeSerialize(const aFileName: string): TmsDiagramm; end; // TmsDiagrammsController implementation uses System.Classes, msShape, FMX.Dialogs, System.SysUtils; { TmsSerializeController } class function TmsSerializeController.DeSerialize(const aFileName: string) : TmsDiagramm; var l_UnMarshal: TJSONUnMarshal; l_StringList: TStringList; begin try l_UnMarshal := TJSONUnMarshal.Create; l_UnMarshal.RegisterReverter(TmsDiagramm, 'FShapeList', procedure(Data: TObject; Field: String; Args: TListOfObjects) var l_Object: TObject; l_Diagramm: TmsDiagramm; l_msShape: TmsShape; begin l_Diagramm := TmsDiagramm(Data); l_Diagramm.ShapeList := TmsShapeList.Create; assert(l_Diagramm <> nil); for l_Object in Args do begin l_msShape := l_Object as TmsShape; l_Diagramm.ShapeList.Add(l_msShape); end end); l_StringList := TStringList.Create; l_StringList.LoadFromFile(aFileName); Result := l_UnMarshal.Unmarshal (TJSONObject.ParseJSONValue(l_StringList.Text)) as TmsDiagramm; finally FreeAndNil(l_UnMarshal); FreeAndNil(l_StringList); end; end; class procedure TmsSerializeController.Serialize(const aFileName: string; const aDiagramm: TmsDiagramm); var l_Marshal: TJSONMarshal; // Serializer l_Json: TJSONObject; l_StringList: TStringList; begin try l_Marshal := TJSONMarshal.Create; l_Marshal.RegisterConverter(TmsDiagramm, 'FShapeList', function(Data: TObject; Field: string): TListOfObjects var l_Shape: ImsShape; l_Index: Integer; begin assert(Field = 'FShapeList'); SetLength(Result, (Data As TmsDiagramm).ShapeList.Count); l_Index := 0; for l_Shape in (Data As TmsDiagramm).ShapeList do begin Result[l_Index] := l_Shape.HackInstance; Inc(l_Index); end; // for l_Shape end); l_StringList := TStringList.Create; try l_Json := l_Marshal.Marshal(aDiagramm) as TJSONObject; except on E: Exception do ShowMessage(E.ClassName + '     : ' + E.Message); end; l_StringList.Add(l_Json.tostring); l_StringList.SaveToFile(aFileName); finally FreeAndNil(l_Json); FreeAndNil(l_StringList); FreeAndNil(l_Marshal); end; end; end. 

Let's see what we did?
In Json it will look like this:
 { "type": "msDiagramm.TmsDiagramm", "id": 1, "fields": { "FShapeList": [{ "type": "msCircle.TmsCircle", "id": 2, "fields": { "FStartPoint": [[146, 250], 146, 250], "FRefCount": 1 } }, { "type": "msCircle.TmsCircle", "id": 3, "fields": { "FStartPoint": [[75, 252], 75, 252], "FRefCount": 1 } }, { "type": "msRoundedRectangle.TmsRoundedRectangle", "id": 4, "fields": { "FStartPoint": [[82, 299], 82, 299], "FRefCount": 1 } }, { "type": "msRoundedRectangle.TmsRoundedRectangle", "id": 5, "fields": { "FStartPoint": [[215, 225], 215, 225], "FRefCount": 1 } }, { "type": "msRoundedRectangle.TmsRoundedRectangle", "id": 6, "fields": { "FStartPoint": [[322, 181], 322, 181], "FRefCount": 1 } }, { "type": "msUseCaseLikeEllipse.TmsUseCaseLikeEllipse", "id": 7, "fields": { "FStartPoint": [[259, 185], 259, 185], "FRefCount": 1 } }, { "type": "msTriangle.TmsTriangle", "id": 8, "fields": { "FStartPoint": [[364, 126], 364, 126], "FRefCount": 1 } }], "fName": " â„–1" } } 

It's time to finish. However, in past posts I described how we set up the testing infrastructure for our project. Therefore, we write tests. TDD fans can throw a “wet rag” at me, and they will be right. Sorry, Guru. I am just learning.
For testing, just save one object (figure). And compare it with the original (the fact that “I scored with my hands”).
Generally:
 unit TestmsSerializeController; { Delphi DUnit Test Case ---------------------- This unit contains a skeleton test case class generated by the Test Case Wizard. Modify the generated code to correctly setup and call the methods from the unit being tested. } interface uses TestFramework, msSerializeController, Data.DBXJSONReflect, JSON, FMX.Objects, msDiagramm ; type // Test methods for class TmsSerializeController TestTmsSerializeController = class(TTestCase) strict private FmsDiagramm: TmsDiagramm; FImage: TImage; public procedure SetUp; override; procedure TearDown; override; published procedure TestSerialize; procedure TestDeSerialize; end; implementation uses System.SysUtils, msTriangle, msShape, System.Types, System.Classes ; const c_DiagramName = 'First Diagram'; c_FileNameTest = 'SerializeTest.json'; c_FileNameEtalon = 'SerializeEtalon.json'; procedure TestTmsSerializeController.SetUp; begin FImage:= TImage.Create(nil); FmsDiagramm := TmsDiagramm.Create(FImage, c_DiagramName); end; procedure TestTmsSerializeController.TearDown; begin FreeAndNil(FImage); FreeAndNil(FmsDiagramm); end; procedure TestTmsSerializeController.TestSerialize; var l_FileSerialized, l_FileEtalon: TStringList; begin FmsDiagramm.ShapeList.Add(TmsTriangle.Create(TmsMakeShapeContext.Create(TPointF.Create(10, 10),nil))); // TODO: Setup method call parameters TmsSerializeController.Serialize(c_FileNameTest, FmsDiagramm); // TODO: Validate method results l_FileSerialized := TStringList.Create; l_FileSerialized.LoadFromFile(c_FileNameTest); l_FileEtalon := TStringList.Create; l_FileEtalon.LoadFromFile(c_FileNameEtalon); CheckTrue(l_FileEtalon.Equals(l_FileSerialized)); FreeAndNil(l_FileSerialized); FreeAndNil(l_FileEtalon); end; procedure TestTmsSerializeController.TestDeSerialize; var ReturnValue: TmsDiagramm; aFileName: string; begin // TODO: Setup method call parameters ReturnValue := TmsSerializeController.DeSerialize(aFileName); // TODO: Validate method results end; initialization // Register any test cases with the test runner RegisterTest(TestTmsSerializeController.Suite); end. 

Links that are useful to me:
www.webdelphi.ru/2011/10/rabota-s-json-v-delphi-2010-xe2/#parsejson
edn.embarcadero.com/article/40882
www.sdn.nl/SDN/Artikelen/tabid/58/view/View/ArticleID/3230/Reading-and-Writing-JSON-with-Delphi.aspx
codereview.stackexchange.com/questions/8850/is-marshalling-converters-reverters-via-polymorphism-realistic
Json viewer plugin for Notepad ++

Senior colleague, Alexander , stepped in the development far ahead of my article. Link to the repository . All your comments on the code plz leave in BitBucket, good repository open. Anyone wishing to try themselves in OpenSource - contact the PM.

This is how the project diagram now looks like:
image


Test Chart:
image

Source: https://habr.com/ru/post/245441/


All Articles