bashook.bas

在介面没有得到焦点的情况下

Attribute VB_Name = "basHook"
Option Explicit

'.bas模块中
Public g_hHook 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 InstallHooks() As Boolean
On Error GoTo HaveErr:

  g_hHook = SetWindowsHookEx(WH_KEYBOARD_LL, _
                                   AddressOf LowLevelKeyboardProc, _
                                   App.hInstance, _
                                   0&)
    
Exit Function
HaveErr:
    InstallHooks = False
    frm.CallPhone_MessageEvent (Err.Description & Err.Number)
End Function


Public Function UnInstallHooks()
On Error GoTo HaveErr:
    If Not g_hHook = 0 Then
        UnhookWindowsHookEx g_hHook
    End If
Exit Function
HaveErr:
    frm.CallPhone_MessageEvent (Err.Description & Err.Number)
End Function


  
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 33                          '//page up
                frm.CmdReady_Click
            Case 34                             '//pagedown
                frm.CmdOut_Click
            Case 107                                 '// 按“＋”号接电话
                Call frm.Frm_WindowTopHold          '//一直保持在最前面
                If frm.M_bln_NewCall = True Then    '//有新的来电才触发事件
                    Call frm.SendData(P_UserDefined_Agent.Speak)     '//发出请求
                    Call frm.Frm_Place
                End If
            Case 109                                 '// 按“-”号挂电话
                Call frm.Frm_WindowTopHold          '//一直保持在最前面
                If frm.M_LngTimeEvery > 0 Then      '//有会话状态才有用
                    Call frm.SendData(P_UserDefined_Agent.Hang)
                End If
            Case 192                '// '//隐藏  按键 ="~"
                Call frm.Frm_Place
            Case Else
         End Select
         
      End If
      
   End If  'nCode = HC_ACTION
  
   LowLevelKeyboardProc = CallNextHookEx(g_hHook, _
                                         nCode, _
                                         wParam, _
                                         lParam)
  
End Function