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

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.