Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[18.206.12.31] |
|
Сообщ.
#1
,
|
|
|
Здравствуйте! Сделал хук, необходимо, чтобы блокировались клавиши: Alt+Tab, Win+R, Win+D, Ctrl, LWin, RWin. Перехват идёт стабильно: в Form1.List3 добавляется строчка после каждого нажатия/отжатия, но заблокировать стабильно не удаётся. Через раз работает, а иногда и реже.
Подскажите, пожалуйста, в чём может быть причина? Public Sub HooksEVN(ByVal eMsg As Long, ByVal wParam As Long, ByVal lParam As Long) Dim pos As POINTAPI Select Case eMsg Case WM_KEYDOWN Form1.List3.AddItem (wParam And &HFF) & " down" & wParam & " " & lParam If GetAsyncKeyState(VK_LWIN) Or GetAsyncKeyState(VK_RWIN) Then PressBtn vbKeyEscape If GetAsyncKeyState(vbKeyControl) Then PressBtn vbKeyEscape If GetAsyncKeyState(VK_LWIN) And &HF0000000 And MapVirtualKey(lParam, 1) = Asc("R") Then PressBtn vbKeyEscape If GetAsyncKeyState(VK_RWIN) And &HF0000000 And MapVirtualKey(lParam, 1) = Asc("R") Then PressBtn vbKeyEscape If GetAsyncKeyState(VK_LWIN) And &HF0000000 And MapVirtualKey(lParam, 1) = Asc("D") Then PressBtn vbKeyEscape If GetAsyncKeyState(VK_RWIN) And &HF0000000 And MapVirtualKey(lParam, 1) = Asc("D") Then PressBtn vbKeyEscape If (GetAsyncKeyState(vbKeyMenu) And &HF0000000) And (GetAsyncKeyState(vbKeyTab) And &HF0000000) Then PressBtn vbKeyEscape Case WM_KEYUP Form1.List3.AddItem wParam Case WM_COMMAND Form1.List3.AddItem wParam Case WM_CANCELJOURNAL 'пользователь нажал ctrl+esc или ctrl+alt+del (защита системы от нашего зависания) HooksStop End Select End Sub Public Sub PressBtn(ByVal btn1 As Byte, Optional ByVal btn2 As String = "") If btn2 = "" Then Call keybd_event(btn1, 0, KEYEVENTF_KEYDOWN, 0) Call keybd_event(btn1, 0, KEYEVENTF_KEYUP, 0) Else Call keybd_event(btn1, 0, KEYEVENTF_KEYDOWN, 0) Call keybd_event(btn2, 0, KEYEVENTF_KEYDOWN, 0) ' Simulate key release Call keybd_event(btn2, 0, KEYEVENTF_KEYUP, 0) Call keybd_event(btn1, 0, KEYEVENTF_KEYUP, 0) End If End Sub Public Sub HooksStart() UserHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf HookUsrProc, App.hInstance, 0) WndHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookWndProc, App.hInstance, App.threadID) End Sub Public Function HookWndProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim eMsg As EventMsgWND If nCode < 0 Then HookWndProc = CallNextHookEx(WndHook, nCode, wParam, lParam) Else CopyMemory eMsg, ByVal lParam, Len(eMsg) HookWndProc = CallNextHookEx(WndHook, nCode, wParam, lParam) HooksEVN eMsg.wMsg, eMsg.wParam, eMsg.lParam ', eMsg.msgTime, eMsg.hWndMsg End If End Function Public Function HookUsrProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim eMsg As EventMsgUSR If nCode < 0 Then ' было просто "If nCode Then" HookUsrProc = CallNextHookEx(UserHook, nCode, wParam, lParam) Else CopyMemory eMsg, ByVal lParam, Len(eMsg) HookUsrProc = CallNextHookEx(UserHook, nCode, wParam, lParam) HooksEVN eMsg.wMsg, eMsg.wParam, eMsg.lParam ', eMsg.msgTime, eMsg.hWndMsg End If End Function Можно ли как-то отменить нажатие кнопки или отменить/заблокировать действие после нажатия? |
Сообщ.
#3
,
|
|
|
TheTrik, спасибо вам огромное!
Добавлено Public Type EventMsg lParam As Long wParam As Long wMsg As Long msgTime As Long hWndMsg As Long End Type Public Function HooksStart() As LogVar ' wParam: Low (WORD Param) ' lParam: High (LONG Param) HooksStop KeybHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf HookKeybProc, App.hInstance, 0) MouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf HookMouseProc, App.hInstance, 0) WndHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookWndProc, App.hInstance, App.threadID) If KeybHook > 0 And MouseHook > 0 Then HooksStart = 1 Else HooksStart = 0 End If End Function Public Sub HooksStop() If MouseHook > 0 Then UnhookWindowsHookEx MouseHook MouseHook = 0 End If If KeybHook > 0 Then UnhookWindowsHookEx KeybHook KeybHook = 0 End If If WndHook > 0 Then UnhookWindowsHookEx WndHook WndHook = 0 End If End Sub Public Function HookWndProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim eMsg As EventMsg 'CWPSTRUCT If nCode < 0 Then HookWndProc = CallNextHookEx(WndHook, nCode, wParam, lParam) Else CopyMemory eMsg, ByVal lParam, Len(eMsg) HookWndProc = CallNextHookEx(WndHook, nCode, wParam, lParam) 'WndHookEVN eMsg.wMsg, eMsg.wParam, eMsg.lParam ', eMsg.msgTime, eMsg.hWndMsg HookWndEVN eMsg.wMsg, eMsg.wParam, eMsg.lParam ', eMsg.msgTime, eMsg.hWndMsg End If End Function Public Function HookKeybProc(ByVal uCode As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long Dim prevent As LogVar If uCode = HC_ACTION Then Select Case wParam Case WM_KEYDOWN, WM_SYSKEYDOWN Form1.List3.AddItem wParam & " " & lParam.VkCode & " " & lParam.ScanCode & IIf(lParam.flags And LLKHF_INJECTED, "(inj)", vbNullString) If lParam.VkCode = VK_LWIN Then prevent = 1 'LWIN If lParam.VkCode = VK_RWIN Then prevent = 1 'RWIN If CBool(GetAsyncKeyState(vbKeyControl) And &H8000) Then prevent = 1 ' Ctrl If CBool(lParam.flags And LLKHF_ALTDOWN) Then prevent = 1 ' Alt If lParam.VkCode = vbKeyDelete Then prevent = 1 ' Delete ' ' Alt + Tab If lParam.flags And LLKHF_ALTDOWN And lParam.VkCode = 9 Then prevent = 1 'If lParam.flags And LLKHF_ALTDOWN And lParam.VkCode = 9 Then prevent = 1 'If lParam.VkCode = 27 Then ' If GetAsyncKeyState(vbKeyShift) < 0 And GetAsyncKeyState(vbKeyControl) < 0 Then prevent = 1 ' Ctrl + Esc If (lParam.VkCode = vbKeyEscape) And CBool(GetAsyncKeyState(vbKeyControl) And &H8000) Then prevent = 1 ' Alt + Esc If (lParam.VkCode = vbKeyEscape) And CBool(lParam.flags And LLKHF_ALTDOWN) Then prevent = 1 ' Alt + F4 If (lParam.VkCode = vbKeyF4) And CBool(lParam.flags And LLKHF_ALTDOWN) Then prevent = 1 'End If If lParam.VkCode = vbKeyF2 Then 'Form1.HackExit WindowPrieksh hWnd_target_hook, 1 WindowSetState Form1.hwnd, SW_NORMAL, 1 End If If lParam.VkCode = vbKeyF3 Then prevent = 1 ' ' If (lParam.VkCode = vbKeyTab) And _ ' (lParam.flags And _ ' LLKHF_ALTDOWN) Then prevent = 1 If prevent = 1 Then Form1.List3.AddItem "HOOK" HookKeybProc = -1 Exit Function End If Case WM_KEYUP, WM_SYSKEYUP 'Case WM_SYSKEYDOWN 'Case WM_SYSKEYUP 'frmMain.lstEvenst.AddItem KeyString(wParam) & "KeyCode: " & lParam.VkCode & " ScanCode: " & lParam.ScanCode & IIf(lParam.flags And LLKHF_INJECTED, "(inj)", vbNullString) 'frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 End Select End If HookKeybProc = CallNextHookEx(KeybHook, uCode, wParam, lParam) End Function Public Function HookMouseProc(ByVal uCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long Dim pt As POINTAPI If uCode = HC_ACTION Then Select Case wParam Case WM_MOUSEMOVE 'Form1.List3.AddItem lParam.pt.x & ", " & lParam.pt.y & IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) Case WM_MOUSEWHEEL 'Form1.List3.AddItem lParam.pt.x & ", " & lParam.pt.y & " Dir: " & IIf(lParam.mouseData > 0, "Forward", "Backward") & IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) Case Else 'frmMain.lstEvenst.AddItem MouseString(wParam) & " Coord: " & lParam.pt.x & ", " & lParam.pt.y & IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) 'frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 End Select End If HookMouseProc = CallNextHookEx(MouseHook, uCode, wParam, lParam) End Function Public Sub HookWndEVN(ByVal eMsg As Long, ByVal wParam As Long, ByVal lParam As Long) Select Case eMsg ''' Case WM_ACTIVATEAPP '''Form1.Caption = "0" '''Case WM_ACTIVATE '''Form1.Caption = "1" Case WM_COMMAND Form1.List3.AddItem wParam '''Case WM_CANCELJOURNAL 'пользователь нажал ctrl+esc или ctrl+alt+del (защита системы от нашего зависания) '''HooksStop 'Form1.WorkExit End Select End Sub Добавлено Есть одно замечание: когда нажимаешь Ctrl+Alt+Delete или просто Ctrl+Alt, не срабатывает отмена. If CBool(GetAsyncKeyState(vbKeyControl) And &H8000) and CBool(lParam.flags And LLKHF_ALTDOWN) and lParam.VkCode = vbKeyDelete Then prevent = 1 |