一个实现系统全局热键的模块

'**********************************************************************

'此模块的功能：
'    定义一些系统快捷键，以方便用快捷键来控制本程序：如隐藏/显示主界面，启用/停止监控等

'用 VB 实现全局热键模块
'武汉 艾军
'在软件报以前的文章中，虽然也介绍了如何用 VB 实现全局热键的方法，但是这些文章都只是针对初学者学习技巧而用，而在真正的程序编写中是不适应的，为了使我们编写的程序有继承性、维护性因此有必要制作一个实现全局热键的模块。
'请大家看看下面调用全局热键的示例:

'激活 3 个热键：（注：SetHotkey 是我自定义的函数）
'SetHotkey 1, "Ctrl,112", "Add"             按 Ctrl+F1 激活指定程序
'SetHotkey 2, 113, "Add"                    按 F2 激活指定程序
'SetHotkey 3, "Ctrl+Alt,113", "Add"         按 Ctrl+Alt+F2 激活指定程序
'注释：注：关于激活热键后的操作，由自定义函数 SetHotkey 的 KeyId 传送的值来判断

'注销 3 个热键：
'SetHotkey 1, "", "Del"                     退出程序是一定要用上的，不然会导至程序死掉
'SetHotkey 2, "", "Del"
'SetHotkey 3, "", "Del"
'请大家新建一个模块（.bas）文件，自定义 SetHotkey函数及其他，这样在以后的任何程序中只要调用此模块就可以了。
'**********************************************************************

'**********************************************************************
'以下是键盘中各键对应的ASCII值

'值        描述
'3      CANCEL 键  ()
'8      BACKSPACE 键
'9      TAB 键
'12     CLEAR 键 ()
'13      ENTER 键
'18     MENU 键 ()
'19     PAUSE 键 ()
'20     CAPS LOCK 键
'27     ESC 键
'32     SPACEBAR 键 ()
'33     PAGE UP 键
'34     PAGE DOWN 键
'35     END 键
'36     HOME 键
'37     LEFT ARROW 键
'38     UP ARROW 键
'39     RIGHT ARROW 键
'40     DOWN ARROW 键
'41     SELECT 键  ()
'42     PRINT SCREEN 键 ()
'43     EXECUTE 键 ()
'44     SNAPSHOT 键 ()
'45     INSERT 键
'46     DELETE 键
'47     HELP 键 ()
'144     NUM LOCK 键 ()

'主键盘区中的数字键
'值    描述
'48 0 键
'49 1 键
'50 2 键
'51 3 键
'52 4 键
'53 5 键
'54 6 键
'55 7 键
'56 8 键
'57 9 键

'26个字母
'值     描述
'65     A 键
'66     B 键
'67     C 键
'68     D 键
'69     E 键
'70     F 键
'71     G 键
'72     H 键
'73     I 键
'74     J 键
'75     K 键
'76     L 键
'77     M 键
'78     N 键
'79     O 键
'80     P 键
'81     Q 键
'82     R 键
'83     S 键
'84     T 键
'85     U 键
'86     V 键
'87     W 键
'88     X 键
'89     Y 键
'90     Z 键

'小键盘中的数字键及符号键
'值  描述
'96 0 键
'97 1 键
'98 2 键
'99 3 键
'100 4 键
'101 5 键
'102 6 键
'103 7 键
'104 8 键
'105 9 键
'106 MULTIPLICATION SIGN (*) 键
'107 PLUS SIGN (+) 键
'108 ENTER 键 ()
'109 MINUS SIGN (-) 键
'110 DECIMAL POINT (.) 键 ( )
'111 DIVISION SIGN (/) 键

'功能键F1-F16
'值   描述
'112 F1 键
'113 F2 键
'114 F3 键
'115 F4 键
'116 F5 键
'117 F6 键
'118 F7 键
'119 F8 键
'120 F9 键
'121 F10 键
'122 F11 键
'123 F12 键
'124 F13 键
'125 F14 键
'126 F15 键
'127 F16 键
'**********************************************************************

'**********************************************************************
'变量、常量、API函数定义区
Option Explicit
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private 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
Private Declare Function RegisterHotKey Lib "User32" (ByVal hwnd As Long, ByVal id As Long, ByVal fskey_Modifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "User32" (ByVal hwnd As Long, ByVal id As Long) As Long

Const WM_HOTKEY = &H312
Const MOD_ALT = &H1
Const MOD_CONTROL = &H2
Const MOD_SHIFT = &H4
Const GWL_WNDPROC = (-4)                     '窗口函数的地址

Dim key_preWinProc As Long                   '用来保存窗口信息
Dim key_Modifiers As Long, key_uVirtKey As Long, key_idHotKey As Long
Dim key_IsWinAddress  As Boolean             '是否取得窗口信息的判断
'**********************************************************************

'**********************************************************************
'此自定义函数用于执行相应热键的操作
Function keyWndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If Msg = WM_HOTKEY Then
    Select Case wParam                       'wParam 值就是 key_idHotKey
                                             '激活几个热键后,这几个热键所对应的操作,大家在其他的程序中，只要修改此处就可以了
      Case 1                                 '第1个热键对应的操作
        frmMain.Visible = Not frmMain.Visible '隐藏和显示窗口
      Case 2
        Unload frmMain                       '退出程序
      Case 3
        frmMain.menPro_Click
      Case 4
        If frmMain.chk1.Value = 0 Then
          frmMain.chk1.Value = 1
        Else
          frmMain.chk1.Value = 0
        End If
    End Select
  End If
  '将消息传送给指定的窗口
  keyWndproc = CallWindowProc(key_preWinProc, hwnd, Msg, wParam, lParam)
End Function
'**********************************************************************

'**********************************************************************
'此自定义函数的功能有二
'功能一：
'    添加热键，如：SetHotkey 1, "Ctrl,112", "Add"
'功能二：
'    删除热键，如：SetHotkey 1, "", "Del"
Function SetHotkey(ByVal KeyId As Long, ByVal KeyAss0 As String, ByVal Action As String)
  Dim KeyAss1 As Long
  Dim KeyAss2 As String
  Dim i As Long
   
  i = InStr(1, KeyAss0, ",")
  If i = 0 Then
    KeyAss1 = Val(KeyAss0)
    KeyAss2 = ""
  Else
    KeyAss1 = Right(KeyAss0, Len(KeyAss0) - i)
    KeyAss2 = Left(KeyAss0, i - 1)
  End If
   
  key_idHotKey = 0
  key_Modifiers = 0
  key_uVirtKey = 0
   
  '判断是否需要取得窗口信息，如果重复取得,再最后恢复窗口时，将会造成程序死掉
  If key_IsWinAddress = False Then
    '记录原来的window程序地址
    key_preWinProc = GetWindowLong(frmMain.hwnd, GWL_WNDPROC)
    '用自定义程序代替原来的window程序
    SetWindowLong frmMain.hwnd, GWL_WNDPROC, AddressOf keyWndproc
  End If

  key_idHotKey = KeyId
  Select Case Action
    Case "Add"
      If KeyAss2 = "Ctrl" Then key_Modifiers = MOD_CONTROL
      If KeyAss2 = "Alt" Then key_Modifiers = MOD_ALT
      If KeyAss2 = "Shift" Then key_Modifiers = MOD_SHIFT
      If KeyAss2 = "Ctrl+Alt" Then key_Modifiers = MOD_CONTROL + MOD_ALT
      If KeyAss2 = "Ctrl+Shift" Then key_Modifiers = MOD_CONTROL + MOD_SHIFT
      If KeyAss2 = "Ctrl+Alt+Shift" Then key_Modifiers = MOD_CONTROL + MOD_ALT + MOD_SHIFT
      If KeyAss2 = "Shift+Alt" Then key_Modifiers = MOD_SHIFT + MOD_ALT
      key_uVirtKey = Val(KeyAss1)
      RegisterHotKey frmMain.hwnd, key_idHotKey, key_Modifiers, key_uVirtKey '向窗口注册系统热键
      key_IsWinAddress = True               '不需要再取得窗口信息
           
    Case "Del"
      SetWindowLong frmMain.hwnd, GWL_WNDPROC, key_preWinProc '恢复窗口信息
      UnregisterHotKey frmMain.hwnd, key_uVirtKey '取消系统热键
      key_IsWinAddress = False              '可以再次取得窗口信息
  End Select
End Function
'**********************************************************************