Перехват нажатия клавиатуры в конкретном приложении - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д