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

=== Hook на клавиатуру и мышку ===
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;
 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;
 end;
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 
ID: 01606
----
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.
Author: Mikel
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01607