很久以前用匯編寫過這樣的程序，上周在“你問我答“上有網友說，這樣的程序在VC和DELPHI上的例子很多，但是在VB上的例子很少，希望能整理一份出來。網友的要求啟能不答應呢？

要實現全系統的鍵盤消息的攔截是需要一個DLL文件的，這個DLL文件我們還是用以前做的那個好啦（做了一點更改，具體更改可以見源代碼）。

在VB中實現HOOK鍵盤與在其它的語言中的原理是一樣的，就讓我們看看具體的代碼吧：

===========================================================================
FORM1中的代碼：

　Option Explicit

　Private Sub Command1_Click()
　　　vAboutHook
　End Sub

　Private Sub Form_Load()
　　On Error GoTo Exit_Label
　　'------------------------------------------ 出錯退出
　　　InstallHook Me.hWnd, WM_KEYBOARD
　　　'------------------------------------------ 安裝鉤子
　　　PrevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
　　　'------------------------------------------ 保存原窗口函數地址
　　　SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
　　　'------------------------------------------ 設置新的窗口函數地址
　　　Exit Sub
　　Exit_Label:
　　　MsgBox "出錯！"
　　　'------------------------------------------ 出錯退出
　End Sub

　Private Sub Form_Unload(Cancel As Integer)
　　UninstallHook
　　'------------------------------------------ 卸載鉤子
　　SetWindowLong Me.hWnd, GWL_WNDPROC, PrevWndProc
　　'------------------------------------------ 恢復原窗口函數地址
　End Sub
===========================================================================
建立一個模塊(.bas)代碼：
　Option Explicit

　Public Const GWL_WNDPROC = (-4)
　Public Const WM_KEYBOARD = &H400 + 12

　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
　Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd 
　As Long, ByVal nIndex As Long) As Long
　Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd 
　As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

　Declare Function InstallHook Lib "Dkey" (ByVal hWnd As Long, ByVal Msg As Long) 
　As Long
　Declare Function UninstallHook Lib "Dkey" () As Long
　Declare Function vAboutHook Lib "Dkey" () As Long

　Public PrevWndProc As Long
　'------------------------------------------ 相關聲明

　Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, 
　ByVal lParam As Long) As Long
　　If Msg = WM_KEYBOARD Then
　　'------------------------------------------ 是我們定義的消息就執行下面的語句
　　　Form1.List1.AddItem "所按字符=" & Chr(wParam) & ", 狀態=" & Hex(lParam)
　　　'----- 顯示字符及狀態 wParam顯示按鍵碼 lParam顯示按鍵狀態如keydown or keyup
　　　Form1.List1.ListIndex = Form1.List1.NewIndex
　　End If
　　WndProc = CallWindowProc(PrevWndProc, hWnd, Msg, wParam, lParam)
　　'------------------------------------------ 回調原函數
　End Function

===========================================================================

好了，就這么多。是不是很簡單呀？