delphi xe6 JSON 测试

System.JSON   ISuperJSOn   mORMETJSON   QJSON  测试

我在测试时发现系统自带的JSON  占用内存大一但多了就会出现内存泄漏的问题

我用的Flst<T> 来测试，

为了方便大家，把代码发出来

窗体类

object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 398
ClientWidth = 696
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object mmo1: TMemo
Left = 8
Top = 64
Width = 680
Height = 326
Lines.Strings = (
'mmo1')
ScrollBars = ssVertical
TabOrder = 0
end
object btn1: TButton
Left = 206
Top = 8
Width = 91
Height = 25
Caption = 'System.json'
TabOrder = 1
OnClick = btn1Click
end
object btn2: TButton
Left = 303
Top = 8
Width = 75
Height = 25
Caption = 'ISuperJSON'
TabOrder = 2
OnClick = btn2Click
end
object edt1: TEdit
Left = 16
Top = 8
Width = 73
Height = 21
NumbersOnly = True
TabOrder = 3
Text = '100000'
end
object edt2: TEdit
Left = 95
Top = 8
Width = 42
Height = 21
NumbersOnly = True
TabOrder = 4
Text = '10'
end
object btn3: TButton
Left = 384
Top = 8
Width = 89
Height = 25
Caption = 'mORMEtJSON'
TabOrder = 5
OnClick = btn3Click
end
object btn4: TButton
Left = 479
Top = 8
Width = 58
Height = 25
Caption = 'QJSON'
TabOrder = 6
OnClick = btn4Click
end
end

pas 类

unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Generics.Collections,
SynCommons, Vcl.StdCtrls, superobject, System.JSON, qjson, IdGlobal;

type
TForm1 = class(TForm)
mmo1: TMemo;
btn1: TButton;
btn2: TButton;
edt1: TEdit;
edt2: TEdit;
btn3: TButton;
btn4: TButton;
procedure btn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btn2Click(Sender: TObject);
procedure btn3Click(Sender: TObject);
procedure btn4Click(Sender: TObject);
private
{ Private declarations }
Flock: IAutoLocker;
procedure StartJSon(index, num: Integer);
procedure SetSuperobjson(index: Integer; num: Integer);
procedure StartmORMeJSON(index, num: Integer);
procedure StartQJSON(index, num: Integer);
public
{ Public declarations }
end;

const
sjs = '{ "retcode": "1", "datafrom": "server","users": "[{\"id\":1, \"username\": \"liuderu\", \"website\": \"bcoder.com\"},{\"id\":2, \"username\": \"Jeoe\", \"website\": \"baidu.com\"}]"}';

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btn2Click(Sender: TObject);
begin
TThread.CreateAnonymousThread(
procedure
var
I23, ind: Integer;
begin
btn2.Enabled := False;
ind := StrToInt(edt2.Text);
for I23 := 0 to ind do
begin
SetSuperobjson(StrToInt(Trim(edt1.Text)), I23);

end;
btn2.Enabled := True;
end).Start;
end;

procedure TForm1.btn3Click(Sender: TObject);
begin
TThread.CreateAnonymousThread(
procedure
var
I23, ind: Integer;
begin
btn3.Enabled := False;
ind := StrToInt(edt2.Text);
for I23 := 0 to ind do
begin
self.StartmORMeJSON(StrToInt(Trim(edt1.Text)), I23);

end;
btn3.Enabled := True;
end).Start;
end;

procedure TForm1.btn4Click(Sender: TObject);
begin
TThread.CreateAnonymousThread(
procedure
var
I23, ind: Integer;
begin
btn4.Enabled := False;
ind := StrToInt(edt2.Text);
for I23 := 0 to ind do
begin
self.StartQJSON(StrToInt(Trim(edt1.Text)), I23);

end;
btn4.Enabled := True;
end).Start;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Flock := TAutoLocker.Create;
end;

procedure TForm1.SetSuperobjson(index: Integer; num: Integer);
var
a, b, I, I1: Integer;
db: TList<ISuperObject>;
dt: ISuperObject;
begin

Flock.Enter;
try
a := GetTickCount;
db := TList<ISuperObject>.Create;
for I := 0 to index do
begin
dt := SO(sjs);
db.Add(dt);
end;

FreeAndNil(db);
mmo1.Lines.Insert(0, 'ISuperObject Num +' + IntToStr(num) + 'index:' + IntToStr(index) + ' ' + IntToStr(GetTickCount - a) + '秒');
finally

Flock.Leave;
end;

end;

procedure TForm1.StartJSon(index, num: Integer);
var
a, b, I, I1: Integer;
db: TList<TJSONValue>;
dt: TJSONValue;
db1: TArray<TJSONValue>;
begin

Flock.Enter;
try
a := GetTickCount;
db := TList<TJSONValue>.Create;
for I := 0 to index do
begin
dt := TJSONValue.Create;
TJSONObject(dt).ParseJSONValue(sjs);
db.Add(dt);
end;
for I := 0 to db.Count -1 do
begin
TJSONValue(db[I]).Free;
db[I] := nil;
end;
FreeAndNil(db);
mmo1.Lines.Insert(0, 'System.JSON Num +' + IntToStr(num) + ' index:' + IntToStr(index) + ' ' + IntToStr(GetTickCount - a) + '秒');
finally

Flock.Leave;
end;

end;

procedure TForm1.StartmORMeJSON(index, num: Integer);
var
a, b, I, I1: Integer;
db: TList<variant>;
dt: variant;
begin

Flock.Enter;
try
a := GetTickCount;
db := TList<variant>.Create;
for I := 0 to index do
begin
dt := TDocVariant.NewJSON(sjs);
db.Add(dt);
end;

FreeAndNil(db);
mmo1.Lines.Insert(0, 'mORMetJSON Num +' + IntToStr(num) + ' index:' + IntToStr(index) + ' ' + IntToStr(GetTickCount - a) + '秒');
finally

Flock.Leave;
end;

end;

procedure TForm1.StartQJSON(index, num: Integer);
var
a, b, I, I1: Integer;
db: TQJson;
dt: TQJson;
begin

Flock.Enter;
try
a := GetTickCount;
db := TQJson.Create;
for I := 0 to index do
begin
dt := TQJson.Create;
dt.Parse(sjs);
db.Add(dt);
end;

FreeAndNil(db);
mmo1.Lines.Insert(0, 'QJSON Num +' + IntToStr(num) + ' index:' + IntToStr(index) + ' ' + IntToStr(GetTickCount - a) + '秒');
finally

Flock.Leave;
end;

end;

procedure TForm1.btn1Click(Sender: TObject);
begin
TThread.CreateAnonymousThread(
procedure
var
I23, ind: Integer;
begin
btn1.Enabled := False;
ind := StrToInt(edt2.Text);
for I23 := 0 to ind do
begin
StartJSon(StrToInt(Trim(edt1.Text)), I23);
end;
btn1.Enabled := True;
end).Start

end;

end.