ustresstest.pas

Delphi/BCB 各种版本都支持的Excel 读写控件.一成功应用在N个项目中 .

unit UStressTest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants,{$IFEND}{$ENDIF} //Delphi 6 or above
  Dialogs, StdCtrls, UExcelAdapter, XLSAdapter, UFlxMemTable,
  UCustomFlexCelReport, UFlexCelReportNoDB, UWaitCursor, ComCtrls;

type
  TFStressTest = class(TForm)
    BtnBegin: TButton;
    Memo1: TMemo;
    Report: TFlexCelReportNoDB;
    Data: TFlxMemTable;
    XLSAdapter: TXLSAdapter;
    StatusBar: TStatusBar;
    procedure DataVirtualRecordCount(Sender: TObject;
      var RecordCount: Integer);
    procedure DataGetData(Sender: TObject; const FieldName: String;
      const RecordPos: Integer; var Value: Variant);
    procedure BtnBeginClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FStressTest: TFStressTest;

implementation

{$R *.dfm}
//Results
//  Count 60000 959 sec

//  Count=6000 -> 8.7-10 sec
//        20000 ->  27 30 37 sec
//        40000 -> 137 130 secs
//        60000  ->  358 secs

//  Count=6000 -> 7.57-7.60 sec
//        20000 ->  28 33 sec
//        40000 -> 96 78 secs
//        60000  -> 316 273 246
procedure TFStressTest.DataVirtualRecordCount(Sender: TObject;
  var RecordCount: Integer);
begin
  RecordCount:=6000;
end;

function CreateRandomString: widestring;
var
  i: integer;
begin
  SetLength(Result,10+Random(50));
  for i:=1 to length(Result) do Result[i]:=widechar(64+Random(200));
end;

procedure TFStressTest.DataGetData(Sender: TObject;
  const FieldName: String; const RecordPos: Integer; var Value: Variant);
begin
  if (FieldName='a1') or (FieldName='a16') then Value:=CreateRandomString
  else if (FieldName='a8') or (FieldName='a21') then Value:='adrian'
  else if (FieldName='a4') or (FieldName='a23') then Value:='Static string 2'
  else Value:=Random(10000);
end;

procedure TFStressTest.BtnBeginClick(Sender: TObject);
var
  StartTime, EndTime: int64;
  WaitCursor: IWaitCursor;
  FMem1, FMem2: THeapStatus;
begin
  RandSeed:=389; //To have always the same results
  Report.FileName:=ExtractFilePath(ParamStr(0))+'Result.xls';
  if FileExists(Report.FileName) then DeleteFile(Report.FileName);
  StatusBar.SimpleText:='';
  WaitCursor:=TWaitCursor.Create;

  FMem1:=GetHeapStatus;
  StartTime:=GetTickCount;
  Report.Run;
  EndTime:=GetTickCount;
  FMem1:=GetHeapStatus;

  StatusBar.SimpleText:=Format('Last Report took: %f seconds   - Used Mem: %d (delta: %d)', [(EndTime-StartTime)/1000, FMem2.TotalAllocated, FMem2.TotalAllocated-FMem1.TotalAllocated]);
  ShowMessage('Ok');
end;

end.