xin3721网络学院为广大学员，准备了丰富了教学视频。相关视频教程地址为：vb.net教程
本例相关代码下载 ： 代码下载
运行效果图：
相关代码：
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports uWindows.ConstDefine
Imports uWindows.SafeNativeMethods
Namespace uWindows
Public Class MouseHook
Public Event OnMouseActivity As MouseEventHandler
Private hMouseHook As Integer = 0
Private MouseHookProcedure As HookProc
Private ThreadHook As Boolean = True
Public Sub New()
Call Start()
End Sub
Public Sub New(ByVal mThreadHook As Boolean)
ThreadHook = mThreadHook
Call Start()
End Sub
Protected Overrides Sub Finalize()
Try
[Stop]()
Finally
MyBase.Finalize()
End Try
End Sub
Private Sub Start()
MouseHookProcedure = New uWindows.SafeNativeMethods.HookProc(AddressOf Me.MouseHookProc)
If ThreadHook Then '线程钩子
hMouseHook = SetWindowsHookEx(uWindows.ConstDefine.HookType.WH_MOUSE, _
MouseHookProcedure, _
GetModuleHandle(Process.GetCurrentProcess().MainModule.ModuleName), _
GetCurrentThreadId)
Else '系统钩子
hMouseHook = SetWindowsHookEx(uWindows.ConstDefine.HookType.WH_MOUSE_LL, _
MouseHookProcedure, _
GetModuleHandle(Process.GetCurrentProcess().MainModule.ModuleName), _
0)
End If
If (hMouseHook = 0) Then
[Stop]()
Throw New Exception("SetWindowsHookEx is failed in MouseHook.")
End If
End Sub
Public Sub [Stop]()
Dim retMouse As Boolean = True
If hMouseHook <> 0 Then
retMouse = UnhookWindowsHookEx(hMouseHook)
hMouseHook = 0
End If
If Not retMouse Then Throw New Exception("UnhookWindowsHookEx failed in MouseHook.")
End Sub
Private Function MouseHookProc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
If nCode >= 0 Then
Dim button As MouseButtons = MouseButtons.None
Select Case wParam
Case WM_LBUTTONDOWN
button = MouseButtons.Left
Case WM_RBUTTONDOWN
button = MouseButtons.Right
Case WM_MOUSEWHEEL
End Select
Dim clickCount As Integer = 0
If Not button = MouseButtons.None Then
If wParam = WM_LBUTTONDBLCLK OrElse wParam = WM_RBUTTONDBLCLK Then
clickCount = 2
Else
clickCount = 1
End If
End If
Dim MyMouseHookStruct As MouseLLHookStruct
MyMouseHookStruct = CType(Marshal.PtrToStructure(lParam, GetType(MouseLLHookStruct)), MouseLLHookStruct)
Dim e As MouseEventArgs = New MouseEventArgs(button, _
clickCount, _
MyMouseHookStruct.pt.x, _
MyMouseHookStruct.pt.y, _
MyMouseHookStruct.mouseData)
RaiseEvent OnMouseActivity(Me, e)
End If
Return CallNextHookEx(hMouseHook, nCode, wParam, lParam)
End Function
End Class
End Namespace
------------------------------------------------------------
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports uWindows.ConstDefine
Imports uWindows.SafeNativeMethods
Namespace uWindows
Public Class KeyboardHook
Public Event KeyDown As KeyEventHandler
Public Event KeyPress As KeyPressEventHandler
Public Event KeyUp As KeyEventHandler
Private hKeyboardHook As Integer = 0
Private KeyboardHookProcedure As SafeNativeMethods.HookProc
Private ThreadHook As Boolean = True
Public Sub New()
Call Start()
End Sub
Public Sub New(ByVal mThreadHook As Boolean)
ThreadHook = mThreadHook
Call Start()
End Sub
Protected Overrides Sub Finalize()
Try
[Stop]()
Finally
MyBase.Finalize()
End Try
End Sub
Private Sub Start()
If (hKeyboardHook = 0) Then
KeyboardHookProcedure = New HookProc(AddressOf KeyboardHookProc)
If ThreadHook Then '线程钩子
hKeyboardHook = SetWindowsHookEx(uWindows.ConstDefine.HookType.WH_KEYBOARD, _
KeyboardHookProcedure, _
GetModuleHandle(Process.GetCurrentProcess().MainModule.ModuleName), _
GetCurrentThreadId)
Else '系统钩子()
hKeyboardHook = SetWindowsHookEx(uWindows.ConstDefine.HookType.WH_KEYBOARD_LL, _
KeyboardHookProcedure, _
GetModuleHandle(Process.GetCurrentProcess().MainModule.ModuleName), _
0)
End If
If (hKeyboardHook = 0) Then
[Stop]()
Throw New Exception("SetWindowsHookEx is failed in KeyboardHook.")
End If
End If
End Sub
Public Sub [Stop]()
Dim retKeyboard As Boolean = True
If hKeyboardHook <> 0 Then
retKeyboard = UnhookWindowsHookEx(hKeyboardHook)
hKeyboardHook = 0
End If
If Not retKeyboard Then Throw New Exception("UnhookWindowsHookEx failed.")
End Sub
Private Function KeyboardHookProc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
If nCode >= 0 Then
If ThreadHook Then
'我们从右向左数，假设最右边那位为第0位，最左边的就是第31位，那么该参数的的0-15位表示键的发送次数等扩展信息，
'16-23位为按键的扫描码，24-31位表示是按下键还是释放键。
If lParam.ToInt32 > 0 Then
RaiseEvent KeyDown(Me, New KeyEventArgs(CType(wParam, Keys)))
Else
RaiseEvent KeyUp(Me, New KeyEventArgs(CType(wParam, Keys)))
End If
Else
Dim MyKeyboardHookStruct As KeyboardHookStruct
MyKeyboardHookStruct = CType(Marshal.PtrToStructure(lParam, GetType(KeyboardHookStruct)), KeyboardHookStruct)
If wParam = WM_KEYDOWN OrElse wParam = WM_SYSKEYDOWN Then
Dim keyData As Keys = CType(MyKeyboardHookStruct.vkCode, Keys)
Dim e As New KeyEventArgs(keyData)
RaiseEvent KeyDown(Me, e)
End If
If wParam = WM_KEYDOWN Then
Dim keyState As Byte() = New Byte(256 - 1) {}
Call GetKeyboardState(keyState)
Dim inBuffer As Byte() = New Byte(2 - 1) {}
If ToAscii(MyKeyboardHookStruct.vkCode, _
MyKeyboardHookStruct.scanCode, _
keyState, _
inBuffer, _
MyKeyboardHookStruct.flags) = 1 Then
Dim e As KeyPressEventArgs = New KeyPressEventArgs(System.Convert.ToChar(inBuffer(0)))
RaiseEvent KeyPress(Me, e)
End If
End If
If wParam = WM_KEYUP OrElse wParam = WM_SYSKEYUP Then
Dim keyData As Keys = CType(MyKeyboardHookStruct.vkCode, Keys)
Dim e As KeyEventArgs = New KeyEventArgs(keyData)
RaiseEvent KeyUp(Me, e)
End If
End If
End If
Return CallNextHookEx(hKeyboardHook, nCode, wParam, lParam)
End Function
End Class
End Namespace
--------------------------------------------------------------------
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports uWindows.ConstDefine
Imports uWindows.SafeNativeMethods
Namespace uWindows
Public Class FormHook
Private hFormHook As Integer = 0
Private FormHookProcedure As HookProc
Public Sub New()
Start()
End Sub
Protected Overrides Sub Finalize()
Try
[Stop]()
Finally
MyBase.Finalize()
End Try
End Sub
Private Sub Start()
FormHookProcedure = New uWindows.SafeNativeMethods.HookProc(AddressOf Me.FormHookProc)
hFormHook = SetWindowsHookEx(uWindows.ConstDefine.HookType.WH_CALLWNDPROC, _
FormHookProcedure, _
GetModuleHandle(Process.GetCurrentProcess().MainModule.ModuleName), _
GetCurrentThreadId)
If (hFormHook = 0) Then
[Stop]()
Throw New Exception("SetWindowsHookEx is failed in FormHook.")
End If
End Sub
Public Sub [Stop]()
Dim retForm As Boolean = True
If hFormHook <> 0 Then
retForm = UnhookWindowsHookEx(hFormHook)
hFormHook = 0
End If
If Not retForm Then Throw New Exception("UnhookWindowsHookEx failed in FormHook.")
End Sub
Private Function FormHookProc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
If nCode = HC_ACTION Then
Dim MyHookStruct As CWPSTRUCT
MyHookStruct = CType(Marshal.PtrToStructure(lParam, GetType(CWPSTRUCT)), CWPSTRUCT)
Select Case MyHookStruct.message
Case &H85, &H86 '绘制非客户区
Dim hdc As IntPtr = GetWindowDC(MyHookStruct.hwnd)
Dim g As Graphics = Graphics.FromHdc(hdc)
g.DrawString("Test-->Test-->Test-->Test", New Font("宋体", 20), Brushes.Blue, 0, -10)
ReleaseDC(MyHookStruct.hwnd, hdc) : g.Dispose()
Case Else
Return CallNextHookEx(hFormHook, nCode, wParam, lParam)
End Select
Return 1
End If
Return CallNextHookEx(hFormHook, nCode, wParam, lParam)
End Function
Public Declare Auto Function GetWindowDC Lib "user32.dll" (ByVal hWnd As IntPtr) As IntPtr
Public Declare Auto Function ReleaseDC Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal hdc As IntPtr) As IntPtr
End Class
End Namespace
------------------------------------------------------------
Namespace uWindows
Public Module ConstDefine
Public Enum HookType
WH_CALLWNDPROC = 4
WH_CALLWNDPROCRET = 12
WH_CBT = 5
WH_DEBUG = 9
WH_FOREGROUNDIDLE = 11
WH_GETMESSAGE = 3
WH_HARDWARE = 8
WH_JOURNALPLAYBACK = 1
WH_JOURNALRECORD = 0
WH_KEYBOARD = 2
WH_MOUSE = 7
WH_MSGFILTER = (-1)
WH_SHELL = 10
WH_SYSMSGFILTER = 6
WH_KEYBOARD_LL = 13
WH_MOUSE_LL = 14
End Enum
Public Const WM_MOUSEMOVE As Integer = &H200
Public Const WM_LBUTTONDOWN As Integer = &H201
Public Const WM_LBUTTONUP As Integer = &H202
Public Const WM_LBUTTONDBLCLK As Integer = &H203
Public Const WM_RBUTTONDOWN As Integer = &H204
Public Const WM_RBUTTONUP As Integer = &H205
Public Const WM_RBUTTONDBLCLK As Integer = &H206
Public Const WM_MBUTTONDOWN As Integer = &H207
Public Const WM_MBUTTONUP As Integer = &H208
Public Const WM_MBUTTONDBLCLK As Integer = &H209
Public Const WM_MOUSEWHEEL As Integer = &H20A
Public Const WM_KEYDOWN As Integer = &H100
Public Const WM_KEYUP As Integer = &H101
Public Const WM_SYSKEYDOWN As Integer = &H104
Public Const WM_SYSKEYUP As Integer = &H105
Public Const WM_NCMOUSEMOVE = &HA0
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const WM_NCLBUTTONUP = &HA2
Public Const WM_NCLBUTTONDBLCLK = &HA3
Public Const WM_NCRBUTTONDOWN = &HA4
Public Const WM_NCRBUTTONUP = &HA5
Public Const WM_NCRBUTTONDBLCLK = &HA6
Public Const WM_NCMBUTTONDOWN = &HA7
Public Const WM_NCMBUTTONUP = &HA8
Public Const WM_NCMBUTTONDBLCLK = &HA9
Public Const WM_NCXBUTTONDOWN = &HAB
Public Const WM_NCXBUTTONUP = &HAC
Public Const WM_NCXBUTTONDBLCLK = &HAD
Public Const VK_XBUTTON1 = &H5
Public Const VK_XBUTTON2 = &H6
Public Const HC_ACTION = 0
Public Const HC_NOREMOVE = 3
End Module
End Namespace
--------------------------------------------------------
Imports System.Runtime.InteropServices
Namespace uWindows
Friend Class SafeNativeMethods
'钩子处理过程
Public Delegate Function HookProc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
Public Structure CWPSTRUCT
Public lparam As IntPtr
Public wparam As IntPtr
Public message As Integer
Public hwnd As IntPtr
End Structure
'点
Public Class POINT
Public x As Integer
Public y As Integer
End Class
'鼠标消息结构
Public Class MouseHookStruct
Public pt As POINT
Public hWnd As Integer
Public wHitTestCode As Integer
Public dwExtraInfo As Integer
End Class
Public Class MouseLLHookStruct
Public pt As POINT
Public mouseData As Integer
Public flags As Integer
Public time As Integer
Public dwExtraInfo As Integer
End Class
'键盘消息结构
Public Class KeyboardHookStruct
Public vkCode As Integer '1到254间的虚似键盘码
Public scanCode As Integer '扫描码
Public flags As Integer
Public time As Integer
Public dwExtraInfo As Integer
End Class
'安装钩子
Public Shared Function SetWindowsHookEx(ByVal idHook As Integer, ByVal lpfn As HookProc, ByVal hInstance As IntPtr, ByVal threadId As Integer) As Integer
End Function
'卸载钩子
Public Shared Function UnhookWindowsHookEx(ByVal idHook As Integer) As Boolean
End Function
'处理下一个消息
Public Shared Function CallNextHookEx(ByVal idHook As Integer, ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
End Function
Public Shared Function ToAscii(ByVal uVirtKey As Integer, ByVal uScanCode As Integer, ByVal lpbKeyState As Byte(), ByVal lpwTransKey As Byte(), ByVal fuState As Integer) As Integer
End Function
Public Shared Function GetKeyboardState(ByVal pbKeyState As Byte()) As Integer
End Function
Public Declare Function GetKeyState Lib "user32" Alias "GetKeyState" (ByVal nVirtKey As Integer) As Integer
Public Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal ModuleName As String) As IntPtr
Public Overloads Shared Function GetCurrentThreadId() As Integer
End Function
End Class
End Namespace
------------------------------------------------------
Public Class frmHook
Dim WithEvents MyKeyBoardHook As uWindows.KeyboardHook
Dim WithEvents MyMouseHook As uWindows.MouseHook
'Dim WithEvents MyFormHook As uWindows.FormHook
Private Sub frmHook_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
Call btnStop_Click(Nothing, Nothing)
End Sub
Private Sub frmHook_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Try
MyKeyBoardHook = New uWindows.KeyboardHook(False)
MyMouseHook = New uWindows.MouseHook(False)
'MyFormHook = New uWindows.FormHook
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Error")
End Try
End Sub
Private Sub btnStop_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnStop.Click
Try
If MyKeyBoardHook IsNot Nothing Then MyKeyBoardHook.Stop()
If MyMouseHook IsNot Nothing Then MyMouseHook.Stop()
'If MyFormHook IsNot Nothing Then MyFormHook.Stop()
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Error")
End Try
End Sub
Private Sub LogWrite(ByVal txt As String)
txtLog.AppendText(txt + Environment.NewLine)
txtLog.SelectionStart = txtLog.Text.Length
End Sub
Private Sub MyKeyboardHook_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyKeyBoardHook.KeyDown
LogWrite("KeyDown - " + e.KeyData.ToString())
End Sub
Private Sub MyKeyboardHook_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles MyKeyBoardHook.KeyPress
LogWrite("KeyPress - " + e.KeyChar)
End Sub
Private Sub MyKeyboardHook_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyKeyBoardHook.KeyUp
LogWrite("KeyUp - " + e.KeyData.ToString())
End Sub
Private Sub MyMouseHook_OnMouseActivity(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyMouseHook.OnMouseActivity
lblMousePosition.Text = String.Format("x={0} y={1} wheel={2}", e.X, e.Y, e.Delta)
If (e.Clicks > 0) Then LogWrite("MouseButton - " + e.Button.ToString())
End Sub
End Class