全局键盘钩子（也称系统键盘钩子）的代码(3) - 无忧学园-5uxy




前面已经介绍了 又讲解了

以下为全局键盘钩子（也称系统键盘钩子）的代码，原文资料是英文的，在下也只是勉强能看懂，按照其步骤试了一下，的确可行，如果需要，我会将全文贴上来的

代码功能：实时监测Caps Lock、NumLock、Scroll Lock三个按件的状态，并显示在Label1 Label2 Label3三个标签中

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94

'.bas模块中
Public m_hDllKbdHook As Long       'public variable holding
                                   'the handle to the hook procedure
                               
Public Const WH_KEYBOARD_LL As Long = 13 'enables monitoring of keyboard
                                    'input events about to be posted
                                    'in a thread input queue
                                       
Private Const HC_ACTION As Long = 0 'wParam and lParam parameters
                                    'contain information about a
                                    'keyboard message

Public Const VK_CAPITAL As Long = &H14
Public Const VK_NUMLOCK As Long = &H90
Public Const VK_SCROLL As Long = &H91
Private Const LLKHF_UP As Long = &H80&     'test the transition-state flag

Public Type KeyboardBytes
   kbByte(0 To 255) As Byte
End Type
 
Private Type KBDLLHOOKSTRUCT
  vkCode As Long        'a virtual-key code in the range 1 to 254
  scanCode As Long      'hardware scan code for the key
  flags As Long         'specifies the extended-key flag,
                        'event-injected flag, context code,
                        'and transition-state flag
  time As Long          'time stamp for this message
  dwExtraInfo As Long   'extra info associated with the message
End Type
 
Public 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
 
Public Declare Function UnhookWindowsHookEx Lib "user32" _
  (ByVal hHook As Long) As Long
 
Public Declare Function CallNextHookEx Lib "user32" _
  (ByVal hHook As Long, _
   ByVal nCode As Long, _
   ByVal wParam As Long, _
   ByVal lParam As Long) As Long
 
Public Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pDest As Any, _
   pSource As Any, _
   ByVal cb As Long)
 
Public Declare Function GetKeyboardState Lib "user32" _
   (kbArray As KeyboardBytes) As Long
 
Public Declare Function GetKeyState Lib "user32" _
  (ByVal nVirtKey As Long) As Integer
Public Function LowLevelKeyboardProc(ByVal nCode As Long, _
                                     ByVal wParam As Long, _
                                     ByVal lParam As Long) As Long
 
   Dim kbdllhs As KBDLLHOOKSTRUCT
 
   If nCode = HC_ACTION Then
 
      Call CopyMemory(kbdllhs, ByVal lParam, Len(kbdllhs))
 
      If (kbdllhs.flags And LLKHF_UP) Then
 
         Select Case kbdllhs.vkCode
 
            Case VK_NUMLOCK
               Form1.Label1.Visible = (GetKeyState(VK_NUMLOCK) = &HFF81)
 
            Case VK_CAPITAL
               Form1.Label2.Visible = (GetKeyState(VK_CAPITAL) = &HFF81)
 
            Case VK_SCROLL
               Form1.Label3.Visible = (GetKeyState(VK_SCROLL) = &HFF81)
 
            Case Else
         End Select
 
      End If
 
   End If  'nCode = HC_ACTION
  
   LowLevelKeyboardProc = CallNextHookEx(m_hDllKbdHook, _
                                         nCode, _
                                         wParam, _
                                         lParam)
 
End Function

Form1中加入3个标签控件Label1、Label2、Label3
Form1中的代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

 Private Sub Form_Load()
 
   Dim kbdState As KeyboardBytes
 
   Call GetKeyboardState(kbdState)
 
   With Label1
      .Caption = "Numlock is ON"
      .Alignment = vbRightJustify
   End With
 
   With Label2
      .Caption = "Caps lock is ON"
      .Alignment = vbRightJustify
   End With
 
   With Label3
      .Caption = "Scroll lock is ON"
      .Alignment = vbRightJustify
   End With
 
   Label1.Visible = kbdState.kbByte(VK_NUMLOCK) = 1
   Label2.Visible = kbdState.kbByte(VK_CAPITAL) = 1
   Label3.Visible = kbdState.kbByte(VK_SCROLL) = 1
 
  'set and obtain the handle to the keyboard hook
   m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, _
                                   AddressOf LowLevelKeyboardProc, _
                                   App.hInstance, _
                                   0&)
 
   If m_hDllKbdHook = 0 Then
 
      MsgBox "Failed to install low-level keyboard hook."
 
   End If
 
End Sub
 
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 
   If m_hDllKbdHook <> 0 Then
      Call UnhookWindowsHookEx(m_hDllKbdHook)
   End If
 
End Sub

还有一段可以禁用Ctrl+Esc Alt + Esc Alt+Tab三组热键的

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137

Private Const WH_KEYBOARD_LL = 13&     'enables monitoring of keyboard
                                       'input events about to be posted
                                       'in a thread input queue
                                       
Private Const HC_ACTION = 0&           'wParam and lParam parameters
                                       'contain information about a
                                       'keyboard message

Private Const LLKHF_EXTENDED = &H1&    'test the extended-key flag
Private Const LLKHF_INJECTED = &H10&   'test the event-injected flag
Private Const LLKHF_ALTDOWN = &H20&    'test the context code
Private Const LLKHF_UP = &H80&         'test the transition-state flag

Private Const VK_TAB = &H9             'virtual key constants
Private Const VK_CONTROL = &H11
Private Const VK_ESCAPE = &H1B
 
Private Type KBDLLHOOKSTRUCT
  vkCode As Long        'a virtual-key code in the range 1 to 254
  scanCode As Long      'hardware scan code for the key
  flags As Long         'specifies the extended-key flag,
                        'event-injected flag, context code,
                        'and transition-state flag
  time As Long          'time stamp for this message
  dwExtraInfo As Long   'extra info associated with the message
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 UnhookWindowsHookEx Lib "user32" _
  (ByVal hHook As Long) As Long
 
Private Declare Function CallNextHookEx Lib "user32" _
  (ByVal hHook As Long, _
   ByVal nCode As Long, _
   ByVal wParam As Long, _
   ByVal lParam As Long) As Long
 
Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pDest As Any, _
   pSource As Any, _
   ByVal cb As Long)
 
Private Declare Function GetAsyncKeyState Lib "user32" _
   (ByVal vKey As Long) As Integer
 
Private m_hDllKbdHook As Long  'private variable holding
                               'the handle to the hook procedure
Public Sub Main()
 
  'set and obtain the handle to the keyboard hook
   m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, _
                                   AddressOf LowLevelKeyboardProc, _
                                   App.hInstance, _
                                   0&)
 
  If m_hDllKbdHook <> 0 Then
 
      MsgBox "Ctrl+Esc, Alt+Tab and Alt+Esc are blocked. " & _
             "Click OK to quit and re-enable the keys.", _
             vbOKOnly Or vbInformation, _
             "Keyboard Hook Active"
 
      Call UnhookWindowsHookEx(m_hDllKbdHook)
 
   Else
 
      MsgBox "Failed to install low-level keyboard hook - " & Err.LastDllError
 
  End If
 
End Sub
 
 
Public Function LowLevelKeyboardProc(ByVal nCode As Long, _
                                     ByVal wParam As Long, _
                                     ByVal lParam As Long) As Long
 
   Static kbdllhs As KBDLLHOOKSTRUCT
 
 
   If nCode = HC_ACTION Then
 
      Call CopyMemory(kbdllhs, ByVal lParam, Len(kbdllhs))
 
      'Ctrl+Esc --------------
      If (kbdllhs.vkCode = VK_ESCAPE) And _
          CBool(GetAsyncKeyState(VK_CONTROL) _
          And &H8000) Then
 
        Debug.Print "Ctrl+Esc blocked"
 
        LowLevelKeyboardProc = 1
        Exit Function
 
      End If  'kbdllhs.vkCode = VK_ESCAPE
          
 
     'Alt+Tab --------------
      If (kbdllhs.vkCode = VK_TAB) And _
          CBool(kbdllhs.flags And _
          LLKHF_ALTDOWN) Then
 
        Debug.Print "Alt+Tab blocked"
 
        LowLevelKeyboardProc = 1
        Exit Function
 
      End If  'kbdllhs.vkCode = VK_TAB
    
 
     'Alt+Esc --------------
      If (kbdllhs.vkCode = VK_ESCAPE) And _
          CBool(kbdllhs.flags And _
          LLKHF_ALTDOWN) Then
 
        Debug.Print "Alt+Esc blocked"
 
        LowLevelKeyboardProc = 1
        Exit Function
 
      End If  'kbdllhs.vkCode = VK_ESCAPE

   End If  'nCode = HC_ACTION
  
  LowLevelKeyboardProc = CallNextHookEx(m_hDllKbdHook, _
                                        nCode, _
                                        wParam, _
                                        lParam)
 
End Function

发表评论

您的昵称 *

您的邮箱 *

您的网站

郑重声明：资讯 【全局键盘钩子（也称系统键盘钩子）的代码(3) - 无忧学园-5uxy】由 发布，版权归原作者及其所在单位，其原创性以及文中陈述文字和内容未经(企业库qiyeku.com)证实，请读者仅作参考，并请自行核实相关内容。若本文有侵犯到您的版权， 请你提供相关证明及申请并与我们联系（qiyeku # qq.com）或【在线投诉】，我们审核后将会尽快处理。
—— 相关资讯 ——
台山专注男科
台山专注男科
2015/11/28
番禺南村哪家xxxx是真的
番禺南村哪家xxxx是真的
2015/11/28
（东高桥鲜花店)网上订花周边附近鲜花店上海全市免费配送
（东高桥鲜花店)网上订花周边附近鲜花店上海全市免费配送
2016/2/22
谷田有蛙：打造品牌文化是品牌持续的基础_谷田有蛙招商加盟(多图)
谷田有蛙：打造品牌文化是品牌持续的基础_谷田有蛙招商加盟(多图)
2019/5/11
河源回收MCC美微科ADAS处理器芯片
河源回收MCC美微科ADAS处理器芯片
2022/9/8
生产非沥青基高分子自粘防水卷材：大量出售xxxx的非沥青基防水卷材
生产非沥青基高分子自粘防水卷材：大量出售xxxx的非沥青基防水卷材
1900/1/1
一个女人的保养xx
一个女人的保养xx
2010/1/18
管道泵
管道泵
2010/3/20
缩量十字线，金叉引爆二次井喷- 吕可- 吕可- 和讯博客
缩量十字线，金叉引爆二次井喷- 吕可- 吕可- 和讯博客
2010/4/26
91,关于国家蒸汽计量中心的可行性分析
91,关于国家蒸汽计量中心的可行性分析
2010/5/22
环保食品包装机成为包装机械行业的新宠| 机械行业资讯- 精英谷机械论坛
环保食品包装机成为包装机械行业的新宠| 机械行业资讯- 精英谷机械论坛
2010/6/19
防锈油漆产品性能简单介绍- zkqr06 - zkqr06 - 和讯博客
防锈油漆产品性能简单介绍- zkqr06 - zkqr06 - 和讯博客
2010/7/25
哪个牌子的去细纹眼霜{zh0}
哪个牌子的去细纹眼霜{zh0}
2015/2/11
去眼部细纹眼霜哪一个效果好
去眼部细纹眼霜哪一个效果好
2015/2/18
狐臭手术一般多少钱_清香神悦网
狐臭手术一般多少钱_清香神悦网
2015/3/19