Utiliser JSON sous Free Pascal avec la librairie FCL-JSON

TJSONtype = (jtUnknown, jtNumber, jtString, jtBoolean, jtNull, jtArray, jtObject);

{
   "langage " : "pascal",
   "annee_creation" :1969,
   "compilateurs" :[
                                  {"nom" : "MIDlet Pascal", "plateforme" : "Windows"},
                                  {"nom" : "Lazarus", "plateforme" : "Windows, linux, macOs"}
                               ]
}

program parsedemo;
{$mode objfpc}{$H+}
uses
  Classes, SysUtils, fpjson,jsonparser;
 
Procedure DoParse(Parseur : TJSONParser);
Var
  js : TJSONData;
begin
  Try
    js:=parseur.Parse;
    Try
      If Assigned(js) then
        begin
         Writeln(js.AsJSON)
        end
      else
        Writeln('Pas de données disponibles');
    Finally
      FreeAndNil(js);
    end;
  except
    On E : Exception do
      Writeln('Une erreur est survenue lors du traitement du fichier : ',E.Message);
  end;
end;
 
Procedure ParseFile (FileName : String);
Var
  flux : TFileStream;
  Parseur : TJSONParser;
begin
  flux:=TFileStream.Create(FileName, fmopenRead);
  try
    parseur:=TJSONParser.Create(flux);
    try
      DoParse(parseur);
    finally
      FreeAndNil(parseur);
    end;
  finally
    flux.Destroy;
  end;
end;
 
begin
  If FileExists('json.dat') then
    ParseFile('json.dat')
  else
    writeln('Le fichier est introuvable');
  readln;
end.

{
   "langage " : "pascal",
   "annee_creation" :1969,
   "compilateurs" :[
                                  {"nom" : "MIDlet Pascal", "plateforme" : "Windows"},
                                  {"nom" : "Lazarus", "plateforme" : "Windows, linux, macOs"}
                               ]
}

program parsedemo;
{$mode objfpc}{$H+}
uses
         Classes, SysUtils, fpjson,jsonparser;
 
procedure displayData(data : TJSONData);
 var lang, comp : TJSONObject;
     tab : TJSONArray;
     i : byte;
begin
  lang :=TJSONObject(data);
  writeln('Les caracteristiques du langage : '+lang.Strings['langage']);
  writeln('Date de creation : ',lang.Integers['annee_creation']);
  writeln('------------- Les compilateurs disponibles ---------------- ');
  tab:=lang.Arrays['compilateurs'];
  for i:=0 to tab.Count-1 do
  begin
   comp:= tab.Objects[i];
   write('Nom : '+comp.Strings['nom']);
   write(' / ');
   writeln('Plateforme : '+comp.Strings['plateforme']);
  end;
  writeln('------------------------------------------ ---------------- ');
 
end;
 
Procedure DoParse(Parseur : TJSONParser);
Var
  js : TJSONData;
begin
  js:=parseur.Parse;
  displayData(js);
end;
 
Procedure ParseFile (FileName : String);
Var
  flux : TFileStream;
  Parseur : TJSONParser;
begin
  flux:=TFileStream.Create(FileName, fmopenRead);
  try
    parseur:=TJSONParser.Create(flux);
    try
      DoParse(parseur);
    finally
      FreeAndNil(parseur);
    end;
  finally
    flux.Destroy;
  end;
end;
 
begin
  ParseFile('json.dat')
  readln;
end.

Les caracteristiques du langage : pascal
Date de creation : 1969
------------- Les compilateurs disponibles ----------------
Nom : MIDlet Pascal / Plateforme : Windows
Nom : Lazarus / Plateforme : Windows, linux, macOs
---------------------------------------------------------------------

{
 "personal" :
  [
   {"nom" : "Nabster", "email" :"nabster@darrylsite.tk"},
   {"nom" :"annis", "email" : "annis@darrylsite.tk"}
  ],
 "professional" :
  [
   {"nom" : "julius cesarius", "email" : "jcesarius@comesaf.com"},
   {"nom" : "nabistar", "email" : "nabistar@darrylsite.tk"}
  ]
}

unit Unit2;
{$mode objfpc}{$H+}
interface
 
uses
     Classes, SysUtils, fpjson;
 
  Type
       ContactType =(personal, professional);
 
       TContact = class
 
                   public
                    constructor init();
                    procedure addContact(nom : String; email :String; tp : ContactType);
                    procedure removeContact(nom : String; email :String; tp : ContactType);
                    function getJSONData() : String;
                    destructor destroyed;
                    datas : TJSONObject;
                  end;
 
implementation
 
 constructor TContact.init();
 begin
  datas := TJSONObject.create();
  datas.add('personal', TJSONArray.Create);
  datas.add('professional', TJSONArray.Create);
 end;
 
 procedure TContact.addContact(nom : String; email : String; tp : ContactType);
  var cont : TJSONObject;
 begin
   cont := TJSONObject.Create(['nom', nom, 'email', email]);
  if (tp=personal) then
    datas.Arrays['personal'].Add(cont)
   else
    datas.Arrays['professional'].Add(cont);
 end;
 
 procedure TContact.removeContact(nom : String; email : String; tp : ContactType);
  var arr : TJSONArray;
      cont : TJSONObject;
      i : integer;
      trouve : boolean;
 begin
  if(tp=personal) then
    arr:=datas.Arrays['personal']
  else
    arr:=datas.Arrays['professional'];
  trouve := false;
  i:=0;
   while (not trouve) and (i<arr.Count) do
   begin
    cont := arr.Objects[i];
    if(cont.Strings['nom']=nom) and (cont.Strings['email']=email)then
     begin
      arr.Remove(cont);
      trouve:=true;
     end;
   end;
 end;
 
 function TContact.getJSONData() : AnsiString;
 begin
  result := datas.AsJSON;
 end;
 
 destructor TContact.destroyed;
 begin
  FreeAndNil(datas);
 end;
 
end.