debug.pas

H++编译器: 一个仿Pascal语言的编译器

unit Debug;

interface

uses
  Windows, SysUtils;

procedure AppDebug(Filename, Params: String; DebugIt: Boolean);

implementation

procedure AppDebug(Filename, Params: String; DebugIt: Boolean);
var
  startup: STARTUPINFO;
  dbgevent: DEBUG_EVENT;
  pi: PROCESS_INFORMATION;
  str: String;
  dodebug: Boolean;

procedure ShowMenu;
begin
  if DebugIt then
  begin
    Write('- ');
    ReadLn(str);
  end;
end;

begin
  dodebug := True;
  GetStartupInfo(startup);
  CreateProcess(nil,PChar(Filename+' '+Params),nil,nil,False,DEBUG_PROCESS+DEBUG_ONLY_THIS_PROCESS,nil,nil,startup,pi);
  while dodebug = True do
  begin
    WaitForDebugEvent(dbgevent,INFINITE);
    if dbgevent.dwDebugEventCode = EXIT_PROCESS_DEBUG_EVENT then
    begin
      if DebugIt then WriteLn('Debug: Debug exits process.');
      dodebug := False;
    end
    else if dbgevent.dwDebugEventCode = CREATE_PROCESS_DEBUG_EVENT then
    begin
      if DebugIt then WriteLn('File Handle:    '+IntToHex(dbgevent.CreateProcessInfo.hFile,8)+#13#10+
                              'Process Handle: '+IntToHex(Int64(dbgevent.CreateProcessInfo.hProcess),8)+#13#10+
                              'Thread Handle:  '+IntToHex(dbgevent.CreateProcessInfo.hThread,8)+#13#10+
                              'Image Base:     '+IntToHex(Int64(dbgevent.CreateProcessInfo.lpBaseOfImage),8)+#13#10+
                              'Start Address:  '+IntToHex(Int64(dbgevent.CreateProcessInfo.lpStartAddress),8));
    end
    else if dbgevent.dwDebugEventCode = CREATE_THREAD_DEBUG_EVENT then
      if DebugIt then WriteLn('Debug: A new thread is created.')
    else if dbgevent.dwDebugEventCode = EXIT_THREAD_DEBUG_EVENT then
      if DebugIt then WriteLn('Debug: A thread is destroyed.')
    else if dbgevent.dwDebugEventCode = EXCEPTION_DEBUG_EVENT then
    begin
      if dbgevent.Exception.ExceptionRecord.ExceptionCode = EXCEPTION_BREAKPOINT then
        ContinueDebugEvent(dbgevent.dwProcessId,dbgevent.dwThreadId,DBG_CONTINUE)
      else
        WriteLn('Debug Error: ...');
    end;

    ContinueDebugEvent(dbgevent.dwProcessId,dbgevent.dwThreadId,DBG_EXCEPTION_NOT_HANDLED);
  end;
  CloseHandle(pi.hProcess);
  CloseHandle(pi.hThread);
end;

end.