was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1541)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (126)
Strings (83)
System (266)
VCL (242)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

24 Visitors Online


 
...Nachrichten an Delphi's Debugger via Windows API abschicken?
Autor: Loïs Bégué
Homepage: http://www.arpoon.com
[ Tip ausdrucken ]  

Tip Bewertung (10):  
     


{-----------------------------------------------------------------------------
 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;


 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners