Bu unit program Timing Tester işleminde kullanılır.
Kod: Tümünü seç
unit ads_TimingTester;
interface
Uses WinProcs, SysUtils, Classes;
(*
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)
Private
lstLog : TStringList;
lstTemp : TStringList;
FCaption : String;
FDeltaTime: Double;
FEndTime: TDateTime;
FStartTime: TDateTime;
FFileName: TFileName;
FActive: Boolean;
FOverWrite: Boolean;
FMaxLines: Integer;
tmpFileName: String;
procedure SetDeltaTime(const Value: Double);
procedure SetEndTime(const Value: TDateTime);
procedure SetFileName(const Value: TFileName);
procedure SetStartTime(const Value: TDateTime);
procedure SetActive(const Value: Boolean);
procedure SetOverWrite(const Value: Boolean);
Function UserName: string;
procedure SetMaxLines(const Value: Integer);
Public
Function TimeDeltaInMSeconds(StartDate : TDateTime;EndDate : TDateTime): Double;
Procedure Start(Caption : String);
Procedure Next(Caption : String);
Procedure Stop;
Procedure SaveToFile;
Procedure Init;
constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
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();
lstLog .Clear;
lstTemp .Clear;
End;
Destructor TTimeTest_ads.Destroy;
Begin
SaveToFile;
lstLog .Free;
lstTemp.Free;
inherited destroy;
End;
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;
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;
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;
Procedure TTimeTest_ads.Stop;
Var
sgTempFile : String;
Begin
If Not Active Then Exit;
EndTime := now();
DeltaTime := TimeDeltaInMSeconds(StartTime, EndTime);
If Not (Trim(FCaption) = '') Then
Begin
lstLog.Add(
FormatFloat('00000000',DeltaTime) +
' ' +
FormatDateTime('yymmddhhnnssa/p', StartTime)+
' ' +
FormatDateTime('yymmddhhnnssa/p', EndTime) +
' ' +
FCaption);
End;
If lstLog.Count > 20 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;
Init;
End;
Procedure TTimeTest_ads.Init;
Begin
FCaption := '';
StartTime := 0;
EndTime := 0;
DeltaTime := 0.00;
End;
Procedure TTimeTest_ads.Start(Caption : String);
Begin
If Not Active Then Exit;
FCaption := Caption;
StartTime := now();
End;
Procedure TTimeTest_ads.Next(Caption : String);
Begin
If Not Active Then Exit;
Stop;
Start(Caption);
End;
procedure TTimeTest_ads.SetDeltaTime(const Value: Double);
begin
FDeltaTime := Value;
end;
procedure TTimeTest_ads.SetEndTime(const Value: TDateTime);
begin
FEndTime := Value;
end;
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;
procedure TTimeTest_ads.SetStartTime(const Value: TDateTime);
begin
FStartTime := Value;
end;
Procedure Register;
Begin
RegisterComponents('ads', [TTimeTest_ads]);
End;
procedure TTimeTest_ads.SetActive(const Value: Boolean);
begin
FActive := Value;
end;
procedure TTimeTest_ads.SetOverWrite(const Value: Boolean);
begin
FOverWrite := Value;
end;
procedure TTimeTest_ads.SetMaxLines(const Value: Integer);
begin
FMaxLines := Value;
end;
Initialization
TimeTest_ads := TTimeTest_ads.Create(nil);
Finalization
TimeTest_ads.Free;
end.