Использование Debug API

Code:

procedure DoDebugLoop;

{ собственно, это главная процедура перехватчика.

большую часть времени он крутится именно в ней }

var

Event: TDebugEvent;

{ стандартная Win32 структура. для интересующихся:}

ЕDebugEvent = record

   dwDebugEventCode: DWORD; // тип пришедшего события

   dwProcessId: DWORD;   // Id прерванного процесса

   dwThreadId: DWORD; // Id прерванного потока

   case Integer of

     0: (Exception: TExceptionDebugInfo);

     1: (CreateThread: TCreateThreadDebugInfo);

     2: (CreateProcessInfo: TCreateProcessDebugInfo);

     3: (ExitThread: TExitThreadDebugInfo);

     4: (ExitProcess: TExitThreadDebugInfo);

     5: (LoadDll: TLoadDLLDebugInfo);

     6: (UnloadDll: TUnloadDLLDebugInfo);

     7: (DebugString: TOutputDebugStringInfo);

     8: (RipInfo: TRIPInfo);

     // эти части смотрите сами - не могу же я все разжевывать! :-)

end;

Code:

begin

FillChar(ThreadList, SizeOf(ThreadList), 0);

HProc := 0;

{ хэндл процесса, который будем отлаживать.

пока процесс не запущенным считается,

соответственно - хэндла нету }

ProcessFinished := True;

{ поскольку процесс не запустился,

то он считается завершенным :-) }

BPAddr := 0;

{ точку останова уточним,

когда загрузится нужная DLL }

RestoreBreak := False;

repeat

   if not WaitForDebugEvent(Event, INFINITE) then

     break;

   { ожидаем прихода отладочного события. в реальном отладчике здеесь

   вместо INFINITE лучше задать маленькую константу, ожидать в цикле,

   там же в цикле организовывать взаимодействие с юзверем. или вообще

   для интерфейса отдельный поток создать }

   dwContinueStatus := DBG_EXCEPTION_NOT_HANDLED;

   { поскольку большинство исключений мы не обрабатываем,

   то по умолчанию так и говорим системе }

   CurThread := GetThreadHandleFromList(ThreadList, Event.dwThreadId);

   { просто поиск в массиве ThreadList. Id нам известен, ищем хэндл }

   case Event.dwDebugEventCode of

     { проверим - а что, собственно случилось? }

     CREATE_PROCESS_DEBUG_EVENT:

     { запустился новый процесс. запомним его хэндл, и сбросим флажок ProcessFinished }

     begin

       HProc := Event.CreateProcessInfo.HProcess;

       ProcessFinished := False;

       AddThreadToList(ThreadList, Event.dwThreadId, Event.CreateProcessInfo.hThread);

     end;

     EXIT_PROCESS_DEBUG_EVENT:

     { процесс завершился - значит, можно смело закрывать наш перехватчик.

     заодно установим флажок ProcessFinished }

     begin

       ProcessFinished := True;

       ContinueDebugEvent(Event.dwProcessId, Event.dwThreadId, DBG_CONTINUE);

       { это на всякий случай - чтобы ось точно прибила и процесс, и отладчик.

       в принципе, оно не надо, но смотри выше комментарий к ProcessFinished }

       break; { все, из цикла отладки можно смело выходить }

     end;

     CREATE_THREAD_DEBUG_EVENT:

       { процесс запустил новый поток. здесь у нас есть единственная возможность

       запомнить его хэндл. так и делаем }

       AddThreadToList(ThreadList, Event.dwThreadId, Event.CreateThread.hThread);

     EXIT_THREAD_DEBUG_EVENT:

       { процесс завершил исполнение потока. забудем его хэндл }

       DeleteThreadFromList(ThreadList, Event.dwThreadId);

     LOAD_DLL_DEBUG_EVENT:

       { процесс загрузил какую-то DLL'ку. проверим, не та ли

       это, которая нам нужна. если та, установим точку останова.

       текст процедуры смотрите ниже }

       ProcessDLLExport(HProc, DWORD(Event.LoadDll.lpBaseOfDll));

     UNLOAD_DLL_DEBUG_EVENT:

       { процесс выгрузил какую-то DLL'ку. по-правилам,

       это надо бы обработать, но поскольку я перехватываю вызовы kernel32.dll,

       который всегда (за очень-очень редким исключением :-) линкуется статически,

       то это событие я просто игнорирую. а вообще-то надо запомнить

       адрес загрузки нужной нам DLL в LOAD_DLL_DEBUG_EVENT

       (ибо это единственный способ идентифицировать DLL'ку),

       а здесь проверять - не наша ли это. если наша - обнулить BPAddr.

       можете дописать сами - как любят говорить авторы книг:

       "в качестве упражнения" :-) [Енота: ага. а сам, когда видит

       в книге эту фразу, разражается потоком нецензурной лексики :-)] }

       WriteLn('unloading DLL: ', IntToHex(DWORD(Event.UnloadDll.lpBaseOfDll), 8));

     EXCEPTION_DEBUG_EVENT:

       { какое-то исключение. проверим поточнее... }

       case Event.Exception.ExceptionRecord.ExceptionCode of

       EXCEPTION_BREAKPOINT:

       { это - точка останова. здесь мы уточним: наша или нет. дело в том,

       что система сама генерирует это событие, когда процесс загрузился,

       но перед тем, как он запущен (полсе того, как системный загрузчик

       загрузил процесс и все его DLL'ки. как раз перед тем, как исполнить

       первую инструкцию процесса). плюс - мало ли, какой код внутри

       исследуемого процесса может быть? так что... }

       begin

         dwContinueStatus := DBG_CONTINUE;

         { скажем системе, что это исключение мы обработали сами, пусть не напрягается }

         Context.ContextFlags := CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS;

         GetThreadContext(CurThread, Context);

         { получили контекст прерванного потока. больше всего нас интересуют IP и Flags.

         остальные регистры запросили просто для полноты картины }

         if (BPAddr <> 0) and (Context.EIP = BPAddr + 1) then

         begin

           { если мы уже установили нашу точку останова и прервались именно на ней... }

           RetAddr := ReadProcessLong(HProc, Context.ESP);

           { то получим адрес возврата из перехваченной нами функции.

           он нам не нужен, на самом-то деле, это просто пример - откуда его брать.

           если вам нужны параметры - ReadProcessLong(HProc, Context.ESP + 4)

           будет первым, ...+ 8) - вторым, и так далее... кстати, ReadProcessLong -

           просто обертка для системной функции ReadProcessMemory. читает 4 байтика.

           для удобства. думаю, что у вас не будет проблем сделать себе такую же :-) }

           WriteLn('Return address: 0x', IntToHex(RetAddr, 8));

           { дальше - уменьшим IP на еденичку (чтобы исполнить ту инструкцию,

           которую мы заменили на нашу точку останова)... реально, EIP-1

           хранится в BPAddr. так и запишем... }

           Context.EIP := BPAddr;

           { ...и восстановим оригинальный первый байтик этой инструкции }

           WriteProcessByte(HProc, BPAddr, OrigByte);

           { установим флажок для того, чтобы система генерировала

           событие EXCEPTION_SINGLE_STEP. в этом событии надо будет вернуть

           точку останова на место, иначе перехват состоится ровно один раз :-)

           [Енота: а то бы читатель сам не догадался...] }

           RestoreBreak := True;

           Context.EFlags := Context.EFlags or EFLAGS_TRACE;

           { вышеприведенной инструкцией мы сообщаем системе,

           что хотим получать по событию (EXCEPTION_SINGLE_STEP) после каждой

           исполненной в отлаживаемом процессе машинной команды. кстати,

           значение константы EFLAGS_TRACE = $100 }

           Context.ContextFlags := CONTEXT_CONTROL;

           SetThreadContext(CurThread, Context);

           { установим новое значение регистров потока }

         end;

       end;

       EXCEPTION_SINGLE_STEP:

       { выполнена одна машинная команда. скорее всего,

       возниконовение этого события - результат выполнения нашей точки останова,

       но кто знает? проверим флажки. если надо - восстановим точку останова }

       begin

         dwContinueStatus := DBG_CONTINUE;

         { скажем системе, что это исключение мы обработали сами, пусть не напрягается }

         Context.ContextFlags := CONTEXT_CONTROL;

         GetThreadContext(CurThread, Context);

         if RestoreBreak and (Context.EIP >= BPAddr) and (Context.EIP <= BPAddr + 32) then

         begin

           { это действительно "наше" событие. восстановим точку останова,

           чтобы перехватчик работал и дальше }

           OrigByte := WriteInt3(HProc, BPAddr);

           RestoreBreak := False;

           Context.EFlags := Context.EFlags and not EFLAGS_TRACE;

           { сбросим флажок трассировки, ибо больше это событие нам не надо }

         end

         else

           if RestoreBreak then

             Context.EFlags := Context.EFlags or EFLAGS_TRACE;

         { вернем флажок трассировки, если событие не наше -

         нам ведь надо нашего дождаться. у меня система сама скидывает сей флаг,

         так что на всякий случай... }

         Context.ContextFlags := CONTEXT_CONTROL;

         SetThreadContext(CurThread, Context);

       end;

     end;

   end;

   if not ContinueDebugEvent(Event.dwProcessId, Event.dwThreadId, dwContinueStatus) then

     break;

   { все. смело позволяем отлаживаемому процессу исполняться дальше }

until

   False;

{ сюда мы попадем только при каком-нибудь сбое или завершении процесса.

на всякий случай (по совету SleepyHead'а) проверим: а точно наш

отлаживаемый процесс завершился? если нет - прибьем руками }

if not ProcessFinished then

begin

   repeat

     TerminateProcess(HProc, RetAddr);

     if not WaitForDebugEvent(Event, INFINITE) then

       break;

     if (Event.dwDebugEventCode = EXIT_PROCESS_DEBUG_EVENT) then

       break;

     if not ContinueDebugEvent(Event.dwProcessId, Event.dwThreadId, DBG_CONTINUE) then

       break;

   until

     False;

   ContinueDebugEvent(Event.dwProcessId, Event.dwThreadId, DBG_CONTINUE);

end;

{ все. закончили :-) }

end;

{ а вот процедурка, которая устанавливает точку останова }

procedure ProcessDLLExport(PrcH, Base: DWORD);

var

DLLName: string;

ExpTbl: TExportHeader;

N: DWORD;

begin

if (BPAddr <> 0) then

   exit;

{ если уже установлена - не делать ничего }

if not FindExportTable(PrcH, Base, ExpTbl) then

   exit;

{ если не смогли найти в DLL'ке таблицу экспорта (мало ли...) -

тоже ничего не делать }

DLLName := ANSILowerCase(GetASCIIZString(PrcH, ExpTbl.NameRVA + Base));

{ получили имя DLL'ки }

if (DLLName <> 'kernel32.dll') then

   exit;

{ не наша? если да - снова не делаем ничего }

N := FindExportIndexByName(PrcH, Base, 'AllocConsole', ExpTbl);

N := FindExportByIndex(PrcH, Base, N, ExpTbl);

{ нашли по таблице экспорта точку входа (если не нашли -

опять же ничего делать не надо }

if (N = 0) then

   exit;

{ а если нашли - запомним необходимую информацию и установим останов }

BPAddr := N;

OrigByte := WriteInt3(PrcH, N);

{ WriteInt3 просто возвращает в качестве результата старый байтик,

и на его место записывает код $CC - инструкция Int3. когда система

встречает эту инструкцию, она генерирует исключение EXCEPTION_BREAKPOINT }

end;