-
-
[求助]求教Delphi调试技术
-
发表于: 2008-9-23 08:48
-
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{调试信息处理过程}
procedure DebugPro;
var
si: _STARTUPINFOA; (进程启动信息}
pi: _PROCESS_INFORMATION; {进程信息}
Flage: DWORD;
DebugD: DEBUG_EVENT; {调试事件}
Rc: Boolean;
CodeCount: DWORD; {运行的指令数}
ThreadHandle: Thandle; {主线程句柄}
Context: TContext;
begin
{建立调试进程}
CodeCount := 0;
ConText.ContextFlags := CONTEXT_CONTROL;
Flage := DEBUG_PROCESS or DEBUG_ONLY_THIS_PROCESS;
GetStartupInfo(si); {初始化si结构,不然无法正常建立进程}
if not CreateProcess(nil, Pchar('C:\windows\NOTEPAD.EXE'), nil, nil,
False, Flage, nil, nil, si, pi) then
begin
MessageBox(Application.Handle, '建立被调试进程失败', '!!!', MB_OK or MB_ICONERROR);
exit;
end;
while WaitForDebugEvent(DebugD, INFINITE) do
begin {根据事件代码进行相应处理}
case DebugD.dwDebugEventCode of
EXIT_PROCESS_DEBUG_EVENT:
begin
MessageBox(Application.Handle, '被调试进程中止', '!!!', MB_OK or MB_ICONERROR);
Break;
end;
CREATE_PROCESS_DEBUG_EVENT:
begin
ThreadHandle := DebugD.CreateProcessInfo.hThread;
MessageBox(Application.Handle, '被调试进程建立', '!!!', MB_OK or MB_ICONERROR);
end;
EXCEPTION_DEBUG_EVENT:
begin
if (DebugD.Exception.ExceptionRecord.ExceptionCode <> EXCEPTION_SINGLE_STEP) and
(DebugD.Exception.ExceptionRecord.ExceptionCode <> EXCEPTION_BREAKPOINT) then
Rc := False {如果被调试程序产生了异常,让它自己处理}
else
begin
GetThreadContext(ThreadHandle, Context);
{将标志寄存器的陷井标志设为TRUE,这样CPU将会处于单步模式}
Context.EFlags := Context.EFlags or $100;//单步执行
Inc(CodeCount);
Form1.Label1.Caption := IntToStr(CodeCount);
SetThreadContext(ThreadHandle, Context);
Rc := True;
end;
end;
end;
if Rc then
ContinueDebugEvent(DebugD.dwProcessId, DebugD.dwThreadId,
DBG_CONTINUE)
else
ContinueDebugEvent(DebugD.dwProcessId, DebugD.dwThreadId,
DBG_EXCEPTION_NOT_HANDLED);
end;
CloseHandle(pi.hProcess);
Closehandle(pi.hThread);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ThreadHandle, ThreadID: THandle;
begin
ThreadHandle := CreateThread(nil, 0, @DebugPro, nil, 0, ThreadID);
end;
end.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{调试信息处理过程}
procedure DebugPro;
var
si: _STARTUPINFOA; (进程启动信息}
pi: _PROCESS_INFORMATION; {进程信息}
Flage: DWORD;
DebugD: DEBUG_EVENT; {调试事件}
Rc: Boolean;
CodeCount: DWORD; {运行的指令数}
ThreadHandle: Thandle; {主线程句柄}
Context: TContext;
begin
{建立调试进程}
CodeCount := 0;
ConText.ContextFlags := CONTEXT_CONTROL;
Flage := DEBUG_PROCESS or DEBUG_ONLY_THIS_PROCESS;
GetStartupInfo(si); {初始化si结构,不然无法正常建立进程}
if not CreateProcess(nil, Pchar('C:\windows\NOTEPAD.EXE'), nil, nil,
False, Flage, nil, nil, si, pi) then
begin
MessageBox(Application.Handle, '建立被调试进程失败', '!!!', MB_OK or MB_ICONERROR);
exit;
end;
while WaitForDebugEvent(DebugD, INFINITE) do
begin {根据事件代码进行相应处理}
case DebugD.dwDebugEventCode of
EXIT_PROCESS_DEBUG_EVENT:
begin
MessageBox(Application.Handle, '被调试进程中止', '!!!', MB_OK or MB_ICONERROR);
Break;
end;
CREATE_PROCESS_DEBUG_EVENT:
begin
ThreadHandle := DebugD.CreateProcessInfo.hThread;
MessageBox(Application.Handle, '被调试进程建立', '!!!', MB_OK or MB_ICONERROR);
end;
EXCEPTION_DEBUG_EVENT:
begin
if (DebugD.Exception.ExceptionRecord.ExceptionCode <> EXCEPTION_SINGLE_STEP) and
(DebugD.Exception.ExceptionRecord.ExceptionCode <> EXCEPTION_BREAKPOINT) then
Rc := False {如果被调试程序产生了异常,让它自己处理}
else
begin
GetThreadContext(ThreadHandle, Context);
{将标志寄存器的陷井标志设为TRUE,这样CPU将会处于单步模式}
Context.EFlags := Context.EFlags or $100;//单步执行
Inc(CodeCount);
Form1.Label1.Caption := IntToStr(CodeCount);
SetThreadContext(ThreadHandle, Context);
Rc := True;
end;
end;
end;
if Rc then
ContinueDebugEvent(DebugD.dwProcessId, DebugD.dwThreadId,
DBG_CONTINUE)
else
ContinueDebugEvent(DebugD.dwProcessId, DebugD.dwThreadId,
DBG_EXCEPTION_NOT_HANDLED);
end;
CloseHandle(pi.hProcess);
Closehandle(pi.hThread);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ThreadHandle, ThreadID: THandle;
begin
ThreadHandle := CreateThread(nil, 0, @DebugPro, nil, 0, ThreadID);
end;
end.
|
|
|---|---|
|
|
程序执行后在DEBUGBREAKPOINT单步执行，可我想在程序入口开始，请教论坛上的人帮我改改代码，先行谢过！
|
|
|
|
|
|
|
|
|
|
