Delphi 10.2 JSON与对象/结构体序列化性能提高100多倍

Posted 2020-10-16 全能中间件

     今天在盒子闲逛，无意中看到有人说XE7自带的Json对象序列化很慢，帖子在这里：http://bbs.2ccc.com/topic.asp?topicid=464378 ;经过测试的确如此。
     但是 D10.2后，自带的 Json 做了优化，性能大大的提高了100多倍。

和其他json库对比了序列化和反序列化性能，JsonDataObjects 性能最好，但是只支持简单的对象，不支持结构体,QJson 则不支持动态数组，不支持 Attributes (RTTI)，比如需要排除某些字段，System.JSON 和 XSuperObject 可支持。总体来说，个人比较喜欢10.2新增的TJsonSerializer，使用方便，无需第三方库。

 全部代码如下：

unit Unit1;
{$DEFINE XSuperObject}
{$DEFINE QJson }
{$DEFINE JsonDataObjects}

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls,
  Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Samples.Spin
{$IF CompilerVersion>31.0}, System.JSON.Types, System.JSON.Serializers{$ENDIF};

type

{$IF CompilerVersion>31.0}
  [JsonSerialize(TJsonMemberSerialization.&Public)]
{$ENDIF}

  TObj1 = class
  private
    F_i: Integer;
    f_d: TDateTime;
    f_s: string;
  //  f_a: TArray<string>;
  public
    constructor Create;
  published
    property field_s: string read f_s write f_s;
    property field_i: Integer read F_i write F_i;
    property field_d: TDateTime read f_d write f_d;
  //  property field_a: TArray<string> read f_a write f_a;
  end;

  TForm1 = class(TForm)
    btnObjectToJsonString: TButton;
    btnJsonSerializer: TButton;
    mmoLog: TMemo;
    seTestNumber: TSpinEdit;
    lbl1: TLabel;
    btnXSuperObject: TButton;
    btnQJson: TButton;
    btnJsonDataObjects: TButton;
    btnParseFile: TButton;
    dlgOpen1: TOpenDialog;
    procedure btnObjectToJsonStringClick(Sender: TObject);
    procedure btnJsonSerializerClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnXSuperObjectClick(Sender: TObject);
    procedure btnQJsonClick(Sender: TObject);
    procedure btnJsonDataObjectsClick(Sender: TObject);
    procedure btnParseFileClick(Sender: TObject);
  private
    procedure Log(const S: string);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  TestNumber: Integer;

implementation

uses
  System.Diagnostics,
  System.IOUtils,
  REST.JSON,
  System.JSON,
{$IFDEF JsonDataObjects}
  JsonDataObjects,
{$ENDIF}
{$IFDEF XSuperObject}
  XSuperObject,
{$ENDIF}
{$IFDEF QJson}
  qjson,
{$ENDIF}
  rtcMW.System.JSONHelper;

{$R *.dfm}


function GetFileSize(const AFileName: string): Int64;
var
  AttributeData: TWin32FileAttributeData;
begin
  if not GetFileAttributesEx(PChar(AFileName), GetFileExInfoStandard, @AttributeData) then
    RaiseLastOSError;
  Int64Rec(Result).Lo := AttributeData.nFileSizeLow;
  Int64Rec(Result).Hi := AttributeData.nFileSizeHigh;
end;

procedure TForm1.btnObjectToJsonStringClick(Sender: TObject);
var
  Foo: TObj1;
  I: Integer;
  sw: TStopwatch;
  JSON: string;
begin
  TestNumber := seTestNumber.Value;

  sw := TStopwatch.StartNew;
  for I := 1 to TestNumber - 1 do
  begin
    Foo := TObj1.Create;
    try
      Foo.field_s := \'Hello World\';
      Foo.field_i := 42;
      Foo.field_d := Now;
      JSON := REST.JSON.TJson.ObjectToJsonString(Foo);
    finally
      Foo.Free;
    end;
  end;
  Log(\'TJson.ObjectToJsonString：\' + sw.ElapsedMilliseconds.ToString + \' ms \' + JSON);

  sw := TStopwatch.StartNew;
  for I := 1 to TestNumber - 1 do
  begin
    Foo := REST.JSON.TJson.JsonToObject<TObj1>(JSON);
    try
    finally
      Foo.Free;
    end;
  end;
  Log(\'TJson.ObjectToJsonString：\' + sw.ElapsedMilliseconds.ToString + \' ms\');
  Log(\'=======================\');
end;

procedure TForm1.btnXSuperObjectClick(Sender: TObject);
{$IFDEF XSuperObject}
var
  Foo: TObj1;
  I: Integer;
  sw: TStopwatch;
  AJson: string;
{$ENDIF}
begin
{$IFDEF XSuperObject}
  TestNumber := seTestNumber.Value;
  sw := TStopwatch.StartNew;

  for I := 0 to TestNumber - 1 do
  begin
    Foo := TObj1.Create;
    try
      Foo.field_s := \'Hello World\';
      Foo.field_i := 42;
      Foo.field_d := Now;
      AJson := XSuperObject.TJson.SuperObject<TObj1>(Foo).AsJSON();
    finally
      Foo.Free;
    end;

  end;
  Log(\'XSuperObject.TJson.SuperObject：\' + sw.ElapsedMilliseconds.ToString + \' ms  \' + AJson);

  for I := 0 to TestNumber - 1 do
  begin
    Foo := XSuperObject.TJson.Parse<TObj1>(AJson);
    try
    finally
      Foo.Free;
    end;

  end;
  Log(\'XSuperObject.TJson.Parse：\' + sw.ElapsedMilliseconds.ToString + \' ms\');
  Log(\'=======================\');
{$ENDIF}

end;

procedure TForm1.btnJsonDataObjectsClick(Sender: TObject);
{$IFDEF JsonDataObjects}
var
  Foo: TObj1;
  I: Integer;
  sw: TStopwatch;
  AJson: string;
  JsonObj: JsonDataObjects.TJsonObject;
{$ENDIF}
begin
{$IFDEF JsonDataObjects}
  TestNumber := seTestNumber.Value;
  sw := TStopwatch.StartNew;

  JsonObj := JsonDataObjects.TJsonObject.Create;
  for I := 0 to TestNumber - 1 do
  begin
    Foo := TObj1.Create;
    try
      Foo.field_s := \'Hello World\';
      Foo.field_i := 42;
      Foo.field_d := Now;
      JsonObj.FromSimpleObject(Foo);
      AJson := JsonObj.ToJSON();
    finally
      Foo.Free;
    end;

  end;
  Log(\'JsonDataObjects.FromSimpleObject：\' + sw.ElapsedMilliseconds.ToString + \' ms \' + AJson);
  JsonObj.Free;

  sw := TStopwatch.StartNew;
  for I := 1 to TestNumber - 1 do
  begin
    JsonObj := JsonDataObjects.TJsonObject.Parse(AJson) as JsonDataObjects.TJsonObject;
    Foo := TObj1.Create;
    try
      JsonObj.ToSimpleObject(Foo);
    finally
      Foo.Free;
      JsonObj.Free;
    end;
  end;
  Log(\'JsonDataObjects.ToSimpleObject：\' + sw.ElapsedMilliseconds.ToString + \' ms\');
  Log(\'=======================\');
{$ENDIF}
end;

procedure TForm1.btnParseFileClick(Sender: TObject);

var
  JsonObj: System.JSON.TJsonObject;
  JsonObj1: JsonDataObjects.TJsonObject;
{$IFDEF QJson}
  JsonObj2: TQJson;
{$ENDIF}
  sw: TStopwatch;
  FileName: string;
begin
  if not dlgOpen1.Execute() then
    Exit;
  FileName := dlgOpen1.FileName;
  Log(Format(\'%s,FileSize:%d Byte\', [FileName, GetFileSize(FileName)]));
  Log(\'=======================\');

  sw := TStopwatch.StartNew;
  JsonObj := System.JSON.TJsonObject.LoadFromFile(FileName).AsJsonObject;
  try
    if JsonObj = nil then
      raise Exception.CreateFmt(\'%s 不是有效的 JSON 文件\', [FileName]);
    // Log(JsonObj.GetValue<string>(\'meta[0].field_name\'));
    Log(\'System.Json.TJsonObject.LoadFromFile：\' + sw.ElapsedMilliseconds.ToString + \' ms\');
  finally
    JsonObj.Free;
  end;
{$IFDEF JsonDataObjects}
  sw := TStopwatch.StartNew;
  JsonObj1 := JsonDataObjects.TJsonObject.Create;
  try
    JsonObj1.LoadFromFile(FileName);
    if JsonObj1 <> nil then
    begin
      Log(\'JsonDataObjects.TJsonObject.LoadFromFile：\' + sw.ElapsedMilliseconds.ToString + \' ms\');
    end;
  finally
    JsonObj1.Free;
  end;
{$ENDIF}
{$IFDEF QJson}
  sw := TStopwatch.StartNew;
  JsonObj2 := TQJson.Create;
  try
    JsonObj2.LoadFromFile(FileName);
    if JsonObj2 <> nil then
    begin
      // Log(Json.ItemByPath(\'meta[0].field_name\').AsString);
      Log(\'TQJson.LoadFromFile：\' + sw.ElapsedMilliseconds.ToString + \' ms\');
    end;
  finally
    JsonObj2.Free;
  end;
{$ENDIF}

end;

procedure TForm1.btnJsonSerializerClick(Sender: TObject);
{$IF CompilerVersion>31.0}
var
  Foo: TObj1;
  I: Integer;
  sw: TStopwatch;
  AJson: string;
  Serializer: TJsonSerializer;
{$ENDIF}
begin
{$IF CompilerVersion>31.0}
  TestNumber := seTestNumber.Value;
  sw := TStopwatch.StartNew;
  Serializer := TJsonSerializer.Create;
  try
    Serializer.DateTimeZoneHandling := TJsonDateTimeZoneHandling.Utc;
    for I := 0 to TestNumber - 1 do
    begin
      Foo := TObj1.Create;
      try
        Foo.field_s := \'Hello World\';
        Foo.field_i := 42;
        Foo.field_d := Now;
        AJson := Serializer.Serialize<TObj1>(Foo);
      finally
        Foo.Free;
      end;

    end;
    Log(\'TJsonSerializer.Serialize：\' + sw.ElapsedMilliseconds.ToString + \' ms \' + AJson);

    sw := TStopwatch.StartNew;
    for I := 1 to TestNumber - 1 do
    begin
      Foo := Serializer.Deserialize<TObj1>(AJson);
      try
      finally
        Foo.Free;
      end;
    end;
    Log(\'TJsonSerializer.Deserialize：\' + sw.ElapsedMilliseconds.ToString + \' ms\');

  finally
    FreeAndNil(Serializer);
  end;
  Log(\'=======================\');
{$ENDIF}
end;

procedure TForm1.btnQJsonClick(Sender: TObject);
{$IFDEF QJson}
var
  Foo: TObj1;
  I: Integer;
  sw: TStopwatch;
  AJson: string;
  Serializer: TQJson;
{$ENDIF}
begin
{$IFDEF QJson}
  TestNumber := seTestNumber.Value;
  sw := TStopwatch.StartNew;
  Serializer := TQJson.Create;
  for I := 0 to TestNumber - 1 do
  begin
    Foo := TObj1.Create;
    try
      Foo.field_s := \'Hello World\';
      Foo.field_i := 42;
      Foo.field_d := Now;
      Serializer.FromRtti(Foo);
      AJson := Serializer.AsJSON;
    finally
      Foo.Free;
    end;

  end;
  Log(\'TQJson.FromRtti：\' + sw.ElapsedMilliseconds.ToString + \' ms  \' + AJson);

  for I := 0 to TestNumber - 1 do
  begin
    Serializer.Parse(AJson);
    Foo := TObj1.Create;
    try
      Serializer.ToRtti(Foo);
    finally
      Foo.Free;
    end;

  end;
  Serializer.Free;
  Log(\'TQJson.ToRtti：\' + sw.ElapsedMilliseconds.ToString + \' ms\');
  Log(\'=======================\');
{$ENDIF}
end;

procedure TForm1.FormCreate(Sender: TObject);
const
  // D2010~D10.2
  DelphiIDEVers: array [21 .. 32] of string = (
    \'Delphi 2010\',
    \'Delphi XE\',
    \'Delphi XE2\',
    \'Delphi XE3\',
    \'Delphi XE4\',
    \'Delphi XE5\',
    \'Delphi XE6\',
    \'Delphi XE7\',
    \'Delphi XE8\',
    \'Delphi 10 Seattle\',
    \'Delphi 10.1 Berlin\',
    \'Delphi 10.2 Tokyo\');
begin
{$IFDEF WIN64}
  Caption := Caption + \' (64-bit)\';
{$ENDIF}
  Caption := Caption + \' - \' + DelphiIDEVers[Trunc(CompilerVersion)];

{$IF CompilerVersion<32.0}
  btnJsonSerializer.Enabled := False;
{$ENDIF}

{$IFNDEF XSuperObject}
  btnXSuperObject.Enabled := False;
{$ENDIF}
{$IFNDEF JsonDataObjects}
  btnJsonDataObjects.Enabled := False;
{$ENDIF}
{$IFNDEF QJson}
  btnQJson.Enabled := False;
{$ENDIF}
  ReportMemoryLeaksOnShutdown := True;
end;

procedure TForm1.Log(const S: string);
begin
  mmoLog.Lines.Add(S);
end;

{ TObj1 }

constructor TObj1.Create;
begin
  inherited;
 { SetLength(f_a, 4);
  f_a[0] := \'全能中间件\';
  f_a[1] := \'QQ:64445322\';
  f_a[2] := \'淘宝：https://imaps.taobao.com/\';
  f_a[3] := \'没有Unicode？\\\\//\';  }
end;

end.