Перехват нажатия клавиатуры в конкретном приложении - VB

Узнай цену своей работы

Формулировка задачи:

Возможно это уже где то звучало, но тк с апи не имел ничего общего обращаюсь к вам. Надо создать приложение чтобы перехватывать нажатия клавиатуры и записывать их в текстовый файл. Причем надо бы и кириллицу и латиницу и спецсимволы и цифры. Без форм,без настроек и прочего. Только перехват клавиатуры в текст. Если есть желание, то можно не бесплатно. Писать надо на VB6.0

Решение задачи: «Перехват нажатия клавиатуры в конкретном приложении»

textual
Листинг программы
  1. Option Explicit
  2.  
  3. Private Type POINTAPI
  4.     x As Long
  5.     y As Long
  6. End Type
  7. Private Type MSLLHOOKSTRUCT
  8.     pt As POINTAPI
  9.     mouseData As Long
  10.     flags As Long
  11.     time As Long
  12.     dwExtraInfo As Long
  13. End Type
  14. Private Type KBDLLHOOKSTRUCT
  15.     VkCode As Long
  16.     ScanCode As Long
  17.     flags As Long
  18.     time As Long
  19.     dwExtraInfo As Long
  20. End Type
  21.  
  22. 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
  23. Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Integer, lParam As Any) As Long
  24. Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
  25.  
  26. Private Const WH_KEYBOARD_LL = 13
  27. Private Const WH_MOUSE_LL = &HE&
  28. Private Const HC_ACTION = 0
  29. Private Const LLKHF_INJECTED = &H10
  30. Private Const LLMHF_INJECTED = 1
  31. Private Const WM_KEYDOWN As Long = &H100
  32. Private Const WM_KEYUP As Long = &H101
  33. Private Const WM_SYSKEYDOWN As Long = &H104
  34. Private Const WM_SYSKEYUP As Long = &H105
  35. Private Const WM_MOUSEMOVE As Long = &H200
  36. Private Const WM_LBUTTONDOWN As Long = &H201
  37. Private Const WM_LBUTTONUP As Long = &H202
  38. Private Const WM_MBUTTONDOWN As Long = &H207
  39. Private Const WM_MBUTTONUP As Long = &H208
  40. Private Const WM_RBUTTONDOWN As Long = &H204
  41. Private Const WM_RBUTTONUP As Long = &H205
  42. Private Const WM_MOUSEWHEEL As Long = &H20A
  43.  
  44. Dim hKeyHook As Long, hMouseHook As Long
  45.  
  46. Public Sub Hook()
  47.     hKeyHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelkbdProc, App.hInstance, 0)
  48.     If hKeyHook = 0 Then MsgBox ("Keyboard hook error")
  49.     hMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, App.hInstance, 0)
  50.     If hMouseHook = 0 Then MsgBox ("Mouse hook error")
  51. End Sub
  52. Public Sub UnHook()
  53.     If hKeyHook Then UnhookWindowsHookEx (hKeyHook): hKeyHook = 0
  54.     If hMouseHook Then UnhookWindowsHookEx (hMouseHook): hMouseHook = 0
  55. End Sub
  56. ' Процедура перехвата сообщений клавиатуры
  57. Private Function LowLevelkbdProc(ByVal uCode As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long
  58.     If uCode = HC_ACTION Then
  59.         Select Case wParam
  60.         Case WM_KEYDOWN, WM_KEYUP, WM_SYSKEYDOWN, WM_SYSKEYUP
  61.             frmMain.lstEvenst.AddItem KeyString(wParam) & _
  62.                                       "KeyCode: " & lParam.VkCode & _
  63.                                       " ScanCode: " & lParam.ScanCode & _
  64.                                       IIf(lParam.flags And LLKHF_INJECTED, "(inj)", vbNullString)
  65.             frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1
  66.         End Select
  67.     End If
  68.     LowLevelkbdProc = CallNextHookEx(hKeyHook, uCode, wParam, lParam)
  69. End Function
  70. ' Процедура перехвата сообщений мыши
  71. Private Function LowLevelMouseProc(ByVal uCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long
  72.     If uCode = HC_ACTION Then
  73.         Select Case wParam
  74.         Case WM_MOUSEMOVE
  75.             frmMain.lstEvenst.AddItem "MouseMove: " & _
  76.                                       "Coord: " & lParam.pt.x & ", " & lParam.pt.y & _
  77.                                       IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString)
  78.             frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1
  79.         Case WM_MOUSEWHEEL
  80.             frmMain.lstEvenst.AddItem "MouseWheel: " & _
  81.                                       "Coord: " & lParam.pt.x & ", " & lParam.pt.y & _
  82.                                       " Dir: " & IIf(lParam.mouseData > 0, "Forward", "Backward") & _
  83.                                       IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString)
  84.             frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1
  85.         Case Else
  86.             frmMain.lstEvenst.AddItem MouseString(wParam) & _
  87.                                       " Coord: " & lParam.pt.x & ", " & lParam.pt.y & _
  88.                                       IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString)
  89.             frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1
  90.         End Select
  91.     End If
  92.     LowLevelMouseProc = CallNextHookEx(hMouseHook, uCode, wParam, lParam)
  93. End Function
  94. Private Function MouseString(WH As Long) As String
  95.     Select Case WH
  96.     Case WM_LBUTTONDOWN: MouseString = "MouseLButtonDown:"
  97.     Case WM_LBUTTONUP: MouseString = "MouseLButtonUp:"
  98.     Case WM_RBUTTONDOWN: MouseString = "MouseRButtonDown:"
  99.     Case WM_RBUTTONUP: MouseString = "MouseRButtonUp:"
  100.     Case WM_MBUTTONDOWN: MouseString = "MouseMButtonDown:"
  101.     Case WM_MBUTTONUP: MouseString = "MouseMMuttonUp:"
  102.     End Select
  103. End Function
  104. Private Function KeyString(WH As Long) As String
  105.     Select Case WH
  106.     Case WM_KEYDOWN: KeyString = "KeyDown:"
  107.     Case WM_KEYUP: KeyString = "KeyUp:"
  108.     Case WM_SYSKEYDOWN: KeyString = "KeySysDown:"
  109.     Case WM_SYSKEYUP: KeyString = "KeySysUp:"
  110.     End Select
  111. End Function

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

8   голосов , оценка 4.375 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы