Question

VB 编程高手进

请各位高手贴出 消息钩子的代码和SETWINDOWSHOOKEX函数的参数解释 ，谢谢

Answer 1

HHOOK SetWindowsHookEx(
int idHook, //要安装的钩子类型 (参考下面的IdHook取值)
HOOKPROC lpfn, //钩子过程的指针 ,也即拦截到指定系统消息后的预处理过程,须定义在DLL中,
HINSTANCE hMod, //应用程序实例的句柄 如果是全局钩子， hInstance是DLL句柄（DllMain中给的模块地址。就是包含HookProc的动态库加载地址。否则给0就可以了，即勾自己。
DWORD dwThreadId; //要安装钩子的线程ID ,指定被监视的线程，如果明确指定了某个线程的ID就只监视该线程，此时的钩子即为线程钩子；如果该参数被设置为0，则表示此钩子为监视系统所有线程的全局钩子。);

其中idHook参数可以取如下常量：
WH_CALLWNDPROC //窗口钩子，当系统向目标窗口发送消息时将触发此钩子
WH_CALLWNDPROCRET //窗口钩子，当窗口处理完消息后将触发此钩子
WH_CBT //当Windows激活、产生、释放（关闭）、最小化、最大化或改变窗口时都将触发此事件
WH_DEBUG //调试钩子
WH_GETMESSAGE //当往消息队列中增加一个消息时将触发此钩子
WH_JOURNALPLAYBACK //回放钩子，可以用于播放已记录的鼠标和键盘的操作
WH_JOURNALRECORD //记录钩子，可以用于记录鼠标和键盘的操作，木马程序可以使用此钩子窃取受控方在屏幕中敲入的密码
WH_KEYBOARD //当敲击键盘时将触发此钩子
WH_MOUSE //当有鼠标操作时将触发此钩子
WH_MSGFILTER //消息过滤钩子
WH_SHELL //Shell钩子
WH_SYSMSGFILTER //系统消息过滤钩子

使用WH_CBT系统级钩子，当Windows激活、产生、释放（关闭）、最小化、最大化或改变窗口时都将触发此事件，我们在自定义消息函数中只处理关闭窗口的消息，在自定义的钩子函数若返回0则允许对窗体的操作，返回1则阻止窗口最大化、最小化等操作。另外此钩子必须使用动态链接库（dll）也就是钩子函数必须写在DLL里。

Answer 2

VB6实现键盘鼠标全局Hook

标准模块(mHook)：
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_CANCELJOURNAL = &H4B

Private Type POINTAPI
x As Long
y As Long
End Type

Private Type TMSG
hwnd As Long
Message As Long
wParam As Long
lParam As Long
Time As Long
PT As POINTAPI
End Type

Public hJouHook As Long, hAppHook As Long, lpHooker As Long

Public Function JouHookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If nCode < 0 Then
JouHookProc = CallNextHookEx(hJouHook, nCode, wParam, lParam)
Exit Function
End If

Call CallEvent(lpHooker, lParam)
Call CallNextHookEx(hJouHook, nCode, wParam, lParam)
End Function

Public Function AppHookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If nCode < 0 Then
AppHookProc = CallNextHookEx(hAppHook, nCode, wParam, lParam)
Exit Function
End If

Dim msg As TMSG
CopyMemory msg, ByVal lParam, Len(msg)

Select Case msg.Message
Case WM_CANCELJOURNAL
If wParam = 1 Then Call CallEvent(lpHooker, WM_CANCELJOURNAL)
End Select
Call CallNextHookEx(hAppHook, nCode, wParam, ByVal lParam)
End Function

Private Sub CallEvent(ByVal lpObj As Long, ByVal lParam As Long)
Dim Hooker As Hooker
CopyMemory Hooker, lpObj, 4&
Hooker.CallEvent lParam
CopyMemory Hooker, 0&, 4&
End Sub

类模块(Hooker)：
Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private 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
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Const WH_JOURNALRECORD = &H0
Private Const WH_GETMESSAGE = &H3
Private Const WM_CANCELJOURNAL = &H4B

Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_SYSTEMKEYDOWN = &H104
Private Const WM_SYSTEMKEYUP = &H105

Private Type EVENTMSG
wMsg As Long
lParamL As Long
lParamH As Long
msgTime As Long
hWndMsg As Long
End Type

Private EMSG As EVENTMSG

Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event SysKeyDown(KeyCode As Integer)
Public Event SysKeyUp(KeyCode As Integer)

Public Sub CreateHook()
If hJouHook = 0 Then hJouHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf JouHookProc, App.hInstance, 0)
If hAppHook = 0 Then hAppHook = SetWindowsHookEx(WH_GETMESSAGE, AddressOf AppHookProc, App.hInstance, App.ThreadID)
End Sub

Public Property Get HookState() As Boolean
If hAppHook = 0 Then
HookState = False
Else
HookState = True
End If
End Property

Public Sub RemoveHook()
UnhookWindowsHookEx hAppHook: hAppHook = 0
UnhookWindowsHookEx hJouHook: hJouHook = 0
End Sub

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

Private Sub Class_Terminate()
If hJouHook Or hAppHook Then RemoveHook
End Sub

Friend Sub CallEvent(ByVal lParam As Long)
Dim i As Integer, j As Integer, K As Integer, s As String

If lParam = WM_CANCELJOURNAL Then
hJouHook = 0: CreateHook
Exit Sub
End If

CopyMemory EMSG, ByVal lParam, Len(EMSG)

Select Case EMSG.wMsg
Case WM_KEYDOWN
If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1)
If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2)
If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4)

s = Hex(EMSG.lParamL)
K = (EMSG.lParamL And &HFF)

RaiseEvent KeyDown(K, j)

s = Left$(s, 2) & Right$("00" & Hex(K), 2)
EMSG.lParamL = CLng("&h" & s)
CopyMemory ByVal lParam, EMSG, Len(EMSG)

Case WM_KEYUP
If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1)
If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2)
If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4)
s = Hex(EMSG.lParamL)
K = (EMSG.lParamL And &HFF)

RaiseEvent KeyUp(K, j)

s = Left$(s, 2) & Right$("00" & Hex(K), 2)
EMSG.lParamL = CLng("&h" & s)
CopyMemory ByVal lParam, EMSG, Len(EMSG)

Case WM_MOUSEMOVE
If GetAsyncKeyState(vbKeyLButton) Then i = (i Or 1)
If GetAsyncKeyState(vbKeyRButton) Then i = (i Or 2)
If GetAsyncKeyState(vbKeyMButton) Then i = (i Or 4)
If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1)
If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2)
If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4)

RaiseEvent MouseMove(i, j, CSng(EMSG.lParamL), CSng(EMSG.lParamH))

Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN
If GetAsyncKeyState(vbKeyShift) Then i = (i Or 1)
If GetAsyncKeyState(vbKeyControl) Then i = (i Or 2)
If GetAsyncKeyState(vbKeyMenu) Then i = (i Or 4)

RaiseEvent MouseDown(2 ^ ((EMSG.wMsg - 513) / 3), i, CSng(EMSG.lParamL), CSng(EMSG.lParamH))

Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP
If GetAsyncKeyState(vbKeyShift) Then i = (i Or 1)
If GetAsyncKeyState(vbKeyControl) Then i = (i Or 2)
If GetAsyncKeyState(vbKeyMenu) Then i = (i Or 4)

RaiseEvent MouseUp(2 ^ ((EMSG.wMsg - 514) / 3), i, CSng(EMSG.lParamL), CSng(EMSG.lParamH))

Case WM_SYSTEMKEYDOWN
s = Hex(EMSG.lParamL)
K = (EMSG.lParamL And &HFF)

If K <> vbKeyMenu Then RaiseEvent SysKeyDown(K)

s = Left$(s, 2) & Right$("00" & Hex(K), 2)
EMSG.lParamL = CLng("&h" & s)
CopyMemory ByVal lParam, EMSG, Len(EMSG)

Case WM_SYSTEMKEYUP
s = Hex(EMSG.lParamL)
K = (EMSG.lParamL And &HFF)

If K <> vbKeyMenu Then RaiseEvent SysKeyUp(K)

s = Left$(s, 2) & Right$("00" & Hex(K), 2)
EMSG.lParamL = CLng("&h" & s)
CopyMemory ByVal lParam, EMSG, Len(EMSG)

Case Else
End Select
End Sub