自己写的一个测试函数执行效率的单元(test on Delphi 7)

运用了一点技巧来实现对函数进行效率测试

使用方法:
uses
  Profile;
.......

function TForm1.Func1():string;
begin
    TFunctionTimeProfiler.ExecuteTest(ClassName, 'Func1'); //这里会创建一个接口实例,并开始测试; 此实例会自动释放并结束测试
    ....
end;

程序最后退出会自动生成一详细的报告, 根据报告, 就可以有针对性的优化代码, 提高程序的执行效率

希望大家看后能有一点收获



unit Profile;

interface

uses
  SysUtils, Classes, Windows, Controls, Forms;

{$IFNDEF TIMEPROFILE}
  {$DEFINE TIMEPROFILE} { 需要测试时去掉"."即可 }
{$ENDIF}

type
  { 性能测试对象 }
  TTimeProfiler = class(TObject)
  private
    {$IFDEF TIMEPROFILE}
    FItemList, FHistoryList: TStringList;
    FLogStream: TFileStream;
    FLevel: Integer;
    FTimeID: Integer;
    function RecordToString(ClassName, Method: string; Tick: Cardinal): string;
    procedure StringToRecord(Str: string; var ClassName, Method: string; var Tick: Cardinal);
    function Ident: string;
    procedure AddString(s: string; WithBreak: Boolean = True);
    procedure AddHR(CH: Char = '-'; Width: Integer = 80);
    procedure AddBR;
    function GetItem(TestID: Integer): string;
    {$ENDIF}
  public
    constructor Create(LogName: string);
    destructor Destroy; override;
    { 开始测试 }
    function BeginTest(ClassName: string; Method: string): Integer;
    { 结束测试 }
    function EndTest(TestID: Integer): Cardinal;
  end;

  { 性能测试接口，利用接口技术实现自动释放 }
  ITimeProfiler = interface
    ['{4F54512F-728C-438E-9CAE-A10257A58439}']
  end;

  { 函数性能测试对象 }
  TFunctionTimeProfiler = class(TInterfacedObject, ITimeProfiler)
  private
    FTimeID: Integer;
  public
    constructor Create(TimeID: Integer);
    destructor Destroy; override;
    class function ExecuteTest(ClassName: string; Method: string): ITimeProfiler;
  end;

var
  TimeProfiler: TTimeProfiler;

implementation

function iif(const Condition: Boolean; const IfTrue: string; const IfFalse: string): string;
begin
  if Condition then
    Result := IfTrue
  else
    Result := IfFalse;
end;

{ TTimeProfiler }

constructor TTimeProfiler.Create(LogName: string);
begin
  {$IFDEF TIMEPROFILE}
  FTimeID := 0;
  FLevel := 0;
  FItemList := TStringList.Create;
  FHistoryList := TStringList.Create;
  LogName := Trim(LogName);
  if FileExists(LogName) then
  begin
    FLogStream := TFileStream.Create(LogName, fmOpenWrite);
    FLogStream.Seek(0, soFromEnd);
  end
  else
    FLogStream := TFileStream.Create(LogName, fmCreate);
  AddBR;
  AddHR;
  AddString(Format(' 软件性能测试 - 测试时间：%s ', [DateTimeToStr(Now)]));
  AddHR;
  {$ENDIF}
end;

destructor TTimeProfiler.Destroy;
{$IFDEF TIMEPROFILE}
var
  i: Integer;
  ClassName, Method: string;
  Tick: Cardinal;
{$ENDIF}
begin
  {$IFDEF TIMEPROFILE}
  { 保存综合测试结果 }
  if FHistoryList.Count > 0 then
  begin
    AddBR;
    AddHR('*');
    AddString(' 所有函数测试结果(按所花费时间排序) ');
    AddHR('*');
    FHistoryList.Sort;
    for i := FHistoryList.Count - 1 downto 0 do
    begin
      StringToRecord(FHistoryList[i], ClassName, Method, Tick);
      AddString(ClassName + iif(ClassName <> '', '.', '') + Method + ' - Used Time: ' + Format('%.3f', [Tick / 1000]) + ' sec.');
    end;
  end;
  AddBR;
  AddHR;
  AddString(Format(' 软件性能测试 - 测试结束，时间：%s ', [DateTimeToStr(Now)]));
  AddHR;
  if Assigned(FItemList) then
    FreeAndNil(FItemList);
  if Assigned(FHistoryList) then
    FreeAndNil(FHistoryList);
  if Assigned(FLogStream) then
    FreeAndNil(FLogStream);
  {$ENDIF}
  inherited Destroy;
end;

function TTimeProfiler.BeginTest(ClassName, Method: string): Integer;
begin
  {$IFDEF TIMEPROFILE}
  Inc(FTimeID);
  FItemList.AddObject(RecordToString(ClassName, Method, GetTickCount), Pointer(FTimeID));
  AddString(Ident + ClassName + iif(ClassName <> '', '.', '') + Method + ' - Begin');
  Inc(FLevel);
  Result := FTimeID;
  {$ELSE}
  Result := 0;
  {$ENDIF}
end;

function TTimeProfiler.EndTest(TestID: Integer): Cardinal;
{$IFDEF TIMEPROFILE}
var
  ClassName, Method, s: string;
  Tick: Cardinal;
{$ENDIF}
begin
  {$IFDEF TIMEPROFILE}
  s := GetItem(TestID);
  if s = '' then
    Exception.Create('Cannot end the test ' + IntToStr(TestID) + '!');
  StringToRecord(s, ClassName, Method, Tick);
  Result := GetTickCount - Tick;
  FItemList.Delete(FItemList.Count - 1);
  Dec(FLevel);
  AddString(Ident + ClassName + iif(ClassName <> '', '.', '') + Method + ' - End (Used Time: ' + Format('%.3f', [Result / 1000]) + ' sec.)');
  //if FLevel = 0 then //只保存第一级测试结果
    FHistoryList.Add(RecordToString(ClassName, Method, Result));
  {$ELSE}
  Result := 0;
  {$ENDIF}
end;

{$IFDEF TIMEPROFILE}
function TTimeProfiler.RecordToString(ClassName, Method: string;
  Tick: Cardinal): string;
begin
  Result := Format('%-.8d|%s.%s', [Tick, ClassName, Method]);
end;

procedure TTimeProfiler.StringToRecord(Str: string; var ClassName,
  Method: string; var Tick: Cardinal);
begin
  Tick := StrToIntDef(GetShortHint(Str), 0);
  Str := StringReplace(GetLongHint(Str), '.', '|', [rfReplaceAll]);
  ClassName := GetShortHint(Str);
  Method := GetLongHint(Str);
end;

procedure TTimeProfiler.AddString(s: string; WithBreak: Boolean);
begin
  if Assigned(FLogStream) then
  begin
    if WithBreak then
      s := s + #13#10;
    FLogStream.WriteBuffer(Pointer(s)^, Length(s));
  end;
end;

function TTimeProfiler.Ident: string;
begin
  Result := StringOfChar(' ', FLevel * 4);
end;

procedure TTimeProfiler.AddHR;
begin
  AddString(StringOfChar(CH, Width));
end;

procedure TTimeProfiler.AddBR;
begin
  AddString(#13#10, False);
end;

function TTimeProfiler.GetItem(TestID: Integer): string;
var
  i: Integer;
begin
  Result := '';
  if FItemList.Count > 0 then
  begin
    {
    if TestID = -1 then
    begin
      Result := FItemList[FItemList.Count - 1];
      Exit;
    end;
    }
    for i := FItemList.Count - 1 downto 0 do
      if Integer(FItemList.Objects[i]) = TestID then
      begin
        Result := FItemList[i];
        Break;
      end;
  end;
end;
{$ENDIF}

{ TFunctionTimeProfiler }

constructor TFunctionTimeProfiler.Create(TimeID: Integer);
begin
  FTimeID := TimeID;
end;

destructor TFunctionTimeProfiler.Destroy;
begin
  TimeProfiler.EndTest(FTimeID);
  inherited Destroy;
end;

class function TFunctionTimeProfiler.ExecuteTest(ClassName: string;
  Method: string): ITimeProfiler;
begin
  {$IFDEF TIMEPROFILE}
  Result := TFunctionTimeProfiler.Create(TimeProfiler.BeginTest(ClassName, Method));
  {$ELSE}
  Result := nil;
  {$ENDIF}
end;

initialization
  if not Assigned(TimeProfiler) then
    TimeProfiler := TTimeProfiler.Create(ChangeFileExt(Application.ExeName, '.Time.txt'));

finalization
  if Assigned(TimeProfiler) then
    FreeAndNil(TimeProfiler);

end.