?? myldbdebug.pas
字號:
// Unit name: MYLDBDebug
// Debug library, contains time measurement routines.
// Date: 04/18/2003
//==============================================================================
unit MYLDBDebug;
{$I MYLDBVER.INC}
interface
uses windows, sysutils, dialogs;
var DebugOff: Boolean = False;
DebugStarted: Boolean = False;
type
TMYLDBTestTime = record
name: string;
startTime: Integer;
stopTime: Integer;
timeStarted: Boolean;
timeRestarted: Boolean;
end;
var startTime, stopTime : Integer;
timeStarted : Boolean = false; // if true - time is counting, else - pause
timeRestarted : Boolean = false; // if true - restart time counting
Counter: Integer;
var logFileName: string;
const logName = 'abs_log.txt';
// gets counted time in milliseconds (based on GetTickCount)
function aaGetTime : Integer; overload;
function aaGetTime(var TimeRec: TMYLDBTestTime): Integer; overload;
// inits time counting
procedure aaInitTime; overload;
procedure aaInitTime(var TimeRec: TMYLDBTestTime); overload;
// starts time counting from current time
procedure aaStartTime; overload;
procedure aaStartTime(var TimeRec: TMYLDBTestTime); overload;
// stops time counting
procedure aaStopTime; overload;
procedure aaStopTime(var TimeRec: TMYLDBTestTime); overload;
// shows time
procedure aaShowTime; overload;
procedure aaShowTime(var TimeRec: TMYLDBTestTime); overload;
// write time to log
procedure aaWriteTime; overload;
procedure aaWriteTime(var TimeRec: TMYLDBTestTime); overload;
// writes string to log file
procedure aaWriteToLog(s: string); overload; // writes string to log file
// writes string to log file
procedure aaWriteToLog(Msg: String; const Args: array of const); overload; // writes string to log file
// delete log
procedure EmptyLog;
// SL = simple logging
procedure SLWriteStartTime(FunctionName: string);
procedure SLWriteEndTime(FunctionName: string);
implementation
var
// SL = simple logging
SLStartTime, SLEndTime: TDateTime;
//-------------------------------- DEBUG ---------------------------------------
// gets counted time in milliseconds (based on GetTickCount)
function aaGetTime : Integer;
begin
if (timeStarted) then
Result := GetTickCount - startTime
else
Result := stopTime - startTime;
end; // aaGetTime
function aaGetTime(var TimeRec: TMYLDBTestTime): Integer;
begin
if (TimeRec.timeStarted) then
Result := GetTickCount - TimeRec.startTime
else
Result := TimeRec.stopTime - TimeRec.startTime;
end; // aaGetTime
// inits time counting
procedure aaInitTime;
begin
timeRestarted := true;
startTime := 0;
stopTime := 0;
timeStarted := false;
Counter := 0;
end;
// inits time counting
procedure aaInitTime(var TimeRec: TMYLDBTestTime);
begin
TimeRec.timeRestarted := true;
TimeRec.startTime := 0;
TimeRec.stopTime := 0;
TimeRec.timeStarted := false;
end;
// starts time counting from current time
procedure aaStartTime;
begin
Inc(Counter);
if (timeRestarted) then
begin
startTime := GetTickCount;
timeRestarted := false;
timeStarted := true;
end
else
if (not timeStarted) then
begin
startTime := startTime + GetTickCount - stopTime;
end;
end;
// starts time counting from current time
procedure aaStartTime(var TimeRec: TMYLDBTestTime);
begin
if (TimeRec.timeRestarted) then
begin
TimeRec.startTime := GetTickCount;
TimeRec.timeRestarted := false;
TimeRec.timeStarted := true;
end
else
if (not TimeRec.timeStarted) then
begin
TimeRec.startTime := TimeRec.startTime + GetTickCount - TimeRec.stopTime;
end;
end;
// stops time counting
procedure aaStopTime;
begin
timeStarted := false;
stopTime := GetTickCount;
end;
// stops time counting
procedure aaStopTime(var TimeRec: TMYLDBTestTime);
begin
TimeRec.timeStarted := false;
TimeRec.stopTime := GetTickCount;
end;
// shows time
procedure aaShowTime;
begin
ShowMessage('time = '+inttostr(aaGetTime)+', Counter='+IntToStr(Counter));
end;
// shows time
procedure aaShowTime(var TimeRec: TMYLDBTestTime);
begin
ShowMessage(TimeRec.name + inttostr(aaGetTime(TimeRec)));
end;
// write time to log
procedure aaWriteTime;
begin
aaWriteToLog('time = '+inttostr(aaGetTime));
end;
procedure aaWriteTime(var TimeRec: TMYLDBTestTime);
begin
aaWriteToLog(TimeRec.name + inttostr(aaGetTime(TimeRec)));
end;
//-------------------------------- DEBUG ---------------------------------------
// writes string to log file
procedure aaWriteToLog(s : string); overload;
var f : Text;
begin
{$IFNDEF DEBUG_LOG}
Exit;
{$ENDIF}
if (DebugOff) then
Exit;
Assign(f,logFileName);
if (FileExists(logFileName)) then
Append(f)
else
ReWrite(f);
Writeln(f,s);
Close(f);
end;
procedure aaWriteToLog(Msg : string; const Args: array of const); overload;
var
Text: string;
begin
{$IFNDEF DEBUG_LOG}
Exit;
{$ENDIF}
if (DebugOff) then
Exit;
try
Text := Format(Msg, Args);
except
Text := Msg + ' Arguments are invalid!';
end;
aaWriteToLog(Text);
end;
procedure EmptyLog;
var f: text;
begin
Assign(f,logFileName);
ReWrite(f);
Close(f);
end;
procedure SLWriteStartTime(FunctionName: string);
begin
SLStartTime := Time;
aaWriteToLog(FormatDateTime('hh:nn:ss.zzz', SLStartTime) + ' ' + FunctionName + ' started');
end;
procedure SLWriteEndTime(FunctionName: string);
begin
SLEndTime := Time;
aaWriteToLog(FormatDateTime('hh:nn:ss.zzz', SLEndTime) + ' ' + FunctionName + ' finished , execution time ' +
FormatDateTime('hh:nn:ss.zzz', SLStartTime - SLEndTime));
end;
initialization
// logFileName := GetCurrentDir+'\'+logName;
logFileName := logName;
// Delete Old Log !
DeleteFile(logFileName);
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -