|
运用了一点技巧来实现对函数进行效率测试
使用方法:
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, 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) = TestID then
begin
Result := FItemList;
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. |
|