unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  sti: tstartupinfo;
  lpPi: tprocessinformation;
  DE: _Debug_event;
  Cont: _Context;
implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
const
  b: array[0..1] of byte = (0, $CC);
var
  f: file of longint;
  x: longint;
  i: cardinal;
begin

  assignfile(f, 'C:\w\notepad.exe');
  reset(f);
  seek(f, $2A); //читаем OEP из PE
  read(f, x);
  closefile(f);
  x := x + $400000; //типа imagebase

  //добавим еще Create_suspended чтобы процесс без нас никуда не убежал :)
  CreateProcess(nil, 'C:\w\notepad.exe', nil, nil, false, DEBUG_PROCESS
    or DEBUG_ONLY_THIS_PROCESS or Create_suspended, nil, nil, StI, lpPI);

  readprocessmemory(lppi.hProcess, pointer(x), @b[0], 1, i); //запоминаем байт
  writeprocessmemory(lppi.hProcess, pointer(x), @b[1], 1, i); //пишем $cc
  resumethread(lppi.hThread);

  {цикл ожидания EP}
  while true do
  begin
    if not WaitForDebugEvent(de, 0) then
      application.ProcessMessages;
    if de.dwDebugEventCode = EXCEPTION_DEBUG_EVENT then
      if DE.Exception.ExceptionRecord.ExceptionCode = EXCEPTION_BREAKPOINT then
      begin
        cont.ContextFlags := CONTEXT_CONTROL;
        GetThreadContext(lppi.hThread, cont);
        {Эти брейкпоинты не тока мы генерим, но и маздай так что
        приходится проверку делать: EIP=Entry Point или нет}

        if cont.eip - 1 = x then
          // тошо EXCEPTION_BREAKPOINT генерится после int 3.
        begin
          cont.eip := cont.eip - 1;
          cont.EFlags := cont.EFlags or $100; //флаг T
          setThreadContext(lppi.hThread, cont);
          //ставим байт на место
          writeprocessmemory(lppi.hProcess, pointer(x), @b[0], 1, i);
          break;
        end;
        ContinueDebugEvent(lppi.dwProcessId, lppi.dwThreadid, DBG_CONTINUE);
      end;
    ContinueDebugEvent(lppi.dwProcessId, lppi.dwThreadid, DBG_CONTINUE);
  end;

  {tracing... 0% complete}
  while true do
  begin

    if not WaitForDebugEvent(de, 0) then
      application.ProcessMessages;

    if de.dwDebugEventCode = EXCEPTION_DEBUG_EVENT then
      if DE.Exception.ExceptionRecord.ExceptionCode = EXCEPTION_BREAKPOINT then
      begin
        GetThreadContext(lppi.hThread, cont);
        cont.EFlags := cont.EFlags or $100;
        setThreadContext(lppi.hThread, cont);
        {Здесь мог бы быть ваш код :))) }
        ContinueDebugEvent(lppi.dwProcessId, lppi.dwThreadid, DBG_CONTINUE);
      end
      else if DE.Exception.ExceptionRecord.ExceptionCode = EXCEPTION_SINGLE_STEP
        then
      begin
        cont.ContextFlags := CONTEXT_CONTROL;
        GetThreadContext(lppi.hThread, cont);
        cont.EFlags := cont.EFlags or $100;
        setThreadContext(lppi.hThread, cont);
        {Здесь мог бы быть ваш код :))) }
        ContinueDebugEvent(lppi.dwProcessId, lppi.dwThreadid, DBG_CONTINUE);
      end;
  end;
end;

end.