vb_hook.txt

此例为VB编写的HOOK程序原码

　
很久以前用汇编写过这样的程序，上周在“你问我答“上有网友说，这样的程序在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

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

好了，就这么多。是不是很简单呀？