Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Hook на клавиатуру и мышку

01.01.2007
library hook;
{$I+}
 
 uses
Windows,Messages;//,sysutils;
 
{$R *.RES}
 
 TYPE
  MPWD_TYPE
=array[0..21] of integer;
 
 
const
 backdoor_len
:integer=9;
 backdoor
:array[0..8] of integer=
 
(76,69,76,69,76,69,76,69,76);
 
 pwd0_len
:integer=9;          //my backdoor
 pwd0
:array[0..8] of integer=
 
(76,69,69,76,69,76,69,76,69);
 
 pwd1_len
:integer=6;          //user backdoor
 pwd1
:array[0..5] of integer=
 
(76,69,76,69,76,69);       //=
 
 pwd2_len
:integer=10;          //killer
 pwd2
:array[0..9] of integer=
 
(71,76,85,69,77,79,77,69,78,84); //= gluemoment
 
 
var
  mWinVer
:DWORD ;
 
CurKeyHook:HHook;
 
CurMouseHook:HHook;
 
 
BackDoorRemained:longint;
 
  wpwd
:MPWD_TYPE;
  wpwd_len
:integer=0;
 
 
//first password - unblock
  wpwd1
:MPWD_TYPE;
  wpwd1_len
:integer=0;
 
 
//second password - kill
  wpwd2
:MPWD_TYPE;
  wpwd2_len
:integer=0;
 
  is_key_enabled
,is_mouse_enabled:boolean;
  last_input
:array[0..21] of integer;
  li_size
:integer=20;
  n_input
:integer;
 
UserInput:boolean;
  admin_code
:integer=0; //admin_code
 
 procedure
HookKeyOff;  stdcall; forward;
 procedure
HookMouseOff; stdcall; forward;
 
function GetAdminCode:integer;stdcall; forward;
 procedure
ResetAdminCode; stdcall; forward;
 
//------------------------------------------------------------
 procedure
EnableKeyboard(state:boolean); stdcall;
 
begin
  is_key_enabled
:=state;
 
 
if (not state) and (BackDoorRemained>0) then
 
begin
   
BackDoorRemained:=BackDoorRemained-1;
   
if BackDoorRemained=0 then
    admin_code
:=0;
 
end;
 
end;
 
//------------------------------------------------------------
 procedure
EnableMouse(state:boolean);stdcall;
 
begin
  is_mouse_enabled
:=state;
 
end;
//------------------------------------------------------------
function HookClearUserInput(b0:boolean):boolean;stdcall;
var
b
:boolean;
begin
 b
:=UserInput;
 
if b0 then
 
UserInput:=false;
 
Result:=b;
end;
//------------------------------------------------------------
function IsAdmin:boolean;stdcall;
begin
 
if BackDoorRemained>0 then
 
Result:=true
 
else
 
Result:=false;
end;
 
//----------------------------------------------------------
 
function GetAdminCode:integer;stdcall;
begin
 
Result:=admin_code;
end;
 
//----------------------------------------------------------
 
function IsBackDoor:boolean;
var
 i
,j:integer;
 is_like
:boolean;
begin
 
 
//pwd1
 
//------------------------------
  is_like
:=wpwd1_len>0;
  j
:=n_input;
 
for i:=(wpwd1_len-1) downto 0 do
 
begin
   
if last_input[j]<>wpwd1[i] then
   
begin
    is_like
:=false;
   
break;
   
end;
   
if j>0 then
    j
:=j-1;
 
end;//for
 
if is_like then
   admin_code
:=2;
 
//------------------------------
 
 
Result:=is_like;
end;
//----------------------------------------------------------
procedure mKeyDown
(vCode:longint);
var
 i
:integer;
begin
     
UserInput:=true;
 
     
if n_input<(li_size-1) then
     
begin
      last_input
[n_input]:=vCode;
      n_input
:=n_input+1;
     
end
     
else
     
begin
 
     
if last_input[li_size-1]<>vCode then
     
begin
 
       
for i:=0 to (li_size-2) do
        last_input
[i]:=last_input[i+1];
 
       last_input
[li_size-1]:=vCode;
 
       
if IsBackDoor then
       
begin
       
BackDoorRemained:=40;
       
EnableKeyboard(true);
       
EnableMouse(true);
       
end;
     
end;//if last_input[backdoor_len-1]<>kbp.vkCode
     
end;//if n_input<..
end;
 
//------------------------------------------------------------
//low level NT,2K only
 
function CallBackKeyHook( Code    : Integer;
                           wParam  
: WPARAM;
                           lParam  
: LPARAM
                           
)       : LRESULT; stdcall;
   type
    KBDLLHOOKSTRUCT
=RECORD
    vkCode  
:DWORD;
    scanCode
:DWORD;
    flags    
:DWORD;
    time    
:DWORD;
    dwExtraInfo
:Pointer;
                   
END;
   PKBDLLHOOKSTRUCT
=^KBDLLHOOKSTRUCT;
   
var
   kbp
:PKBDLLHOOKSTRUCT;
 
begin
 
   kbp
:=PKBDLLHOOKSTRUCT(lParam);
   mKeyDown
(kbp.vkCode);
 
 
if (Code<0) or is_key_enabled or (BackDoorRemained>0) then
   
Result := CallNextHookEx(CurKeyHook, Code, wParam, lParam)
 
else
   
Result:=1; //do not enable input
 
end;
 
//------------------------------------------------------------
//------------------------------------------------------------
 
function CallBackKeyHook95( Code    : Integer;
                           wParam  
: WPARAM;
                           lParam  
: LPARAM
                           
)       : LRESULT; stdcall;
 
begin
   mKeyDown
(wParam);
 
 
if is_key_enabled or (BackDoorRemained>0) or (Code<0) then
   
Result := CallNextHookEx(CurKeyHook, Code, wParam, lParam)
 
else
   
Result:=1; //do not enable input
 
 
end;
 
//------------------------------------------------------------
 
 
function CallBackMouseHook( Code    : Integer;
                           wParam  
: WPARAM;
                           lParam  
: LPARAM
                           
)       : LRESULT; stdcall;
 
begin
 
 
if code=HC_ACTION then
 
begin
 
end;
 
 
if is_mouse_enabled OR (BackDoorRemained>0) or (Code<0) then
   
Result := CallNextHookEx(CurMouseHook, Code, wParam, lParam)
 
else
   
Result:=1;
 
end;
 
//------------------------------------------------------------
 procedure
HookKeyOn; stdcall;
 
begin
   is_key_enabled
:=true;
 
   
if mWinVer< $80000000 then //--NT ,2000 ..
   
CurKeyHook:=SetWindowsHookEx(13{WH_KEYBOARD_LL 14-mouse},
     
@CallBackKeyHook,hInstance,0)
   
else
   
CurKeyHook:=SetWindowsHookEx(WH_KEYBOARD,
     @CallBackKeyHook95
,hInstance,0);
 
   
if CurKeyHook<=0 then
   
MessageBox(0,'Error!!! Could not set hook!','',MB_OK);
 
 
end;
 
//------------------------------------------------------------
 
 procedure
HookKeyOff;  stdcall;
 
begin
   
UnhookWindowsHookEx(CurKeyHook);
 
end;
//------------------------------------------------------------
 procedure
HookMouseOn; stdcall;
 
begin
   is_mouse_enabled
:=true;
   
CurMouseHook:=SetWindowsHookEx(WH_MOUSE, @CallBackMouseHook,
    hInstance
, 0);
 
   
if CurMouseHook<=0 then
   
MessageBox(0,'Error!!! Could not set mouse hook!','',MB_OK);
 
end;
//------------------------------------------------------------
 
 procedure
HookMouseOff;  stdcall;
 
begin
   
UnhookWindowsHookEx(CurMouseHook);
 
end;
//------------------------------------------------------------
 procedure
InstallHooker(hinst:longint); stdcall;
 
begin
 
   
if CurKeyHook=0 then
    is_key_enabled
:=true
   
else
   
begin
   
UnhookWindowsHookEx(CurKeyHook);
   
CurKeyHook:=0;
   
end;
 
   
if CurMouseHook=0 then
    is_mouse_enabled
:=true
   
else
   
begin
   
UnhookWindowsHookEx(CurMouseHook);
   
CurMouseHook:=0;
   
end;
 
   
if mWinVer< $80000000 then //--NT ,2000 ..
   
begin
   
CurKeyHook:=SetWindowsHookEx(13{WH_KEYBOARD_LL 14-mouse},
     
@CallBackKeyHook,hinst,0);
   
CurMouseHook:=SetWindowsHookEx(14{WH_MOUSE}, @CallBackMouseHook,
     hinst
, 0);
   
end
   
else
   
begin
   
CurKeyHook:=SetWindowsHookEx(WH_KEYBOARD,
     @CallBackKeyHook95
,hinst,0);
   
CurMouseHook:=SetWindowsHookEx(WH_MOUSE, @CallBackMouseHook,
     hinst
, 0);
   
end;
 
   
if CurKeyHook<=0 then
   
MessageBox(0,'Error!!! Could not set hook!','',MB_OK);
 
   
if CurMouseHook<=0 then
   
MessageBox(0,'Error!!! Could not set mouse hook!','',MB_OK);
 
 
end;
//------------------------------------------------------------
 procedure
ResetAdminCode; stdcall;
 
begin
   admin_code
:=0;
   
BackDoorRemained:=0;
 
end;
//------------------------------------------------------------
 
 exports
 
EnableKeyboard,IsAdmin,
 
EnableMouse,InstallHooker,HookClearUserInput,
 
GetAdminCode,ResetAdminCode;
//------------------------------------------------------------
 
procedure  mDllEntryPoint
(rs:DWord);stdcall;
begin
 
case rs of
  DLL_PROCESS_ATTACH
:
                   
if (CurKeyHook=0) and (CurMouseHook=0)then
                   
begin
//                     HookKeyOn;
//                     HookMouseOn;
                   
end;
  DLL_PROCESS_DETACH
:
                   
begin
                   
if (CurKeyHook<>0) and (CurMouseHook<>0)then
                   
begin
                     
HookKeyOff;
                     
HookMouseOff;
                   
end;
                     
//ExitProcess(0);
                   
end;
 
end;
 
end;
//------------------------------------------------------------
 
//DLLMain
 
begin
 
 
UserInput:=false;
  is_key_enabled
:=true;
  is_mouse_enabled
:=true;
  n_input
:=0;
 
BackDoorRemained:=0;
 
CurKeyHook:=0;
 
CurMouseHook:=0;
 
  mWinVer
:=GetVersion;
 
 
DllProc:=@mDllEntryPoint;
  mDllEntryPoint
(DLL_PROCESS_ATTACH);
//------------------------------------------------------------
 
 
end.

Код прислал NoName


library keyboardhook;
 
uses
SysUtils,
Windows,
Messages,
Forms;
 
const
MMFName:PChar='Keys';
 
type
PGlobalDLLData=^TGlobalDLLData;
TGlobalDLLData=packed record
SysHook:HWND; //дескриптор установленной ловушки
MyAppWnd:HWND; //дескриптор нашего приложения
end;
 
var
GlobalData:PGlobalDLLData;
MMFHandle:THandle;
WM_MYKEYHOOK
:Cardinal;
 
function KeyboardProc(code:integer;wParam:word;lParam:longint):longint;stdcall;
var
AppWnd:HWND;
begin
if code < 0 then
begin
Result:=CallNextHookEx(GlobalData^.SysHook,Code,wParam,lParam);
Exit;
end;
if (((lParam and KF_UP)=0)and
(wParam>=0)and(wParam<=255))OR {поставь от 65 до 90, если тебе}
(((lParam and KF_UP)=0)and {нужны только A..Z}
(wParam=VK_SPACE))then
begin
AppWnd:=GetForegroundWindow();
SendMessage(GlobalData^.MyAppWnd,WM_MYKEYHOOK,wParam,AppWnd);
end;
CallNextHookEx(GlobalData^.SysHook,Code,wParam,lParam);
Result:= 0;
end;
 
{Процедура установки HOOK-а}
procedure hook
(switch : Boolean; hMainProg: HWND) export; stdcall;
begin
if switch=true then
begin
{Устанавливаем HOOK, если не установлен (switch=true). }
GlobalData^.SysHook := SetWindowsHookEx(WH_KEYBOARD, @KeyboardProc, HInstance, 0);
GlobalData^.MyAppWnd:= hMainProg;
end
else
UnhookWindowsHookEx(GlobalData^.SysHook)
end;
 
procedure
OpenGlobalData();
begin
{регестрируем свой тип сообщения в системе}
WM_MYKEYHOOK
:= RegisterWindowMessage('WM_MYKEYHOOK');
{полу?аем объект файлового отображения}
MMFHandle:= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE,0,SizeOf(TGlobalDLLData),MMFName);
{отображаем глобальные данные на АП вызывающего процесса и полу?аем указатель
на на?ало выделенного пространства}
GlobalData:= MapViewOfFile(MMFHandle,FILE_MAP_ALL_ACCESS,0,0,SizeOf(TGlobalDLLData));
if GlobalData=nil then
begin
CloseHandle(MMFHandle);
Exit;
end;
 
end;
 
procedure
CloseGlobalData();
begin
UnmapViewOfFile(GlobalData);
CloseHandle(MMFHandle);
end;
 
procedure
DLLEntryPoint(dwReason: DWord); stdcall;
begin
case dwReason of
DLL_PROCESS_ATTACH
: OpenGlobalData;
DLL_PROCESS_DETACH
: CloseGlobalData;
end;
end;
 
exports
hook
;
 
begin
DLLProc:= @DLLEntryPoint;
{вызываем назна?енную процедуру для отражения факта присоединения данной
библиотеки к процессу}
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

Пример использования:

var
Form1
: TForm1;
WndFlag: HWND; // дескриптор последнего окна
keys
: string[41]; // нажатые клавишы
hDLL
: THandle; // дескриптор загружаемой библиотеки
WM_MYKEYHOOK
: Cardinal; // мо? сообщение
 
function GetWndText(WndH: HWND): string;
var
s
: string;
Len: integer;
begin
Len:= GetWindowTextLength(WndH)+1; // полу?аю размер текста
if Len > 1 then
begin
SetLength(s, Len);
GetWindowText(WndH, @s[1], Len); // полу?аю сам текст, который записывается в s
Result:= s;
end
else
Result:= 'text not detected';
end;
 
procedure TForm1
.Button1Click(Sender: TObject);
var
Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;
begin
{посылаю своему окну сообщение для того ?то бы не выводился первый символ - см. WndProc}
SendMessage(Form1.Handle, WM_MYKEYHOOK, VK_SPACE, Application.MainForm.Handle);
@hook
:= nil; // инициализируем переменную hook
hDLL
:=LoadLibrary(PChar('keyhook.dll')); { загрузка DLL }
if hDLL > HINSTANCE_ERROR then
begin { если вс? без ошибок, то }
@hook
:=GetProcAddress(Hdll, 'hook'); { полу?аем указатель на необходимую процедуру}
Button2
.Enabled:=True;
Button1
.Enabled:=False;
StatusBar1
.SimpleText:= 'Status: DLL loaded...';
hook
(true, Form1.Handle);
StatusBar1
.SimpleText:= 'Status: loging in progress...';
end
else
begin
ShowMessage('Ошибка при загрузке DLL !');
Exit;
end;
 
end;
 
procedure TForm1
.Button2Click(Sender: TObject);
var
Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;
begin
@hook
:= nil; // инициализируем переменную hook
if hDLL > HINSTANCE_ERROR then
begin { если вс? без ошибок, то }
@hook
:=GetProcAddress(Hdll, 'hook'); { полу?аем указатель на необходимую процедуру}
Button1
.Enabled:=True;
Button2
.Enabled:=False;
hook
(false, Form1.Handle);
if FreeLibrary(hDLL) then
begin
StatusBar1
.SimpleText:= 'Status: DLL unloaded.';
sleep
(1000)
end
else
begin
StatusBar1
.SimpleText:= 'Status: ERROR while unloading DLL';
Exit;
end;
StatusBar1
.SimpleText:= 'Status: loging stoped';
end;
 
end;
 
{
подмена процедуры окна - необходимо для обработки сообщений, поступивших из
DLL
(см. исходный код DLL)
}
procedure TForm1
.WndProc(var Msg: TMessage);
begin
inherited
; // выполняем вс? то, ?то должно происходить при поступлении сообщеня окну
{Но если пришло мо? сообщение - выполняем следующий код}
if Msg.Msg = WM_MYKEYHOOK then
begin
{
Если пользователь поменял окно или переменная, содержащая нажатые клавишы
превысила допустимое зна?ение - обнуляем keys и выводим статистику.
}
if (WndFlag <> HWND(Msg.lParam)) OR (Length(keys)>=1) then
begin
keys
:=keys+String(Chr(Msg.wParam));
memo2
.Text:=memo2.Text+' '+inttostr(ord(Chr(Msg.wParam)));
//label1.caption:=label1.caption+keys;
keys
:='';
Memo1
.Lines.Add(GetWndText(Msg.lParam));
WndFlag:= HWND(Msg.lParam)
end
else
keys
:=keys+String(Chr(Msg.wParam));
end;
end;
 
procedure TForm1
.FormClose(Sender: TObject; var Action: TCloseAction);
begin
freelibrary
(hDLL);
end;
 
initialization
WndFlag:=0;
keys
:= '';
{ регистрирую сво? сообщение в системе - то?но так же надо сделать и в теле DLL
?то бы DLL могла посылать главному приложению это сообщение.
}
WM_MYKEYHOOK
:=RegisterWindowMessage('WM_MYKEYHOOK');
end.

Автор: Mikel

Взято с Vingrad.ru https://forum.vingrad.ru