还是老掉牙的问题:窗口hook问题

一如既往哈 2014-02-13 09:51:26
1、很多窗口使用hook以后可以得到其窗口上的鼠标动作,但有一些窗口hook后会产生一些问题,比如不能输入中文等.......

2、如果使用全局鼠标hook的话,也会有一些问题:比如只有最后的hook有效,这样会影响其他人的使用;

碰到这样的,大侠们都是怎么处理的?
...全文
214 5 打赏 收藏 转发到动态 举报
写回复
用AI写文章
5 条回复
切换为时间正序
请发表友善的回复…
发表回复
一如既往哈 2014-02-17
  • 打赏
  • 举报
回复
看来是老了,大侠都不愿意出手了......... 算了吧,不用他了
bcrun 2014-02-15
  • 打赏
  • 举报
回复
指哪个帖子啊,有啥
一如既往哈 2014-02-15
  • 打赏
  • 举报
回复
不小心翻出了以前的收藏....发现竟然有......
一如既往哈 2014-02-15
  • 打赏
  • 举报
回复
引用 3 楼 bcrun 的回复:
指哪个帖子啊,有啥
原来若干年前就已经收藏过(不知原作者是谁,抱歉啦同时感谢他),只是一直未曾使用过。。。。。。。 这个代码是全局鼠标键盘监控的,而且可以多个实例同时运行。但有一点小小遗憾: 1、不知道怎么获取Mouse_Wheel事件中的WheelData值? 2、不知怎么吃掉消息。
Form1窗体:请添加一个自动换行的Text1
Option Explicit
Private WithEvents Hooker As Hooker
Private Sub Form_Click()
    Text1.Text = ""
End Sub
Private Sub Form_Load()
    Set Hooker = New Hooker
    Hooker.CreateHook
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Hooker.RemoveHook
    Set Hooker = Nothing
End Sub
Private Sub Hooker_KeyUp(KeyCode As Integer, Shift As Integer)
    Text1.Text = Text1.Text & vbCrLf & "Hooker_KeyUp---" & KeyCode & "," & Shift
End Sub
Private Sub Hooker_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Text1.Text = Text1.Text & vbCrLf & "Hooker_MouseDown--" & Button & "," & Shift & "," & X & "," & Y
End Sub
Private Sub Hooker_MouseWheel(WheelDeta As Long)
    Text1.Text = Text1.Text & vbCrLf & "Hooker_MouseWheel--" & WheelDeta
End Sub

Module1代码:
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
Public 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&
    Call 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 MouseWheel(WheelDeta As Long) ''怎么弄这个?
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, lRet As Long
    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_MOUSEWHEEL
            RaiseEvent MouseWheel(EMSG.lParamL) ''这个WheelData怎么获取?
        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


大侠们给看看,怎么在原代码的基础上完善一下,添加以下2项功能,可以方便大家使用!! 1、找出WheelData,完善Mouse_Wheel事件; 2、在事件代码中添加一个开关,在有必要的时候吃掉某个消息。比如在窗体中:

Private Sub Hooker_MouseWheel(WheelDeta As Long,iRet as Long)
    Text1.Text = Text1.Text & vbCrLf & "Hooker_MouseWheel--" & WheelDeta
    iRet=-1 ''当iRet=-1或其它值时会吃掉这个消息
End Sub

赵4老师 2014-02-14
  • 打赏
  • 举报
回复

1,485

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧