Catch-debug-information-of-an-application


            Title: Catch debug information of an application
Question: Ever wanted to read the debug information an application sends out?
Answer:
This little codesnippet will ask for the ProcessID (PID) of the application you want to catch debug information from. I did not have time to write some code for it right now, so in the meantime use the taskmanager and get the PID there. :)
Type
 TDebugThread = Class(TThread)
 Private
 { Private declarations }
 Protected
 { Protected declarations }
 Procedure Execute; override;
 Public
 { Public declarations }
 Constructor Create;
 Destructor Destroy; override;
 End;
 TForm1 = class(TForm)
 Memo1: TMemo;
 TreeView1: TTreeView;
 procedure FormCreate(Sender: TObject);
 procedure FormDestroy(Sender: TObject);
 private
 { Private declarations }
 DebugThread : TDebugThread;
 public
 { Public declarations }
 Procedure BeginCompile(Sender: TObject);
 end;
var
 Form1: TForm1;
Implementation
Procedure TForm1.FormCreate(Sender: TObject);
Begin
 DebugThread := TDebugThread.Create;
End;
procedure TForm1.FormDestroy(Sender: TObject);
Begin
 DebugThread.Terminate;
End;
Procedure TDebugThread.Execute;
Var
 DebugEvent : _Debug_Event;
 ReadLen : DWord;
 StrBuffer : pChar;
 UniBuffer : WideString;
 S : String;
 DbgHandle : THandle;
 OpenHandle : THandle;
 // ProcessNode : TTreeNode;
 ThreadNode : TTreeNode;
Begin
 S := InputBox('Process', 'Handle', '0');
 DbgHandle := StrToIntDef(S, 0);
 OpenHandle := OpenProcess(PROCESS_ALL_ACCESS, True, DbgHandle);
 IF (DebugActiveProcess(DbgHandle)) Then Form1.Caption := 'Debug ok'
 Else Form1.Caption := 'Debug failed';
 Form1.TreeView1.Items.Clear;
 ThreadNode := Form1.TreeView1.Items.AddChild(NIL, 'Threads');
 // ProcessNode := Form1.TreeView1.Items.AddChild(NIL, 'Processes');
 While (not Terminated) do
 Begin
 Sleep(0);
 IF (WaitForDebugEvent(DebugEvent, 100)) Then
 Begin
 IF (not Application.Terminated) Then
 Begin
 Case DebugEvent.dwDebugEventCode of
 OUTPUT_DEBUG_STRING_EVENT : Begin
 IF (DebugEvent.DebugString.fUnicode = 0) Then
 Begin
 StrBuffer := StrAlloc(DebugEvent.DebugString.nDebugStringLength);
 ReadProcessMemory(OpenHandle{DebugEvent.dwProcessId}, @DebugEvent.DebugString.lpDebugStringData^, StrBuffer, DebugEvent.DebugString.nDebugStringLength, ReadLen);
 Form1.Memo1.Lines.Add(IntToStr(ReadLen)+' - STR - '+StrPas(StrBuffer));
 StrDispose(StrBuffer);
 End
 Else
 Begin
 SetLength(UniBuffer, DebugEvent.DebugString.nDebugStringLength);
 ReadProcessMemory(DebugEvent.dwProcessId, DebugEvent.DebugString.lpDebugStringData, @UniBuffer[1], DebugEvent.DebugString.nDebugStringLength, ReadLen);
 UniBuffer := Copy(UniBuffer, 1, ReadLen);
 Form1.Memo2.Lines.Add(IntToStr(DebugEvent.DebugString.nDebugStringLength)+' - UNI - '{+UniBuffer});
 End;
 End;
 CREATE_THREAD_DEBUG_EVENT : Begin
 Form1.TreeView1.Items.AddChild(ThreadNode, IntToStr(DebugEvent.CreateThread.hThread));
 End;
 End;
 End;
 ContinueDebugEvent(DebugEvent.dwProcessId, DebugEvent.dwThreadId, DBG_CONTINUE);
 End
 Else Sleep(50);
 End;
 CloseHandle(OpenHandle);
End;
Constructor TDebugThread.Create;
Begin
 Inherited Create(False);
 FreeOnTerminate := True;
End;
Destructor TDebugThread.Destroy;
Begin
 Inherited Destroy;
End;
End.
Forms Delphi
