自己写的一个测试函数执行效率的单元(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 .