Delphi 创建 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 仅适用于 Serializing/Deserializing（大多数情况），您应该仅在应用程序的边界上处理 JSON。

合同

为外部定义您的合同，并使用它们将数据从内部传输到外部，反之亦然。

首先是为了方便de-/serialization

而设计的合约单位

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.

如您所见，我使用数组和 classes。要使用 classes 管理这些数组，我有一个基础 class 来处理

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.

业务对象

对于应用程序本身，我们使用此 classes 仅 de-/serialization。内部业务objects/entities与他们分开

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.

申报两次有什么好处？

好了，现在您可以更改业务对象或合同而不会相互感染。您可以在两者中使用不同的类型和名称，并且您的内部 classes 不受任何外部合同的约束。

参见：Single Responsibility Principle

映射

要在业务对象和合同之间轻松映射，请使用映射器

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 西雅图测试的 - 您可能需要更改一些单位才能在运行 XE6

Delphi 创建 JSON

Delphi create JSON

delphi

json

delphi-xe6

合同

业务对象

申报两次有什么好处？

映射

综合起来