Sistema Anti-Bot

Bliblioteca de funções para capturar mouse e teclado globalmente (nomes sugeridos : Hookme, CapitainHook, TheHook, etc...)

uses
  Windows, Messages, SysUtils;

{Define um record para gravar e passar a informação para o sistema globalmente}
type
  PHookRec = ^ THookRec;
  THookRec = Packed Record
    TheHookHandle: HHOOK;
    TheAppWinHandle: HWnd;
    TheCtrlWinHandle: HWnd;
    TheKeyCount: DWord;
  end;

var
  hObjHandle : THandle; {Variavel para mapear o objeto}
  lpHookRec  : PHookRec;
{Pointer para nosso registro}
procedure MapFileMemory (dwAllocSize: DWord);
begin { MapeaArqMemoria }
  {Cria uma variavel para mapear o processo globalmente}
  hObjHandle := CreateFileMapping ($FFFFFFFF, Nil, PAGE_READWRITE, 0,
    dwAllocSize, ´HookRecMemBlock´);
  if (hObjHandle = 0) then
    begin
      MessageBox (0, ´Hook DLL´, ´Não foi possivel criar objeto para mapear o arquivo´, mb_Ok);
      exit
    end { (hObjHandle = 0) };
  {Pointer para a nossa variavel global}
  lpHookRec := MapViewOfFile (hObjHandle, FILE_MAP_WRITE, 0, 0, dwAllocSize);
  if (lpHookRec = Nil) then
    begin
      CloseHandle (hObjHandle);
      MessageBox (0, ´Hook DLL´, ´Não é possível mapear o objeto´, mb_Ok);
      exit
    end { (lpHookRec = Nil) }
end; { MapeArqMemoria }


procedure UnMapFileMemory;
begin { DesMapArqMemoria }
  {Delete o processo}
  if (lpHookRec <> Nil) then
    begin
      UnMapViewOfFile (lpHookRec);
      lpHookRec := Nil
    end { (lpHookRec <> Nil) };
  if (hObjHandle > 0) then
    begin
      CloseHandle (hObjHandle);
      hObjHandle := 0
    end { (hObjHandle > 0) }
end; { DesMapArqMemoria }


function GetHookRecPointer : pointer
  stdcall;
begin { PegaHookRegPointer }
  {Return a pointer to our process wide memory mapped variable}
  Result := lpHookRec
end; { PegaHookRegPointer }


{A função que realmente processa a captura do teclado}
function KeyBoardProc (code: Integer; wParam: Integer; lParam: Integer) :
  Integer;
  stdcall;
var
  KeyUp : bool;
{Remova os commentários para melhorar a funcionalidade
  IsAltPressed : bool;
  IsCtrlPressed : bool;
  IsShiftPressed : bool;
 } 
begin { KeyBoardProc } 
  Result := 0; 
  
  Case code Of 
  HC_ACTION: 
    begin 
      {Capturamos as mensagens aqui} 
      {Seria uma mensagem "key up"?} 
      KeyUp := ((lParam and (1 shl 31)) <> 0); 
      
      (*Remova os commentários para melhorar a funcionalidade
     {Alt foi apertada?}
      if ((lParam and (1 shl 29)) <> 0) then begin
        IsAltPressed := TRUE;
      end else begin
        IsAltPressed := FALSE;
      end;

     {Ctrl foi apertada?}
      if ((GetKeyState(VK_CONTROL) and (1 shl 15)) <> 0) then begin
        IsCtrlPressed := TRUE;
      end else begin
        IsCtrlPressed := FALSE;
      end;

     {Shift foi apertada?}
      if ((GetKeyState(VK_SHIFT) and (1 shl 15)) <> 0) then begin
        IsShiftPressed := TRUE;
      end else begin
        IsShiftPressed := FALSE;
      end;
     *) 
      {Se sim incrementa o contador} 
      if (KeyUp <> false) then 
        begin 
          inc (lpHookRec^.TheKeyCount)
        end { (KeyUp <> false) }; 
      
      Case wParam Of 
      {Enter pressionada?} 
      VK_RETURN: 
        begin 
          {if KeyUp} 
          if (KeyUp <> false) then 
            begin 
              {Manda uma mensagem falsa para a aplicação...} 
              PostMessage (lpHookRec^.TheCtrlWinHandle, WM_KEYDOWN, 0, 0); 
              PostMessage (lpHookRec^.TheCtrlWinHandle, WM_KEYUP, 0, 0)
            end { (KeyUp <> false) }; 
          {se quiser "engolir" a tecla pressionada retorne -1} 
          {senão retorne 0} 
          Result := 0; 
          exit
        end;  
      {se a tecla "para a esquerda" foi pressionada, vamos brincar!} 
      VK_LEFT: 
        begin 
          {if KeyUp} 
          if (KeyUp <> false) then 
            begin 
              {Create a UpArrow keyboard event} 
              keybd_event (VK_RIGHT, 0, 0, 0); 
              keybd_event (VK_RIGHT, 0, KEYEVENTF_KEYUP, 0)
            end { (KeyUp <> false) }; 
          {engole a tecla} 
          Result := -1; 
          exit
        end;  
      end { case wParam }; {case wParam} 
      {Allow the keystroke} 
      Result := 0
    end;  
  HC_NOREMOVE: 
    begin 
      {Esta é uma mensagem do teclado, mas a mensagem não foi
       removida da fila, porque uma aplicação chamou PeekMessage() com
       atributo PM_NOREMOVE} 
      Result := 0; 
      exit
    end; 
  end { case code }; {case code} 
  if (code < 0) then 
    {Próxima captura na fila} 
    Result := CallNextHookEx (lpHookRec^.TheHookHandle, code, wParam, lParam)
end; { KeyBoardProc } 


procedure StartKeyBoardHook 
  stdcall; 
begin { StartKeyBoardHook } 
  {Se temos uma variavel global na memória
   e a captura ainda não foi iniciada} 
  if ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle = 0)) then 
    begin 
      {Inicie a captura e guarde o handle} 
      lpHookRec^.TheHookHandle := SetWindowsHookEx (WH_KEYBOARD, @KeyBoardProc, 
        HInstance, 0)
    end { ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle = 0)) }
end; { StartKeyBoardHook } 


procedure StopKeyBoardHook 
  stdcall; 
begin { StopKeyBoardHook } 
  {Se temos uma variavel global na memória
   e a captura já foi inciada} 
  if ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle <> 0)) then 
    begin 
      {Retira a captura e limpe o handle} 
      if (UnHookWindowsHookEx (lpHookRec^.TheHookHandle) <> false) then 
        begin 
          lpHookRec^.TheHookHandle := 0
        end { (UnHookWindowsHookEx (lpHookRec^.TheHookHandle) <> false) }
    end { ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle <> 0)) }
end; { StopKeyBoardHook } 


procedure DllEntryPoint (dwReason: DWord); 
begin { DllEntryPoint } 
  Case dwReason Of 
  Dll_Process_Attach: 
    begin 
      {Se mapeado dentro de um processo, então
       pegue um pointer para nossa variavel global}
      hObjHandle := 0; 
      lpHookRec := Nil; 
      MapFileMemory (sizeof (lpHookRec^))
    end; 
  Dll_Process_Detach: 
    begin 
      {Se desmapeado de um processo, remova o pointer
       da variavel}
      UnMapFileMemory
    end; 
  end { case dwReason }
end; { DllEntryPoint } 


Exports 
  KeyBoardProc name ´KEYBOARDPROC´, 
  GetHookRecPointer name ´GETHOOKRECPOINTER´, 
  StartKeyBoardHook name ´STARTKEYBOARDHOOK´, 
  StopKeyBoardHook name ´STOPKEYBOARDHOOK´; 

begin 
  {Inicia o ponto de entrada da DLL} 
  DLLProc := @DllEntryPoint; 
  {Chama o ponto de entrada da DLL} 
  DllEntryPoint (Dll_Process_Attach)
end.

  StartKeyBoardHook name ´STARTKEYBOARDHOOK´,
  StopKeyBoardHook name ´STOPKEYBOARDHOOK´;