Mega Code Archive
Send string via Windows API to Delphis (or others) Debugger
<![CDATA[
Title: Send string via Windows API to Delphi's (or other's) Debugger?
{-----------------------------------------------------------------------------
Unit Name : DelphiDebug
Author : Loïs Bégué
Date : 10-Jan-2005
Purpose : Send string via Windows API to Delphi's (or other's) Debugger
The Delphi Debugger will put the messages in the event
protocol window of the IDE (Ctrl +Alt + V)
Each line may include a time stamp / duration
-----------------------------------------------------------------------------}
unit DelphiDebug;
interface
uses Windows, Sysutils;
procedure DebugStringStart(aCaption, aText: string);
procedure DebugStringStop(aCaption, aText: string);
procedure DebugString(aCaption, aText: string);
implementation
uses
Dialogs;
type
TDebugStringProc = procedure(aCaption, aText: string);
var
StartDT: TDateTime;
StopDT: TDateTime;
StartDTPrec: Int64;
StopDTPrec: Int64;
PerfFrequency: Int64;
DSStart: TDebugStringProc;
DSStop: TDebugStringProc;
DSStr: TDebugStringProc;
// GetFormatDT - Output = formated DateTime String
function GetFormatDT(aDateTime: TDateTime): string;
begin
Result := FormatDateTime('dd.mm.yy hh:nn:ss zzz', aDateTime);
end;
// GetFormatT - Output = formated Time String
function GetFormatT(aDateTime: TDateTime): string;
begin
Result := FormatDateTime('hh:nn:ss zzz', aDateTime)
end;
// _DebugStringStart - internal: Debug string at start time
procedure _DebugStringStart(aCaption, aText: string);
begin
StartDT := Now;
OutputDebugString(PChar(Format('[%s][%s] %s',
[aCaption, GetFormatDT(StartDT),
aText])));
end;
// _DebugStringStop - internal: Debug string at stop time
procedure _DebugStringStop(aCaption, aText: string);
begin
StopDT := Now;
OutputDebugString(PChar(Format('[%s][%s][%s] %s',
[aCaption, GetFormatDT(StopDT),
GetFormatT(StopDT - StartDT),
aText])));
end;
// _DebugStringStart - internal: Debug string at start time (high definition)
procedure _DebugStringStartPrecision(aCaption, aText: string);
begin
QueryPerformanceCounter(StartDTPrec);
OutputDebugString(PChar(Format('[%s][%s] %s',
[aCaption, GetFormatDT(Now()),
aText])));
end;
// _DebugStringStop - internal: Debug string at stop time (high definition) in ms
procedure _DebugStringStopPrecision(aCaption, aText: string);
begin
QueryPerformanceCounter(StopDTPrec);
OutputDebugString(PChar(Format('[%s][%s][%.2n ms] %s',
[aCaption, GetFormatDT(Now()),
(1000 * (StopDTPrec - StartDTPrec) / PerfFrequency),
aText])));
end;
// DebugStringStart - external: wrapper function
procedure DebugStringStart(aCaption, aText: string);
begin
DSStart(aCaption, aText);
end;
// DebugStringStop - external: wrapper function
procedure DebugStringStop(aCaption, aText: string);
begin
DSStop(aCaption, aText);
end;
// DebugString - external: direct mode
procedure DebugString(aCaption, aText: string);
begin
OutputDebugString(PChar(Format('[%s][%s] %s',
[aCaption, GetFormatDT(Now()),
aText])));
end;
initialization
// If the high definition mode's available, then
// link external calls to the "Precision" functions ...
if QueryPerformanceFrequency(PerfFrequency) then
begin
DSStart := _DebugStringStartPrecision;
DSStop := _DebugStringStopPrecision;
end
// ... else link to the "normal" ones.
else
begin
DSStart := _DebugStringStart;
DSStop := _DebugStringStop;
end;
end.
{-----------------------------------------------------------------------------
Procedure : btnTestDelphiDebugMessageClick
Author : Loïs Bégué
Date : 10-Jan-2005
Purpose : Sample usage of the DelphiDebug functionality
-----------------------------------------------------------------------------}
procedure TForm1.btnTestDelphiDebugMessageClick(Sender: TObject);
begin
(* Single start-stop *)
DebugStringStart('Test', 'First Step Start');
// ... do something ...
DebugStringStop('Test', 'First Step End');
(* or multi stop *)
DebugStringStart('Test', 'First Step');
// ... do something ...
DebugStringStop('Test', 'Second Step');
// ... do something ...
DebugStringStop('Test', 'Third Step');
// ... do something ...
DebugStringStop('Test', 'Fourth Step');
(* or position marking *)
// ... do something ...
DebugString('Test', 'This line has been fired at the given time...');
// ... do something ...
end;
]]>