{{Copyright(c)2016 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
dickmaley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to dickmaley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
unit ads_TimingTester;
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_TimingTester.pas This unit contains the following routines.
Register TTimeTest_ads.GetStartTime TTimeTest_ads.Init TTimeTest_ads.Next TTimeTest_ads.SaveToFile TTimeTest_ads.SetActive TTimeTest_ads.SetDeltaTime TTimeTest_ads.SetEndTime TTimeTest_ads.SetFileName TTimeTest_ads.SetMaxLines TTimeTest_ads.SetOverWrite TTimeTest_ads.SetStartTime TTimeTest_ads.Start TTimeTest_ads.Stop_1 TTimeTest_ads.Stop_2 TTimeTest_ads.TimeDeltaInMSeconds TTimeTest_ads.TrimExcess TTimeTest_ads.UserName
*)
interface
Uses WinProcs, SysUtils, Classes;
{Copyright(c)2016 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
dickmaley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to dickmaley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*
TTimeTest_ads
Description:
TTimeTest_ads will record timing segments in delphi
code and rank longest to shortest.
Log File:
The timing results are saved in a log file called
UserName.log (where UserName is the person's Windows
Network Login ID). By default the file is put in the
same directory where the executable is. The
location and name of the log file can be changed
by changing the filename property.
Installation:
This tester can be used in any delphi unit including a
projects *.dpr file. Put the name of this unit in the
uses clause of any unit you want to test times in.
How to Use:
Put TimeTest_ads.Start('Caption'); before the first block
of code to be tested. Caption should be a unique identifer
for a chunk of code.
Put TimeTest_ads.Next('Caption'); before code that
ends one timing event and immediately starts a new one.
Put TimeTest_ads.Stop; anyplace that ends a timing event
and a new one is not to be started.
Disabling:
If you wish to leave the lines of code mentioned above
in your source code without degrading application
performance at times when timing tests are not needed
turn the component off by setting active to false.
TimeTest_ads.Active := False;
The following example shows how
the tester can be used.
Example Code:
program MasterControl;
uses
ads_TimingTester,
Forms,
MasterControl_dm in 'MasterControl_dm.pas' {dtm_MasterControl: TDataModule},
MasterControl_g in 'MasterControl_g.pas',
MasterControl_p in 'MasterControl_p.pas' {frm_MasterControl_Main},
Cmp_sec in '..\..\dcmp\4\ads\Cmp_Sec.pas';
{$R *.RES}
begin
TimeTest_ads.Start('BeforeInitialize');
Application.Initialize;
TimeTest_ads.Next('BeforeDM');
Application.CreateForm(Tdtm_MasterControl, dtm_MasterControl);
TimeTest_ads.Next('BeforeMain');
Application.CreateForm(Tfrm_MasterControl_Main, frm_MasterControl_Main);
TimeTest_ads.Next('BeforeRun');
Application.Run;
TimeTest_ads.Stop;
end.
Example Output:
ads_TimingTester Results
The left column ranks times from longest to shortest.
Time are in milliseconds.
DELTA ms START TIME END TIME CAPTION
00002360 980929031507p 980929031510p BeforeRun
00000500 980929031507p 980929031507p BeforeMain
00000050 980929031507p 980929031507p BeforeInitialize
00000000 980929031507p 980929031507p BeforeDM
*)
Type
TTimeTest_ads = class(TComponent)
Protected
FActive : Boolean;
FCaption : String;
FDeltaTime : Double;
FEndTime : TDateTime;
FFileName : TFileName;
FMaxLines : Integer;
FOverWrite : Boolean;
FStartTime : TDateTime;
lstLog : TStringList;
lstTemp : TStringList;
StartNames : TStringList;
StartTimes : TStringList;
tmpFileName: String;
Function UserName: string;
Function GetStartTime(Caption : String): TDateTime;
procedure SetActive(const Value: Boolean);
procedure SetDeltaTime(const Value: Double);
procedure SetEndTime(const Value: TDateTime);
procedure SetFileName(const Value: TFileName);
procedure SetMaxLines(const Value: Integer);
procedure SetOverWrite(const Value: Boolean);
procedure SetStartTime(const Value: TDateTime);
procedure TrimExcess;
Public
constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Function TimeDeltaInMSeconds(StartDate : TDateTime;EndDate : TDateTime): Double;
Procedure Init;
Procedure Next(Caption : String);
Procedure SaveToFile;
Procedure Start(Caption : String);
Procedure Stop; Overload;
Procedure Stop(Caption : String); Overload;
property OverWrite : Boolean read FOverWrite write SetOverWrite;
property Active : Boolean read FActive write SetActive;
property StartTime : TDateTime read FStartTime write SetStartTime;
property EndTime : TDateTime read FEndTime write SetEndTime;
property DeltaTime : Double read FDeltaTime write SetDeltaTime;
property MaxLines : Integer read FMaxLines write SetMaxLines;
Published
property FileName : TFileName read FFileName write SetFileName;
End;
Procedure Register;
Var
TimeTest_ads : TTimeTest_ads;
implementation
Constructor TTimeTest_ads.Create(AOwner: TComponent);
Begin
inherited Create(AOwner);
OverWrite := False;
tmpFileName := ExtractFilePath(ParamStr(0))+UserName+'.tmp';
If FileExists(tmpFileName) Then Deletefile(tmpFileName);
FileName := ExtractFilePath(ParamStr(0))+UserName+'.tim';
Active := True;
FMaxLines := 10000;
FCaption := '';
StartTime := 0;
EndTime := 0;
DeltaTime := 0.00;
lstLog := TStringList.Create();
lstTemp := TStringList.Create();
StartNames := TStringList.Create();
StartTimes := TStringList.Create();
lstLog .Clear;
lstTemp .Clear;
StartNames .Clear;
StartTimes .Clear;
End;
Destructor TTimeTest_ads.Destroy;
Begin
SaveToFile;
lstLog .Free;
lstTemp .Free;
StartNames .Free;
StartTimes .Free;
inherited destroy;
End;
//Unit Description UnitIndex Master Index
Function TTimeTest_ads.UserName: string;
Var
sgUserName : String;
iwUserNameLen : DWord;
Begin
iwUserNameLen := 255;
SetLength(sgUserName, iwUserNameLen);
If GetUserName(PChar(sgUserName), iwUserNameLen) Then
Result := Copy(sgUserName,1,iwUserNameLen - 1)
Else
Result := 'Unknown';
End;
//Unit Description UnitIndex Master Index
Function TTimeTest_ads.TimeDeltaInMSeconds(StartDate, EndDate: TDateTime): Double;
Var
Hour, Min, Sec, MSec: Word;
Delta: TDateTime;
Begin
Try
Delta := EndDate - StartDate;
DecodeTime(Delta, Hour, Min, Sec, MSec);
Result := (((((Hour*60)+Min)*60)+Sec)*1000)+MSec;
Except
Result := 0;
End;
End;
//Unit Description UnitIndex Master Index
Procedure TTimeTest_ads.SaveToFile;
Var
lstPrior : TStringlist;
lstFinal : TStringlist;
inCounter : Integer;
Begin
If Not Active Then Exit;
lstPrior := TStringlist.Create();
lstFinal := TStringlist.Create();
Try
If Not OverWrite Then
Begin
lstPrior.clear;
If FileExists(FileName) Then
Begin
Try
lstPrior.LoadFromFile(FileName);
Except
lstPrior.clear;
End;
End;
End;
If FileExists(tmpFileName) Then
Begin
lstTemp.LoadFromFile(tmpFileName);
lstLog.SetText(PChar(lstTemp.Text+lstLog.Text));
lstTemp.Clear;
DeleteFile(tmpFileName);
End;
lstLog.Sorted := True;
lstFinal.Clear;
lstFinal.Add('ads_TimingTester Results '+FormatDateTime('mm/dd/yy hh:nn:ss a/p',now()));
lstFinal.Add('');
lstFinal.Add('The left column ranks times from longest to shortest.');
lstFinal.Add('Time are in milliseconds.');
lstFinal.Add('');
lstFinal.Add('DELTA ms START TIME END TIME CAPTION');
For inCounter := (lstLog.Count -1) DownTo 0 Do
Begin
lstFinal.Add(lstLog[inCounter]);
End;
If Not OverWrite Then
Begin
lstFinal.Append('____________________________________________');
lstFinal.Append(lstPrior.Text);
End;
Try
If lstFinal.Count > MaxLines Then
Begin
For inCounter := (lstFinal.Count - 1) DownTo (MaxLines - 1) Do
Begin
lstFinal.Delete(inCounter);
End;
For inCounter := (lstFinal.Count - 1) DownTo 0 Do
Begin
If Not (lstFinal[inCounter] = '____________________________________________') Then
Begin
lstFinal.Delete(inCounter);
End
Else
Begin
Break;
End;
End;
End;
lstFinal.SaveToFile(FileName);
Except
End;
Finally
lstPrior.Free;
lstFinal.Free;
End;
End;
//Unit Description UnitIndex Master Index
Procedure TTimeTest_ads.Stop;
Var
sgTempFile : String;
sgDelta : String;
Begin
If Not Active Then Exit;
EndTime := now();
DeltaTime := TimeDeltaInMSeconds(StartTime, EndTime);
sgDelta := FormatFloat('00000000',DeltaTime);
If sgDelta <> '00000000' Then
Begin
If Not (Trim(FCaption) = '') Then
Begin
lstLog.Add(
FormatFloat('00000000',DeltaTime) +
' ' +
FormatDateTime('yymmddhhnnssa/p', StartTime)+
' ' +
FormatDateTime('yymmddhhnnssa/p', EndTime) +
' ' +
FCaption);
End;
If lstLog.Count > 2 Then
Begin
sgTempFile := '';
If FileExists(tmpFileName) Then
Begin
lstTemp.LoadFromFile(tmpFileName);
sgTempFile := lstTemp.Text;
End;
lstTemp.SetText(PChar(sgTempFile+lstLog.Text));
lstTemp.SaveToFile(tmpFileName);
lstTemp.Clear;
lstLog .Clear;
End;
End;
Init;
End;
//Unit Description UnitIndex Master IndexProcedure TTimeTest_ads.Init; Begin FCaption := ''; StartTime := 0; EndTime := 0; DeltaTime := 0.00; End; //Unit Description UnitIndex Master Index
Procedure TTimeTest_ads.Start(Caption : String);
Begin
If Not Active Then Exit;
FCaption := Caption;
StartTime := now();
StartNames.Add(UpperCase(Caption));
StartTimes.Add(FormatFloat('#0.000000',StartTime));
If StartNames.Count > 1000 Then TrimExcess;
End;
//Unit Description UnitIndex Master IndexProcedure TTimeTest_ads.Next(Caption : String); Begin If Not Active Then Exit; Stop; Start(Caption); End; //Unit Description UnitIndex Master Index
procedure TTimeTest_ads.SetDeltaTime(const Value: Double); begin FDeltaTime := Value; end; //Unit Description UnitIndex Master Index
procedure TTimeTest_ads.SetEndTime(const Value: TDateTime); begin FEndTime := Value; end; //Unit Description UnitIndex Master Index
procedure TTimeTest_ads.SetFileName(const Value: TFileName);
Var
sgOldTemp : String;
begin
FFileName := Value;
sgOldTemp := tmpFileName;
tmpFileName:= Copy(FFileName,1,Length(FFileName)-3)+'tmp';
If Not (sgOldTemp = tmpFileName) Then
Begin
If FileExists(tmpFileName) Then Deletefile(tmpFileName);
If FileExists(sgOldTemp) Then CopyFile(PChar(sgOldTemp),PChar(tmpFileName),False);
If FileExists(sgOldTemp) Then Deletefile(sgOldTemp);
End;
end;
//Unit Description UnitIndex Master Indexprocedure TTimeTest_ads.SetStartTime(const Value: TDateTime); begin FStartTime := Value; end; //Unit Description UnitIndex Master Index
Procedure Register;
Begin
RegisterComponents('ads', [TTimeTest_ads]);
End;
//Unit Description UnitIndex Master Indexprocedure TTimeTest_ads.SetActive(const Value: Boolean); begin FActive := Value; end; //Unit Description UnitIndex Master Index
procedure TTimeTest_ads.SetOverWrite(const Value: Boolean); begin FOverWrite := Value; end; //Unit Description UnitIndex Master Index
procedure TTimeTest_ads.SetMaxLines(const Value: Integer); begin FMaxLines := Value; end; //Unit Description UnitIndex Master Index
procedure TTimeTest_ads.Stop(Caption: String);
Var
dtStart : TDateTime;
Begin
If Not Active Then Exit;
dtStart := GetStartTime(Caption);
If dtStart <> 0 Then
Begin
StartTime := dtStart;
FCaption := Caption;
End;
Stop;
End;
//Unit Description UnitIndex Master Index
function TTimeTest_ads.GetStartTime(Caption: String): TDateTime;
Var
inCounter : Integer;
sgDt : String;
inMax : Integer;
inIndex : Integer;
begin
Result := 0;
Try
If Not Active Then Exit;
Caption := UpperCase(Caption);
inMax := StartNames.Count -1;
inIndex := -1;
For inCounter := inMax DownTo 0 Do
Begin
If StartNames[inCounter] <> Caption Then Continue;
inIndex := inCounter;
Break;
End;
If inIndex = -1 Then Exit;
sgDt := StartTimes[inIndex];
StartNames.Delete(inIndex);
StartTimes.Delete(inIndex);
Result := StrToFloat(sgDt);
Except
Result := 0;
End;
End;
//Unit Description UnitIndex Master Index
procedure TTimeTest_ads.TrimExcess;
Var
inCounter : Integer;
inToTrim : Integer;
begin
If Not Active Then Exit;
inToTrim := StartNames.Count - 1000;
If inToTrim < 0 Then Exit;
For inCounter := 1 To inToTrim Do
Begin
StartNames.Delete(0);
StartTimes.Delete(0);
End;
end;
Initialization
TimeTest_ads := TTimeTest_ads.Create(nil);
Finalization
TimeTest_ads.Free;
end.
//