absdebug.pas

Absolute Database 是来替代BDE[Borland数据库引擎]的用于Delphi 和 C++ Builder 开发用的数据库引擎. 它小巧, 高速, 健壮, 易于使用. 它能直接编译进

//==============================================================================
// Unit name: ABSDebug
// Debug library, contains time measurement routines.
// Date: 04/18/2003
//==============================================================================
unit ABSDebug;

{$I ABSVER.INC}

interface

uses windows, sysutils, dialogs;

var DebugOff:       Boolean = False;
    DebugStarted:   Boolean = False;

type
  TABSTestTime = 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: TABSTestTime): Integer; overload;
// inits time counting
procedure aaInitTime; overload;
procedure aaInitTime(var TimeRec: TABSTestTime); overload;
// starts time counting from current time
procedure aaStartTime; overload;
procedure aaStartTime(var TimeRec: TABSTestTime); overload;
// stops time counting
procedure aaStopTime; overload;
procedure aaStopTime(var TimeRec: TABSTestTime); overload;
// shows time
procedure aaShowTime; overload;
procedure aaShowTime(var TimeRec: TABSTestTime); overload;
// write time to log
procedure aaWriteTime; overload;
procedure aaWriteTime(var TimeRec: TABSTestTime); 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: TABSTestTime): 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: TABSTestTime);
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: TABSTestTime);
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: TABSTestTime);
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: TABSTestTime);
begin
 ShowMessage(TimeRec.name + inttostr(aaGetTime(TimeRec)));
end;


// write time to log
procedure aaWriteTime;
begin
 aaWriteToLog('time = '+inttostr(aaGetTime));
end;


procedure aaWriteTime(var TimeRec: TABSTestTime);
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.