JSON parsing with FNC Core

FNC TMS FNC UI Pack
5

Hi,


You can achieve this with the following code:



unit Unit42;


interface


uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls;


type
  TForm42 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form42: TForm42;


implementation


{$R *.fmx}


uses
  FMX.TMSFNCTypes, FMX.TMSFNCPersistence, Generics.Collections;


const
  jsonSample =
    '{' +
    '"$type": "TPerson",' +
    '"name":"John",' +
    '"age":30,'+
    '"cars":[{"name":"Ford","models":["Fiesta"]},'+
    '{"name":"BMW","models":["320","X3","X5"]},' +
    '{"name":"Fiat","models":["500","Panda"]}]}';


type
  TPersonCar = class(TPersistent)
  private
    FName: string;
    FModels: TStringList;
  public
    constructor Create;
    destructor Destroy; override;
  published
    property Name: string read FName write FName;
    property Models: TStringList read FModels;
  end;


  TPersonCars = class(TList<TPersonCar>, ITMSFNCBaseListIO)
  private
    FOwnerInterface: IInterface;
  protected
    function GetItemClass: TClass;
    { IInterface }
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
  end;


  TPerson = class(TInterfacedPersistent, ITMSFNCBasePersistenceIO)
  private
    FAge: Integer;
    FCars: TPersonCars;
    FName: string;
  protected
    function CreateObject(const AClassName: string; const ABaseClass: TClass): TObject;
  public
    constructor Create;
    destructor Destroy; override;
  published
    property Name: string read FName write FName;
    property Age: Integer read FAge write FAge;
    property Cars: TPersonCars read FCars;
  end;


{ TPerson }


constructor TPerson.Create;
begin
  FCars := TPersonCars.Create;
end;


function TPerson.CreateObject(const AClassName: string;
  const ABaseClass: TClass): TObject;
begin
  Result := nil;
  if ABaseClass = TPersonCar then
    Result := TPersonCar.Create;
end;


destructor TPerson.Destroy;
begin
  FreeAndNil(FCars);
  inherited;
end;


procedure TForm42.Button1Click(Sender: TObject);
var
  p: TPerson;
begin
  p := TPerson.Create;
  try
    p.JSON := jsonSample;
    p.Log;
  finally
    p.Free;
  end;
end;


{ TPersonCar }


constructor TPersonCar.Create;
begin
  FModels := TStringList.Create;
end;


destructor TPersonCar.Destroy;
begin
  FreeAndNil(FModels);
  inherited;
end;


{ TPersonCars }


function TPersonCars.GetItemClass: TClass;
begin
  Result := TPersonCar;
end;


function TPersonCars._AddRef: Integer;
begin
  if FOwnerInterface <> nil then
    Result := FOwnerInterface._AddRef else
    Result := -1;
end;


function TPersonCars._Release: Integer;
begin
  if FOwnerInterface <> nil then
    Result := FOwnerInterface._Release else
    Result := -1;
end;


function TPersonCars.QueryInterface(const IID: TGUID;
  out Obj): HResult;
const
  E_NOINTERFACE = HResult($80004002);
begin
  if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;
end;




end.
1 Like
JSON persistence