Мышка/клавиатура
Code: |
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
Code: |
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. |
Пример использования:
Code: |
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. |
- Подробности
- Родительская категория: Работа с железом
- Категория: Мышка/клавиатура
Code: |
unit Unit1; {©Drkb v.3}
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type TForm1 = class(TForm) Memo1: TMemo; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); end;
var Form1: TForm1;
implementation
{$R *.dfm}
var MouseHook: HHOOK;
function LowLevelMouseProc(nCode: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall; begin Result := CallNextHookEx(MouseHook, nCode, WParam, LParam); case WParam of WM_LBUTTONDOWN: Form1.Memo1.Lines.Add('Мыша вдавилась левой кнопкой.'); WM_LBUTTONUP: Form1.Memo1.Lines.Add('Мыша отдавилась левой кнопкой.'); WM_LBUTTONDBLCLK: Form1.Memo1.Lines.Add('Мыша дважды клацнулась левой кнопкой.'); WM_RBUTTONDOWN: Form1.Memo1.Lines.Add('Мыша вдавилась правой кнопкой.'); WM_RBUTTONUP: Form1.Memo1.Lines.Add('Мыша отдавилась правой кнопкой.'); WM_RBUTTONDBLCLK: Form1.Memo1.Lines.Add('Мыша дважды клацнулась правой кнопкой.'); WM_MBUTTONDOWN: Form1.Memo1.Lines.Add('Мыша вдавилась средней кнопкой.'); WM_MBUTTONUP: Form1.Memo1.Lines.Add('Мыша отдавилась средней кнопкой.'); WM_MBUTTONDBLCLK: Form1.Memo1.Lines.Add('Мыша дважды клацнулась средней кнопкой.'); WM_MOUSEMOVE: Form1.Memo1.Lines.Add('Мыша побежала.'); WM_MOUSEWHEEL: Form1.Memo1.Lines.Add('Мыша тащиться.'); else Form1.Memo1.Lines.Add('Мыша сошла с ума, купите новую мышу.'); end; end;
procedure TForm1.FormCreate(Sender: TObject); const WH_MOUSE_LL = 14; begin MouseHook := SetWindowsHookEx(WH_MOUSE_LL, @LowLevelMouseProc, HInstance, 0); end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin UnhookWindowsHookEx(MouseHook); end;
end. |
Тож самое и на клавиатуру, код хука - Цифра 13 Соответственно принимай уже мессаги от клавиатуры...
Только начиная с Win 2000
- Подробности
- Родительская категория: Работа с железом
- Категория: Мышка/клавиатура
Как сделать так, чтобы при минимизации приложения в Tray его можно было вызвать определённой комбинацией клавиш, например Alt-Shift-F9 ?
- Подробности
- Родительская категория: Мышка/клавиатура
- Категория: Клавиатура
Code: |
winexec(Pchar('rundll32 keyboard,disable' ) ,sw_Show); Клава OFF winexec(Pchar('rundll32 mouse,disable' ) ,sw_Show); Маус OFF |
- Подробности
- Родительская категория: Работа с железом
- Категория: Мышка/клавиатура
Я хотел бы обнаружить более 2 клавиш, нажимая в форме. Например, я хотел бы знать, если пользователь нажал время. В onkeydown должны, кажется, только чек на одну или две клавиши максимум, но верном вы можете определить, какие клавиши нажаты.
- Подробности
- Родительская категория: Мышка/клавиатура
- Категория: Клавиатура
Code: |
procedure TForm1.Button1Click(Sender: TObject); {©Drkb v.3}
var TI:TInput; MI: TMouseInput; P:TPoint; begin GetCursorPos(P); MI.dx := P.X; MI.dy := P.Y; MI.mouseData := 0; MI.dwFlags := MOUSEEVENTF_RIGHTDOWN ; MI.time := 10; TI.mi := MI; TI.Itype := INPUT_MOUSE; SendInput(1, TI, SizeOf(TInput)); MI.dwFlags:=MOUSEEVENTF_RIGHTUP; TI.mi := MI; SendInput(1, TI, SizeOf(TInput)); end; |
- Подробности
- Родительская категория: Работа с железом
- Категория: Мышка/клавиатура
Представьте себе такую ситуацию: глупый пользователь включает тачку, а тут... светомузыка, индикаторы состояния клавиш то включатся, то погаснут... а если ещё каждую секунду проходит 500 тактов!!! Шутка, конечно злостная, но воспроизводится весьма легко.
Всё основывается на следующем коде:
- Подробности
- Родительская категория: Мышка/клавиатура
- Категория: Клавиатура
Code: |
unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;
type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); private { Private declarations } procedure AppIdle(Sender: TObject; var Done: Boolean); public { Public declarations } end;
var Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean); begin if GetAsyncKeyState(VK_SNAPSHOT) <> 0 then Form1.Caption := 'PrintScreen ia?aoa !'; Done := True; end;
procedure TForm1.FormCreate(Sender: TObject); begin Application.OnIdle := AppIdle; end; end. |
- Подробности
- Родительская категория: Мышка/клавиатура
- Категория: Клавиатура
Code: |
SelectNext(screen.ActiveControl, True, True); |
Разместите приведенный код в обработчике одного из собитий. SelectNext - защищенный метод TWinControl со следующим прототипом:
- Подробности
- Родительская категория: Мышка/клавиатура
- Категория: Клавиатура
Code: |
// используемые переменные var Dummy: integer = 0; OldKbHook: HHook = 0;
implementation
function KbHook(code: Integer; wparam: Word; lparam: LongInt): LongInt; stdcall; begin if code < 0 then Result := CallNextHookEx(oldKbHook, code, wparam, lparam) else Result := 1; end;
// включение клавы
procedure TForm1.KeyBoardOn(Sender: TObject); begin if OldKbHook <> 0 then begin UnHookWindowshookEx(OldKbHook); OldKbHook := 0; end; SystemParametersInfo(SPI_SETFASTTASKSWITCH, 0, 0, 0); SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, 0, 0); end;
// выключение клавы
procedure TForm1.KeyBoardOff(Sender: TObject); begin SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy, 0); SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0); OldKbHook := SetWindowsHookEx(WH_KEYBOARD, @KbHook, HInstance, 0); end; |
- Подробности
- Родительская категория: Мышка/клавиатура
- Категория: Клавиатура
Code: |
procedure TForm1.Button1Click(Sender: TObject); begin if GetKeyState(VK_SHIFT) < 0 then ShowMessage('Кнопка Shift нажата') else ShowMessage('Обычное нажатие кнопки'); end; |
- Подробности
- Родительская категория: Мышка/клавиатура
- Категория: Клавиатура
Страница 1 из 8