看起來可能讓你眼暈，但是只要你懂得VB知識，又想要這個東西的話，那你就得潛心研究一下了 

modHook.bas

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 Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)


Public Datas() As String
Public NUM 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

ClsHook.cls

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_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
Dim IntCode As Integer

CopyMemory Msg, ByVal lparam, Len(Msg)

IntShift = 0
    Select Case Msg.wMsg
       Case WM_KEYDOWN
          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
          Debug.Print Msg.lParamLow
          Debug.Print &HFF
          RaiseEvent KeyDown(IntCode, IntShift)
    End Select
End Function

Private Sub Class_Initialize()
LngClsPtr = ObjPtr(Me)
End Sub

form1.frm

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 Hook_KeyDown(KeyCode As Integer, Shift As Integer)
Dim StrCode As String

    StrCode = CodeToString(KeyCode)

     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 = "[Shift] + " & StrCode
       If Shift = vbCtrlMask Then StrCode = "[Ctrl] + " & StrCode
       If Shift = vbAltMask Then StrCode = "[Alt] + " & StrCode
       If Shift = vbAltMask + vbCtrlMask Then StrCode = "[Alt + Ctrl] + " & StrCode
       If Shift = vbAltMask + vbShiftMask Then StrCode = "[Alt + Shift] + " & StrCode
       If Shift = vbCtrlMask + vbShiftMask Then StrCode = "[Ctrl + Shift] + " & StrCode
       If Shift = vbCtrlMask + vbShiftMask + vbAltMask Then StrCode = "[Ctrl + Shift +Alt] + " & StrCode
     End If

     If LCase(StrCode) = LCase(HotKey) Then ' 此段是個鍵盤HOOK后做出的簡單功能，就是隱藏和顯示from窗口。
         If App.TaskVisible = False Then
             Me.Show
             App.TaskVisible = True
         Else
             Me.Hide
             App.TaskVisible = False
         End If
     End If

End Sub

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)))) & Str(MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))))
      End Select
    CodeToString = "[" & StrKey & "]"
End Function