// Способ первый
// Для этого необходимо использовать API функцию IsDebuggerPresent.
// Единственный недостаток этой функции, заключается в том,
// что она не работет под Windows 95...

function DebuggerPresent: Boolean;  
type
  TDebugProc = function: Boolean; stdcall;
var
  Kernel32: HMODULE;
  DebugProc: TDebugProc;
begin
   Result := False;
   Kernel32 := GetModuleHandle('kernel32.dll');
   if Kernel32 <> 0 then
   begin
      @DebugProc := GetProcAddress(Kernel32, 'IsDebuggerPresent');
      if Assigned(DebugProc) then
         Result := DebugProc;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if DebuggerPresent then
      ShowMessage('Приложение работает в режиме отладки')
   else
      ShowMessage('Приложение работает в обычном режиме');
end;

// Способ второй
// Аналог использования функции IsDebuggerPresent.
function IsDebug: Boolean;
asm
   {$IFDEF WIN32}
   mov eax, fs:[30h]
   movzx eax, byte ptr [eax+2]
   {$ELSE IFDEF WIN64}
   mov rax, qword ptr gs:[abs $60]
   movzx eax, byte ptr [rax+2]
   {$ENDIF}
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if IsDebug then
      ShowMessage('Debugger detected!');
end;

// Способ третий
procedure TForm1.Button1Click(Sender: TObject);
var
  DebuggerPresent: BOOL;
begin
   // Функция CheckRemoteDebuggerPresent позволяет проверять
   // на отладку не только текущий процесс, но и любой другой.
   CheckRemoteDebuggerPresent(GetCurrentProcess, DebuggerPresent);

   if DebuggerPresent then
      ShowMessage('Приложение работает в режиме отладки')
   else
      ShowMessage('Приложение работает в обычном режиме');
end;

// Способ четвертый
var
  ntdllLibrary: HMODULE = INVALID_HANDLE_VALUE;

type
  NTSTATUS = System.LongInt;

const
  STATUS_SUCCESS = NTSTATUS($00000000);

type
  PROCESS_BASIC_INFORMATION = record
    ExitStatus: NTSTATUS;
    PebBaseAddress: PVOID;
    AffinityMask: ULONG_PTR;
    BasePriority: Integer;
    UniqueProcessId: THandle;
    InheritedFromUniqueProcessId: THandle;
  end;

  TProcessBasicInformation = PROCESS_BASIC_INFORMATION;
  PPROCESS_BASIC_INFORMATION = ^TProcessBasicInformation;

type
  PPEB = ^TPEB;

  TPEB = packed record
    InheritedAddressSpace: System.Boolean;
    ReadImageFileExecOptions: System.Boolean;
    BeingDebugged: System.Boolean;
    //...
  end;

type
  TNtQueryInformationProcess = function(ProcessHandle: THandle;
    ProcessInformationClass: ULONG; ProcessInformation: PVOID;
    ProcessInformationLength: ULONG; ReturnLength: PULONG): NTSTATUS; stdcall;

  TNtReadVirtualMemory = function(ProcessHandle: THandle; BaseAddress: PVOID;
    Buffer: PVOID; BufferLength: SIZE_T; ReturnLength: PSIZE_T): NTSTATUS; stdcall;

var
  NtQueryInformationProcess: TNtQueryInformationProcess = nil;
  NtReadVirtualMemory: TNtReadVirtualMemory = nil;

function GetProcessBeingDebugged(ProcessHandle: THandle; var BeingDebugged: Boolean): NTSTATUS;
var
  ProcessBasicInformation: PROCESS_BASIC_INFORMATION;
  PEB: TPEB;
  ReturnLength: SIZE_T;
begin
   BeingDebugged := False;

   if @NtQueryInformationProcess = nil then
   begin
      Result := ERROR_NOT_SUPPORTED;
      Exit;
   end;

   Result := NtQueryInformationProcess(ProcessHandle, 0, @ProcessBasicInformation, SizeOf(ProcessBasicInformation), nil);

   if Result <> STATUS_SUCCESS then
      Exit;

   if @NtReadVirtualMemory = nil then
   begin
      Result := ERROR_NOT_SUPPORTED;
      Exit;
   end;

   Result := NtReadVirtualMemory(ProcessHandle, ProcessBasicInformation.PebBaseAddress, @PEB, SizeOf(TPEB), @ReturnLength);

   if Result <> STATUS_SUCCESS then
      Exit;

   BeingDebugged := PEB.BeingDebugged;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  BeingDebugged: Boolean;
begin
   ntdllLibrary := LoadLibrary('ntdll.dll');

   @NtQueryInformationProcess := GetProcAddress(ntdllLibrary, 'NtQueryInformationProcess');
   @NtReadVirtualMemory := GetProcAddress(ntdllLibrary, 'NtReadVirtualMemory');

   GetProcessBeingDebugged(GetCurrentProcess, BeingDebugged);

   if BeingDebugged then
      TerminateProcess(GetCurrentProcess, ERROR_SUCCESS);
end;

// Способ пятый
// Во время отладки система выставляет флаги FLG_HEAP_VALIDATE_PARAMETERS,
// FLG_HEAP_ENABLE_TAIL_CHECK, FLG_HEAP_ENABLE_FREE_CHECK, в поле NtGlobalFlag,
// которое находится в структуре PEB. Отладчик использует эти флаги для контроля
// разрушения кучи посредством переполнения.
function GetNtGlobalFlag: DWORD;
asm
   {$IFDEF WIN32}
   mov eax, fs:[30h]
   mov eax, dword ptr [eax+$68];
   {$ELSE IFDEF WIN64}
   mov rax, qword ptr gs:[abs $60]
   mov eax, dword ptr [eax+$bc];
   {$ENDIF}
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  FLG_HEAP_VALIDATE_PARAMETERS = $40;
  FLG_HEAP_ENABLE_TAIL_CHECK = $10;
  FLG_HEAP_ENABLE_FREE_CHECK = $20;

  FLG_DEBUG_PRESENT = FLG_HEAP_VALIDATE_PARAMETERS or
                      FLG_HEAP_ENABLE_TAIL_CHECK or
                      FLG_HEAP_ENABLE_FREE_CHECK;
var
  Flags: DWORD;
begin
   Flags := GetNtGlobalFlag;
   if Flags and FLG_DEBUG_PRESENT <> 0 then
      ShowMessage('Debugger detected!');
end;

// Способ шестой
// PEB содержит указатель на структуру _HEAP, в которой есть поля Flags и ForceFlags.
// Когда отладчик подсоединен к приложению, поля Flags и ForceFlags содержат признаки
// отладки. ForceFlags при отладке не должно быть равно нулю, поле Flags не должно быть
// равно 0x00000002:
function GetFlags: DWORD;
asm
   {$IFDEF WIN32}
   mov eax, fs:[30h]
   mov eax, dword ptr [eax+$18];
   mov eax, dword ptr [eax+$40];
   {$ELSE IFDEF WIN64}
   mov rax, qword ptr gs:[abs $60]
   mov eax, dword ptr [eax+$30];
   mov eax, dword ptr [eax+$70];
   {$ENDIF}
end;

function GetForceFlags: DWORD;
asm
   {$IFDEF WIN32}
   mov eax, fs:[30h]
   mov eax, dword ptr [eax+$18];
   mov eax, dword ptr [eax+$44];
   {$ELSE IFDEF WIN64}
   mov rax, qword ptr gs:[abs $60]
   mov eax, dword ptr [eax+$30];
   mov eax, dword ptr [eax+$74];
   {$ENDIF}
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if (GetFlags and HEAP_GROWABLE <> HEAP_GROWABLE) or (GetForceFlags <> 0) then
      ShowMessage('Debugger detected!');
end;

// Способ седьмой
// Функция SetHandleInformation применяется для установки свойств
// дескриптора объектов, на который указывает hObject. Типы объектов
// различны — например, это может быть задание, отображение файла или
// мьютекс. Создадим мьютекс с флагом HANDLE_FLAG_PROTECT_FROM_CLOSE
// и попробуем его закрыть, попутно перехватывая исключение. Если
// исключение будет поймано, то процесс отлаживается.
procedure TForm1.Button1Click(Sender: TObject);
var
  hMutex: THandle;
begin
   hMutex := CreateMutex(nil, False, PChar('MyMutex'));
   SetHandleInformation(hMutex, HANDLE_FLAG_PROTECT_FROM_CLOSE,
      HANDLE_FLAG_PROTECT_FROM_CLOSE);
   try
      CloseHandle(hMutex);
   except
      on E: EExternalException do
         ShowMessage('Debugger detected!');
   end;
end;

// Способ восьмой
// db 66h - машинный код т.н. префикса изменения разрядности операнда
// (с 32 до 16 разрядов в данном случае, если он встречается в 32-разрядном
// коде, то процессор интерпретирует операнды следующий за ним инструкции
// как 16-разнядные и, соответственно, наоборот.). В 32-разрядном режиме
// префикс 66h приводит к переходу по адресу (word ptr SS:[ESP]), со снятием
// одного слова из стека вместо двух, оставляя стек несбалансированным.
procedure TForm1.Button1Click(Sender: TObject);
begin
   {$IFNDEF DEBUG}
   try
      asm
         db 66h
         retn
      end
   except
   {$ENDIF}
      ShowMessage('Отладчик не обнаружен');
   {$IFNDEF DEBUG}
   end;
   {$ENDIF}
end;

// Способ девятый
// "Ice" breakpoint - так называемая "точка заморозки" является одной из неописанных 
// машинных команд Intel, код операции которой 0xF1. Она используется для обнаружения
// трассировки программ. Выполнение этой машинной команды генерирует исключение
// SINGLE_STEP. Поэтому, если программа уже трассируется, то отладчик будет думать,
// что это нормальное исключение, сгенерированное при выполнении машинной команды с
// установленным флагом трассировки. Установленный обработчик исключений не получит
// управления, и выполнение программы продолжится не так как ожидается.
//
// Обход этой уловки прост: можно выполнить программу через эту команду, и остановить
// выполнение в пошаговом режиме уже на ней. Исключение будет сгенерировано, но так
// как программа в это время не трассируется, отладчик поймет, что необходимо передать
// управление обработчику исключений.
procedure TForm1.Button1Click(Sender: TObject);
begin
   try
      asm
         db $F1
      end;
      ShowMessage('Отладчик есть');
   except
      ShowMessage('Отладчика нет');
   end;
end;

// Способ десятый
// Флаг трассировки (TF), расположенный в регистре флагов (EFLSGS),
// управляет выполнением программы. Если этот флаг будет установлен,
// то после исполнения каждой машинной команды генерируется прерывание
// SINGLE_STEP (int 01h). Флагом трассировки можно управлять, чтобы
// мешать трассировке программы. Если программа будет трассироваться
// под отладчиком, то это не окажет никакого эффекта на регистр флагов,
// и отладчик обработает исключение, полагая, что так и должно быть, и
// обработчик исключений не получит управления. Хитрость этой уловки
// против трассировщика просто требует исполнения команды pushf в
// реальном режиме.
procedure TForm1.Button1Click(Sender: TObject);
begin
   try
      asm // Установка флага трассировки
         pushf
         mov dword [esp], $100
         popf
      end;
      ShowMessage('Debugger detected!');
   except
      ShowMessage('Нормальное выполнение программы');
   end;
end;

// Способ одиннадцатый
// Начиная с Windows XP для отладочного процесса создается "объект отладки".
// Если объект отладки существует, процесс отлаживается.
const
  ProcessDebugObjectHandle = $1E;

function NtQueryInformationProcess(ProcessHandle: THandle;
  ProcessInformationClass: Byte; ProcessInformation: Pointer;
  ProcessInformationLength: ULONG; ReturnLength: PULONG): DWORD;
  stdcall; external 'ntdll.dll';

procedure TForm1.Button1Click(Sender: TObject);
var
  DebugObjectHandle: THandle;
begin
  {$IFDEF WIN32}
  if NtQueryInformationProcess(GetCurrentProcess, ProcessDebugObjectHandle,
    @DebugObjectHandle, SizeOf(DebugObjectHandle), nil) = NO_ERROR then
    if DebugObjectHandle > 0 then
      ShowMessage('Процесс отлаживается');
  {$ENDIF}
end;

// Способ двенадцатый
// При проверке флага DebugFlags возвращается обратное значение бита
// NoDebugInherit структуры ядра EPROCESS. Если возвращаемое значение
// функции NtQueryInformationProcess равно 0, процесс отлаживается.
const
  ProcessDebugFlags = $1F;

function NtQueryInformationProcess(ProcessHandle: THandle;
  ProcessInformationClass: Byte; ProcessInformation: Pointer;
  ProcessInformationLength: ULONG; ReturnLength: PULONG): DWORD;
  stdcall; external 'ntdll.dll';

procedure TForm1.Button1Click(Sender: TObject);
var
  DebugFlags: Cardinal;
begin
  {$IFDEF WIN32}
  if NtQueryInformationProcess(GetCurrentProcess, ProcessDebugFlags,
    @DebugFlags, SizeOf(DebugFlags), nil) = NO_ERROR then
    if DebugFlags = 0 then
      ShowMessage('Процесс отлаживается');
  {$ENDIF}
end;

// Способ тринадцатый
// При вызове функции NtQueryInformationProcess с флагом ProcessBasicInformation
// возвращается структура PROCESS_BASIC_INFORMATION. Самое интересное в этой
// структуре - это поле InheritedFromUniqueProcessId. Здесь нам нужно получить имя
// родительского процесса и сравнить его с именами популярных отладчиков.
uses
  Winapi.TlHelp32;

type
  PROCESS_BASIC_INFORMATION = packed record
    ExitStatus: DWORD;
    PebBaseAddress: Pointer;
    AffinityMask: DWORD;
    BasePriority: DWORD;
    uUniqueProcessId: Ulong;
    uInheritedFromUniqueProcessId: Ulong;
  end;

const
  ProcessBasicInformation = 0;

function NtQueryInformationProcess(ProcessHandle: THandle;
  ProcessInformationClass: Byte; ProcessInformation: Pointer;
  ProcessInformationLength: ULONG; ReturnLength: PULONG): DWORD;
  stdcall; external 'ntdll.dll';

procedure TForm1.Button1Click(Sender: TObject);

  {$IFDEF WIN32}
  function GetProcessNameById(Pid: DWORD): string;
  var
    hSnapshot: NativeUInt;
    pe32: TProcessEntry32;
  begin
    Result := '';

    hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    if hSnapshot = -1 then
      Exit;

    pe32.dwSize := SizeOf(TProcessEntry32);
    if Process32First(hSnapshot, pe32) then
    repeat
      if pe32.th32ProcessID = Pid then
      begin
        Result := pe32.szExeFile;
        Break;
      end;
    until not Process32Next(hSnapshot, pe32);
    CloseHandle(hSnapshot);
  end;
  {$ENDIF}

var
  ProcessName: string;
  Info: PROCESS_BASIC_INFORMATION;
begin
  {$IFDEF WIN32}
  if NtQueryInformationProcess(GetCurrentProcess, ProcessBasicInformation,
    @Info, SizeOf(Info), nil) = NO_ERROR then
  begin
    ProcessName := GetProcessNameById(Info.uInheritedFromUniqueProcessId);
    if (LowerCase(ProcessName) = 'devenv.exe') or
       (LowerCase(ProcessName) = 'bds.exe') or
       (LowerCase(ProcessName) = 'ollydbg.exe') or
       (LowerCase(ProcessName) = 'snd.exe') then
      ShowMessage('Процесс отлаживается');
  end;
  {$ENDIF}
end;

// Способ первый
// Можно проверить отладочные регистры, получить доступ к которым можно
// через контекст потока при помощи функции GetThreadContext. Всего
// отладочных регистров восемь, DR0–DR7. Нас интересуют первые четыре -
// DR0–DR3, они содержат информацию о точках останова.
procedure TForm1.Button1Click(Sender: TObject);
var
  Context: TContext;
begin
   Context.ContextFlags := CONTEXT_DEBUG_REGISTERS;
   GetThreadContext(GetCurrentThread, Context);
   if (Context.Dr0 <> 0) or (Context.Dr1 <> 0) or (Context.Dr2 <> 0) or (Context.Dr3 <> 0) then
      ShowMessage('Debugger detected!');
end;

// Способ второй
// Обнаружение через GetThreadContext с последующей проверкой регистра DR7
// (если он не пуст - значит стоит Hardware BreakPoint).
function CheckHardwareBreakPoint: Boolean;
var
  Context: TContext;
begin
   Context.ContextFlags := CONTEXT_DEBUG_REGISTERS;
   GetThreadContext( GetCurrentThread, Context );
   Result := Context.Dr7 <> 0;
   // При обнаружении Hardware BreakPoint можно завершить приложение вызовом
   // TerminateProcess(GetCurrentProcess, 0);
end;

// Способ третий
type
  // Структура для восстановления
  TSeh = packed record
    Esp, Ebp, SafeEip: DWORD;
  end;

var
  Seh: TSeh;
  HBPDetected: Boolean;

// Обработчик отладочного исключения функции
// CheckHardwareBreakPointWithException
function _except_handler(ExceptionRecord: PExceptionRecord;
  EstablisherFrame: Pointer; Context: PContext;
  DispatcherContext: Pointer): DWORD; cdecl;
const
  ExceptionContinueExecution = 0;
begin
   HBPDetected := Context^.Dr7 <> 0;

   // Возвращаем регистры на место
   Context^.Eip := Seh.SafeEip;
   Context^.Esp := Seh.Esp;
   Context^.Ebp := Seh.Ebp;
   // И говорим продолжить выполнение
   Result := ExceptionContinueExecution;
end;

// Обнаружение через отладочное исключение с последующей проверкой
// регистра DR7 (если он не пуст - значит стоит Hardware BreakPoint).
function CheckHardwareBreakPointWithException: Boolean;
asm
   // Устанавливаем SEH фрейм
   push offset _except_handler
   xor  eax, eax
   push fs:[eax]
   mov  fs:[eax], esp
   // Заполняем данные для восстановления
   lea eax, seh
   mov [eax], esp
   add eax, 4
   mov [eax], ebp
   add eax, 4
   lea ecx, @done
   mov [eax], ecx
    // Генерируем исключение
   mov eax, [0]
   @done:
   // Удаляем SEH фрейм
   xor eax, eax
   pop fs:[eax]
   add esp, 4
   // Возвращаем результат
   mov eax, dword ptr HBPDetected
end;

function ChechLicense: Boolean;
begin
   Randomize;
   Result := Boolean(Random(2));
end;

procedure ChechLicenseEnd;
begin
end;

// Команда int 3h с кодом операции 0xCC - используется
// для вызова дескриптора отладки, именно эту конанду
// нам нужно найти.
procedure TForm1.Button1Click(Sender: TObject);
var
  p: PByte;
begin
   p := @ChechLicense;
   while NativeUInt(p) <= NativeUInt(@ChechLicenseEnd) do
   begin
      if Byte(p^) = $CC then
      begin
         ShowMessage('');
         Break;
      end;
      Inc(p);
   end;
end;

// Если мы точно знаем что у метода только одна точка
// выхода, проводить поиск можно до тех пор, пока не
// встретится команда ret
procedure TForm1.Button2Click(Sender: TObject);
var
  p: PByte;
begin
   p := @ChechLicense;
   while Byte(p^) <> $C3 do
   begin
      if Byte(p^) = $CC then
      begin
         ShowMessage('');
         Break;
      end;
      Inc(p);
   end;
end;

// Способ первый
// Стэк (в конкретной точке кода) с точки зрения программиста -
// это два регистра, EBP -  Base Pointer и ESP - Stack Pointer.
// Изменив эти два значения на любые произвольные стэк будет
// разрушен.
procedure KillSkack;
asm
   mov ebp, 0
   mov esp, 0
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   KillSkack;
end;

// Способ второй
// Стек всегда растет вниз, в то время как сверху остаются некие
// данные, в том числе и адреса возврата и SEH фреймы. Все эти
// данные доступны для чтения и модификации. Удалив их стэк будет
// разрушен.
{$IFDEF WIN32}
procedure KillSkackOnClean(var Dest; Count: Integer; Value: Byte);
asm
   push edi

   mov edi,eax   { Point EDI to destination }

   mov ch, cl    { Fill EAX with value repeated 4 times }
   mov eax, ecx
   shl eax, 16
   mov ax, cx

   mov ecx, edx
   sar ecx, 2
   js @@exit

   rep stosd     { Fill count DIV 4 dwords }

   mov ecx, edx
   and ecx, 3
   rep stosb     { Fill count MOD 4 bytes }

 @@exit:
   pop edi
end;
{$ENDIF}

procedure TForm1.Button1Click(Sender: TObject);
var
  p: Pointer;
begin
   {$IFDEF WIN32}
   KillSkackOnClean(p, MaxInt, 0);
   {$ENDIF}
end;

// Способ третий
// Срыв стека на рекурсивном вызове SEH фрейма. Логика данных фреймов
// проста, после установки они обрабатывают все исключения до тех пор,
// пока не будут сняты. В Delphi они представлены в частично обрезанном
// виде в качестве оберток try..finally/except. Идея заключается в том,
// что после установки SEH фрейма мы не производим его удаления и в нем
// же генерируем ошибку, заставляя рекурсивно вызывать самого себя. В
// результате имеем переполнение стека, плавно перерастающее в PAGE_FAULT.
{$IFDEF WIN32}
procedure KillSkackOnSEH;
asm
   lea eax, @KillStack
   push eax
   push dword ptr [fs:0]
   mov [fs:0], esp
   xor eax, eax
   mov eax, [eax]
  @KillStack:
   mov eax, 0
   call eax
end;
{$ENDIF}

procedure TForm1.Button1Click(Sender: TObject);
begin
   {$IFDEF WIN32}
   KillSkackOnSEH;
   {$ENDIF}
end;

// Способ четвертый
// Границы стека всегда обрамлены страницами с флагом PAGE_GUARD. Это
// можно наглядно увидеть в данном примере. Механизм работы данного
// флага следующий, при обращении к участку памяти с данным флагом
// срабатывает исключение Access Violation и данный флаг снимается.
// После чего при повторном обращении к этому участку срабатывает
// PAGE_FAULT. В данном коде используется локальный статический массив
// для ускорения переполнения стека.
{$IFDEF WIN32}
procedure KillSkackOnGuard;

  procedure T;
  var
    HugeBuff: array[0..10000] of DWORD;
  begin
     if HugeBuff[0] <> HugeBuff[10000] then
        Inc( HugeBuff[0] );
     T;
  end;

begin
   try
      T;
   except
      T;
   end;
end;
{$ENDIF}

procedure TForm1.Button1Click(Sender: TObject);
begin
   {$IFDEF WIN32}
   KillSkackOnGuard;
   {$ENDIF}
end;

type
  TDbgUiRemoteBreakinPath = packed record
    push0: Word;
    push: Byte;
    CurrProc: DWORD;
    moveax: Byte;
    TerminateProcAddr: DWORD;
    calleax: Word;
  end;

/// При вызове в отладчике функции DebugActiveProcess, в отлаживаемом приложении
/// всегда вызывается функция DbgUiRemoteBreakin. Зная это мы пропатчим сами
/// себя, точнее тело функции DbgUiRemoteBreakin, добавив в ее начало переход на
/// адрес функции TerminateProcess, таким образом, как только произойдет
/// подключение отладчика к процессу, процесс сразу же завершится.
procedure BlockDebugActiveProcess;
var
  pDbgUiRemoteBreakin: Pointer;
  Path: TDbgUiRemoteBreakinPath;
  OldProtect: DWORD;
begin
   pDbgUiRemoteBreakin := GetProcAddress(GetModuleHandle('ntdll.dll'), 'DbgUiRemoteBreakin');
   if pDbgUiRemoteBreakin = nil then
      Exit;
   Path.push0 := $006A;
   Path.push := $68;
   Path.CurrProc := $FFFFFFFF;
   Path.moveax := $B8;
   Path.TerminateProcAddr := DWORD(GetProcAddress(GetModuleHandle(kernel32), 'TerminateProcess'));
   Path.calleax := $D0FF;
   if VirtualProtect(pDbgUiRemoteBreakin, SizeOf(TDbgUiRemoteBreakinPath), PAGE_READWRITE, OldProtect) then
   try
      Move(Path, pDbgUiRemoteBreakin^, SizeOf(TDbgUiRemoteBreakinPath));
   finally
      VirtualProtect(pDbgUiRemoteBreakin, SizeOf(TDbgUiRemoteBreakinPath), OldProtect, OldProtect);
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   BlockDebugActiveProcess;
end;

// Способ первый
// Данный прием основан на том, что дизассемблер не всегда может правильно
// интерпретировать машинный код, особенно если он написан специально с целью
// запутывания дизасма. Как пример, достаточно малому количеству разработчиков
// известно такое понятие как "длинный NOP". Соответственно большинство
// дизассемблеров умеют работать только с опкодом 0x90.
// К СОЖАЛЕНИЮ ЭТО НЕ ДЕЙСТВУЕТ С СОВРЕМЕННЫМИ ДИЗАССЕМБЛЕРАМИ, НАПРИМЕР
// OLLYDBG 2.01 ПРАВИЛЬНО РАСПОЗНАЕТ ДЛИННЫЙ NOP.
procedure TForm1.Button1Click(Sender: TObject);
asm
  db $0F, $1F, $00
  xor eax, eax
  inc eax
  neg eax
end;

// Способ второй
// Здесь идея кроется в том, что перед началом очередной инструкции пишется
// абсолютно левый байт, перед которым пишется код инструкции "jmp +1" заставляя
// программу пропускать этот мусорный байт и перейти непосредственно на нужный
// код. Казалось бы банальная вещь - но достаточно сильно сбивает дизассемблер
// с толку.
procedure TForm1.Button1Click(Sender: TObject);
asm
   db $EB, $01   // jmp +1 (прыжок на xor пропуская "левый байт")
   db $B8        // непосредственно сам "левый" байт
   xor eax, eax  // правильный код
   inc eax
   neg eax
   not eax
   sub edx, eax
   imul eax, edx
   nop
   nop
end;

type
  NTSTATUS = System.LongInt;

function NtSetInformationThread(ThreadHandle: THandle;
  ThreadInformationClass: Cardinal; ThreadInformation: Pointer;
  ThreadInformationLength: Cardinal): NTSTATUS; stdcall; external 'ntdll.dll';

// Метод антиотладки основан на передаче флага HideFromDebugger
// (находится в структуре за номером 0x11) в функцию NtSetInformationThread.
// Поток, для которого установлен этот флаг, прекращает отправку уведомлений
// о событиях отладки, например таких, как срабатывание точек останова.
//
// Для обхода зтой защиты нужно перехватить (hook) вызов функции
// NtSetInformationThread. В перехваченной функции, при правильном ее вызове,
// должен быть возвращен STATUS_SUCCESS без передачи управления исходной функции
// NtSetInformationThread.
procedure TForm1.Button1Click(Sender: TObject);
const
  HideFromDebugger = $11;
begin
   NtSetInformationThread(GetCurrentThread, HideFromDebugger, nil, 0);
end;

// Оригинальный антитрассировщик, о котором мало кто знает, и еще меньше
// народу его использует. Трюк состоит из трассировки следующего кода:
//   push ss
//   pop ss
//   pushf
//   nop
// После выполнения pop ss в режиме трассировки, следующая машинная команда
// будет выполнена, но отладчик не остановится на ней, а остановится только
// на следующей машинной команде (в приведенном примере это nop).
//
// Фишка функции SS в том, что если этот код трассируется в отладчике,
// команда pushf будет выполнена, но отладчик на ней не остановится, и
// будет не в состоянии сбросить флаг трассировки в значении, помещенном
// в стек.
//
// Простой способ обойти это состоит в том, чтобы установить бряк на pushf
// и выполнить программу (чтобы избежать установки флага трассировки).
function SS: Boolean;
asm
   push ss

   pop ss
   pushf

   xor eax, eax
   pop ax
   and eax, $100
   or eax, eax
   jnz @debugged

   // метод не трассируется
   mov eax, 0
   jz @exit

  @debugged:
   // метод трассируется
   mov eax, 1

  @exit:
end;

// Если протрассировать метод SS, после его завершения будет выведено
// сообщение, без трассировки никакого сообщения не будет.
procedure TForm1.Button1Click(Sender: TObject);
begin
   if SS then
      ShowMessage('Обнаружена трассировка метода SS');
end;