Delphi create JSON

Question

Я нахожусь на Delphi XE6, и я ищу лучший способ для создания JSON и для разбора JSON.

Я стараюсь работать с блоком REST.Json и этот метод: TJson.ObjectToJsonString

TContrat = class 
private 
    FdDateDeb: TDate; 
public 
    property dDateDeb: TDate read FdDateDeb write FdDateDeb; 
end; 

TApprenant = class 
private 
    FsNom : string; 
    [JSONName('ListContrat')] 
    FListContrat: TObjectList<TContrat>; 
public 
    property sNom : string read FsNom write FsNom; 
    property ListContrat: TObjectList<TContrat> read FListContrat write FListContrat; 
end; 

... 
procedure TForm3.Button2Click(Sender: TObject); 
var 
    apprenant : TApprenant; 
    contrat : TContrat; 
begin 
    Memo1.Clear; 

    apprenant := TApprenant.Create; 
    apprenant.sNom := 'JEAN'; 

    contrat := TContrat.Create; 
    contrat.dDateDeb := StrToDate('01/01/2015'); 
    apprenant.ListContrat.Add(contrat); 

    contrat := TContrat.Create; 
    contrat.dDateDeb := StrToDate('01/01/2016'); 
    apprenant.ListContrat.Add(contrat); 

    Memo1.Lines.Add(TJson.ObjectToJsonString(apprenant)); 
end; 

результат является

{ 
    "sNom": "JEAN", 
    "ListContrat": { 
     "ownsObjects": true, 
     "items": [{ 
      "dDateDeb": 42005, 
     }, { 
      "dDateDeb": 42370, 
     }], 
     "count": 2, 
     "arrayManager": {} 
    } 
} 

В результате у меня есть некоторое свойство TObjectList <> (экс "ownsObjects").

Это лучший способ создать JSON? Я должен использовать фреймворк? У вас хороший учебник?

Извините, у меня есть поиск на форуме, но вы не нашли хороший способ.

Answer 1

Если JSON предназначен только для сериализации/десериализации (в большинстве случаев), вы должны иметь дело с JSON только на основе вашего приложения.

Контракты

Определить свой контракт (ы) для внешней стороны и использовать их для транспортировки данных изнутри наружу, и наоборот.

Первый контракт блок, который предназначен для удобного де-/сериализации

unit whatever.ApiJson.v1; 

// this is the contract definition for version 1  

interface 

uses 
    System.SysUtils, 
    REST.Json.Types, 
    Commons.JsonContract; 

type 
    TApprenantJSON = class; 
    TContratJSON = class; 

    TContratJSON = class(TJsonContractBase) 
    private 
    [ JSONName('date_deb') ] 
    FDateDeb: TDateTime; 
    public 
    property DateDeb: TDateTime read FDateDeb write FDateDeb; 
    public 
    class function FromJson(const aJsonStr: string): TContratJSON; 
    end; 

    TApprenantJSON = class(TJsonContractBase) 
    private 
    [ JSONName('nom') ] 
    FNom: string; 
    [ JSONName('contrats') ] 
    FContrats: TArray<TContratJSON>; 
    public 
    property Nom  : string read FNom write FNom; 
    property Contrats: TArray<TContratJSON> read FContrats write FContrats; 
    public 
    destructor Destroy; override; 
    public 
    class function FromJson(const aJsonStr: string): TApprenantJSON; 
    end; 

implementation 

{ TApprenantJSON } 

destructor TApprenantJSON.Destroy; 
begin 
    DisposeObjectArray<TContratJSON>(FContrats); 
    inherited; 
end; 

class function TApprenantJSON.FromJson(const aJsonStr: string): TApprenantJSON; 
begin 
    Result := _FromJson(aJsonStr) as TApprenantJSON; 
end; 

{ TContratJSON } 

class function TContratJSON.FromJson(const aJsonStr: string): TContratJSON; 
begin 
    Result := _FromJson(aJsonStr) as TContratJSON; 
end; 

end. 

Как вы можете видеть, что я использовать массивы и классы. Для того, чтобы управлять этими массивами с классами у меня есть базовый класс работы с этой

unit Commons.JsonContract; 

interface 

type 
    TJsonContractBase = class abstract 
    protected 
    procedure DisposeObjectArray<T: class>(var arr: TArray<T>); 
    class function _FromJson(const aJsonStr: string): TObject; overload; 
    class procedure _FromJson(aResult: TObject; const aJsonStr: string); overload; 
    public 
    function ToJson(): string; virtual; 
    end; 

implementation 

uses 
    System.Sysutils, 
    System.JSON, 
    REST.JSON; 

{ TJsonContractBase } 

procedure TJsonContractBase.DisposeObjectArray<T>(var arr: TArray<T>); 
var 
    I: Integer; 
begin 
    for I := low(arr) to high(arr) do 
    FreeAndNil(arr[ I ]); 
    SetLength(arr, 0); 
end; 

class function TJsonContractBase._FromJson(const aJsonStr: string): TObject; 
begin 
    Result := Self.Create; 
    try 
    _FromJson(Result, aJsonStr); 
    except 
    Result.Free; 
    raise; 
    end; 
end; 

class procedure TJsonContractBase._FromJson(aResult: TObject; const aJsonStr: string); 
var 
    lJson: TJsonObject; 
begin 
    lJson := TJsonObject.ParseJSONValue(aJsonStr) as TJsonObject; 
    try 
    TJson.JsonToObject(aResult, lJson); 
    finally 
    lJson.Free; 
    end; 
end; 

function TJsonContractBase.ToJson: string; 
begin 
    Result := TJson.ObjectToJsonString(Self); 
end; 

end. 

Business Objects

Для самого приложения мы используем эти классы только для де-/сериализации. Внутренние бизнес-объекты/сущности отделены от них.

unit whatever.DataObjects; 

interface 

uses 
    System.Generics.Collections; 

type 
    TApprenant = class; 
    TContrat = class; 

    TApprenant = class 
    private 
    FNom  : string; 
    FContrats: TObjectList<TContrat>; 
    public 
    property Nom  : string read FNom write FNom; 
    property Contrats: TObjectList<TContrat> read FContrats; 
    public 
    constructor Create; 
    destructor Destroy; override; 
    end; 

    TContrat = class 
    private 
    FDateDeb: TDateTime; 
    public 
    property DateDeb: TDateTime read FDateDeb write FDateDeb; 
    end; 

implementation 

{ TApprenant } 

constructor TApprenant.Create; 
begin 
    inherited; 
    FContrats := TObjectList<TContrat>.Create(true); 
end; 

destructor TApprenant.Destroy; 
begin 
    FContrats.Free; 
    inherited; 
end; 

end. 

Какая польза декларирует все в два раза?

Ну, теперь вы можете изменить бизнес-объекты или контракты, не заражая друг друга. У вас могут быть разные типы, имена в обоих и ваши внутренние классы не связаны с каким-либо контрактом снаружи.

См: Single Responsibility Principle

Mapping

Для удобного отображения между бизнес-объектами и договором использовать картограф

unit Commons.Mappings; 

interface 

uses 
    System.Generics.Collections, 
    System.Rtti, 
    System.SysUtils, 
    System.TypInfo; 

type 
    TMapKey = record 
    Source: PTypeInfo; 
    Target: PTypeInfo; 
    class function Create<TSource, TTarget>(): TMapKey; static; 
    end; 

    TMapper = class 
    private 
    FMappings: TDictionary<TMapKey, TFunc<TValue, TValue>>; 
    public 
    procedure Add<TSource, TTarget>(aConverter: TFunc<TSource, TTarget>); overload; 
    procedure Add<TSource, TTarget>(aConverter: TFunc<TSource, TTarget>; aReverter: TFunc<TTarget, TSource>); overload; 
    public 
    constructor Create; 
    destructor Destroy; override; 

    function Map<TSource, TTarget>(const aSource: TSource): TTarget; overload; 
    procedure Map<TSource, TTarget>(const aSource: TSource; out aTarget: TTarget); overload; 
    function MapCollection<TSource, TTarget>(const aCollection: TEnumerable<TSource>): TArray<TTarget>; overload; 
    function MapCollection<TSource, TTarget>(const aCollection: array of TSource): TArray<TTarget>; overload; 
    end; 

implementation 

{ TMapper } 

procedure TMapper.Add<TSource, TTarget>(aConverter: TFunc<TSource, TTarget>); 
var 
    lKey: TMapKey; 
begin 
    lKey := TMapKey.Create<TSource, TTarget>(); 
    FMappings.Add(lKey, 
    function(Source: TValue): TValue 
    begin 
     Result := TValue.From<TTarget>(aConverter(Source.AsType<TSource>())); 
    end); 
end; 

procedure TMapper.Add<TSource, TTarget>(
    aConverter: TFunc<TSource, TTarget>; 
    aReverter : TFunc<TTarget, TSource>); 
begin 
    Add<TSource, TTarget>(aConverter); 
    Add<TTarget, TSource>(aReverter); 
end; 

constructor TMapper.Create; 
begin 
    inherited; 
    FMappings := TDictionary < TMapKey, TFunc < TValue, TValue >>.Create; 
end; 

destructor TMapper.Destroy; 
begin 
    FMappings.Free; 
    inherited; 
end; 

function TMapper.Map<TSource, TTarget>(const aSource: TSource): TTarget; 
var 
    lKey: TMapKey; 
begin 
    lKey := TMapKey.Create<TSource, TTarget>(); 
    Result := FMappings[ lKey ](TValue.From<TSource>(aSource)).AsType<TTarget>(); 
end; 

procedure TMapper.Map<TSource, TTarget>(
    const aSource: TSource; 
    out aTarget : TTarget); 
begin 
    aTarget := Map<TSource, TTarget>(aSource); 
end; 

function TMapper.MapCollection<TSource, TTarget>(const aCollection: array of TSource): TArray<TTarget>; 
var 
    lCollection: TList<TSource>; 
begin 
    lCollection := TList<TSource>.Create(); 
    try 
    lCollection.AddRange(aCollection); 
    Result := MapCollection<TSource, TTarget>(lCollection); 
    finally 
    lCollection.Free; 
    end; 
end; 

function TMapper.MapCollection<TSource, TTarget>(const aCollection: TEnumerable<TSource>): TArray<TTarget>; 
var 
    lKey  : TMapKey; 
    lMapHandler: TFunc<TValue, TValue>; 
    lResult : TList<TTarget>; 
    lSourceItem: TSource; 
begin 
    lKey  := TMapKey.Create<TSource, TTarget>(); 
    lMapHandler := FMappings[ lKey ]; 

    lResult := TList<TTarget>.Create; 
    try 
    for lSourceItem in aCollection do 
     begin 
     lResult.Add(lMapHandler(TValue.From<TSource>(lSourceItem)).AsType<TTarget>()); 
     end; 

    Result := lResult.ToArray(); 
    finally 
    lResult.Free; 
    end; 
end; 

{ TMapKey } 

class function TMapKey.Create<TSource, TTarget>: TMapKey; 
begin 
    Result.Source := TypeInfo(TSource); 
    Result.Target := TypeInfo(TTarget); 
end; 

end. 

Собирает все вместе

program so_37659536; 

{$APPTYPE CONSOLE} 
{$R *.res} 

uses 
    System.SysUtils, 
    Commons.Mappings in 'Commons.Mappings.pas', 
    Commons.JsonContract in 'Commons.JsonContract.pas', 
    whatever.DataObjects in 'whatever.DataObjects.pas', 
    whatever.ApiJson.v1 in 'whatever.ApiJson.v1.pas', 
    whatever.ApiJson.v2 in 'whatever.ApiJson.v2.pas'; 

procedure DemoMapV1(aMapper: TMapper); 
var 
    lApprenant: TApprenant; 
    lContrat : TContrat; 

    lApprenantJSON: whatever.ApiJson.v1.TApprenantJSON; 

    lApprenantJSONStr: string; 
begin 
    WriteLn; 
    WriteLn('V1'); 
    WriteLn; 
{$REGION 'Serialize'} 
    lApprenantJSON := nil; 
    try 
    lApprenant := TApprenant.Create; 
    try 

     lApprenant.Nom := 'JEAN'; 
     lContrat   := TContrat.Create; 
     lContrat.DateDeb := EncodeDate(2015, 1, 1); 
     lApprenant.Contrats.Add(lContrat); 

     aMapper.Map(lApprenant, lApprenantJSON); 

    finally 
     lApprenant.Free; 
    end; 

    lApprenantJSONStr := lApprenantJSON.ToJson(); 
    finally 
    lApprenantJSON.Free; 
    end; 
{$ENDREGION 'Serialize'} 
    WriteLn(lApprenantJSONStr); 

{$REGION 'Deserialize'} 
    lApprenant  := nil; 
    lApprenantJSON := whatever.ApiJson.v1.TApprenantJSON.FromJson(lApprenantJSONStr); 
    try 
    aMapper.Map(lApprenantJSON, lApprenant); 
    try 

     WriteLn('Nom: ', lApprenant.Nom); 
     WriteLn('Contrats:'); 
     for lContrat in lApprenant.Contrats do 
     begin 
      WriteLn('- ', DateToStr(lContrat.DateDeb)); 
     end; 

    finally 
     lApprenant.Free; 
    end; 
    finally 
    lApprenantJSON.Free; 
    end; 
{$ENDREGION 'Deserialize'} 
end; 

var 
    Mapper: TMapper; 

begin 
    try 
    Mapper := TMapper.Create; 
    try 

{$REGION 'Define Mapping'} 
{$REGION 'v1'} 
     Mapper.Add<TApprenant, whatever.ApiJson.v1.TApprenantJSON>(
     function(s: TApprenant): whatever.ApiJson.v1.TApprenantJSON 
     begin 
      Result := whatever.ApiJson.v1.TApprenantJSON.Create; 
      Result.Nom := s.Nom; 
      Result.Contrats := Mapper.MapCollection<TContrat, whatever.ApiJson.v1.TContratJSON>(s.Contrats); 
     end, 
     function(s: whatever.ApiJson.v1.TApprenantJSON): TApprenant 
     begin 
      Result := TApprenant.Create; 
      Result.Nom := s.Nom; 
      Result.Contrats.AddRange(Mapper.MapCollection<whatever.ApiJson.v1.TContratJSON, TContrat>(s.Contrats)); 
     end); 

     Mapper.Add<TContrat, whatever.ApiJson.v1.TContratJSON>(
     function(s: TContrat): whatever.ApiJson.v1.TContratJSON 
     begin 
      Result := whatever.ApiJson.v1.TContratJSON.Create; 
      Result.DateDeb := s.DateDeb; 
     end, 
     function(s: whatever.ApiJson.v1.TContratJSON): TContrat 
     begin 
      Result := TContrat.Create; 
      Result.DateDeb := s.DateDeb; 
     end); 
{$ENDREGION 'v1'} 

{$REGION 'v2'} 
// mapping for v2 
{$ENDREGION 'v2'} 

{$ENDREGION 'Define Mapping'} 
     DemoMapV1(Mapper); 

    finally 
     Mapper.Free; 
    end; 
    except 
    on E: Exception do 
     WriteLn(E.ClassName, ': ', E.Message); 
    end; 
    ReadLn; 

end. 

ПримечаниеЭто проверено на Delphi Seattle - вам, возможно, придется поменять некоторые из этих устройств, чтобы получить это на XE6