VB6 WH_GETMESSAGE消息钩子

时间:2013-04-02 04:54:43

标签: vb6 hook

你好朋友,我想监视一个IP地址控件(由CreateWindowEx创建)输入事件,它在form.i上使用API​​ SetWindowsHookEx挂钩WH_GETMESSAGE消息,但现在我不能把输入消息当作(MSG) lParam-> message = WM_NULL就像在C中一样,所以我需要你的帮助,朋友们。你能给我解决方案吗?

这是代码:

Private Function GetMsgProc(ByVal nCode As Long, ByVal wParam As Long, ByRef lParam As Long) As Long
CopyMemory p, ByVal lParam, LenB(p)
If p.message = WM_RBUTTONDOWN And GetParent(p.hWnd) = lngHWNDCtl Then
    GetMsgProc = 0
Else
    GetMsgProc = CallNextHookEx(hHook, nCode, wParam, ByVal lParam)
End If
End Function

Public Sub SetHook(ByVal lngThread As Long, lngHWND As Long, bFlag As Boolean)
If bFlag Then
    lngHWNDCtl = lngHWND
    hHook = SetWindowsHookEx(WH_GETMESSAGE, AddressOf GetMsgProc, 0, lngThread)
Else
   If hHook Then UnhookWindowsHookEx hHook
End If
End Sub

1 个答案:

答案 0 :(得分:2)

  1. CallNextHookEx过滤功能中跳过GetMsgProc的来电通常是一个坏主意。如果这样做,则不会调用链中的其他过滤器函数。也许,开发机器上没有,但“在野外”会有其他应用程序安装钩子。如果您阻止调用过滤器函数,那些应用程序将会出错。
  2. 您可能不希望分析仅从队列中偷看但未从队列中删除的消息。对于已从队列中删除的邮件,使用GetMsgProc调用wParam = PM_REMOVE
  3. VB6或C ++或者其他什么,忽略API的MSDN规范是一种致命的做法。这就是GetMsgProc过滤函数应该根据第一个参数的值做出决定的方式:

      

    代码 [in]

         

    指定挂钩过程是否必须处理   信息。如果代码是HC_ACTION,则钩子过程必须处理   信息。如果代码小于零,则钩子过程必须通过   消息到CallNextHookEx函数,无需进一步处理和   应该返回CallNextHookEx返回的值。

         

    http://msdn.microsoft.com/en-us/library/windows/desktop/ms644981%28v=vs.85%29.aspx

    虽然CopyMemory应该有效(假设您正确声明),但我不打扰它。将过滤函数的第三个参数声明为ByRef lParam As MSG

  4. 是完全可以的

    以下是应放在标准模块中的代码(与安装挂钩的任何其他代码一样)。如果我使用它来嗅探WM_RBUTTONDOWN消息,比如放置在主表单上的TextBox控件,它对我有用。

    Option Explicit
    
    'http://msdn.microsoft.com/en-us/library/windows/desktop/dd162805%28v=vs.85%29.aspx
    Private Type tagPOINT
        x As Long
        y As Long
    End Type
    
    'http://msdn.microsoft.com/en-us/library/windows/desktop/ms644958%28v=vs.85%29.aspx
    Private Type MSG
        hWnd    As Long
        message As Long
        wParam  As Long
        lParam  As Long
        time    As Long
        pt      As tagPOINT
    End Type
    
    Private bHooked      As Boolean
    Private hHook        As Long
    Private hHwndToSniff As Long
    
    Private Const HC_Action As Long = &H0
    
    Private Const PM_NOREMOVE   As Long = &H0
    Private Const PM_REMOVE     As Long = &H1
    
    Private Const WH_GETMESSAGE     As Long = &H3
    Private Const WM_RBUTTONDOWN    As Long = &H204
    
    'http://msdn.microsoft.com/en-us/library/windows/desktop/ms644974%28v=vs.85%29.aspx
    Private Declare Function CallNextHookEx Lib "user32" _
        (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    
    'http://msdn.microsoft.com/en-us/library/windows/desktop/ms644990%28v=vs.85%29.aspx
    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
    
    'http://msdn.microsoft.com/en-us/library/windows/desktop/ms644993%28v=vs.85%29.aspx
    Private Declare Function UnhookWindowsHookEx Lib "user32" _
        (ByVal hHook As Long) As Long
    
    Public Sub RemoveHook()
        If bHooked Then 
            UnhookWindowsHookEx hHook
            bHooked = False
        End If
    End Sub
    
    Public Sub SetHook(ByVal hThreadToHook As Long, hHwndFilter As Long)
        If Not bHooked Then
            hHook = SetWindowsHookEx(WH_GETMESSAGE, AddressOf GetMsgProc, 0, hThreadToHook)
            If hHook > 0 Then
                bHooked = True
                hHwndToSniff = hHwndFilter
            Else
                Debug.Assert False
            End If
        End If
    End Sub
    
    'http://msdn.microsoft.com/en-us/library/windows/desktop/ms644981%28v=vs.85%29.aspx
    Private Function GetMsgProc(ByVal uCode As Long _
        , ByVal wParam As Long _
        , ByRef lParam As MSG) As Long
        If uCode = 0 Then
            If wParam = PM_REMOVE Then
                If lParam.message = WM_RBUTTONDOWN Then
                    If lParam.hWnd = hHwndToSniff Then
                        MsgBox "You right-clicked a text box!"
                    End If
                End If
            End If
        End If
    
        GetMsgProc = CallNextHookEx(hHook, uCode, wParam, lParam)
    End Function
    

    挂钩以下列方式安装在表单模块中:

    SetHook App.ThreadID, Me.Text1.hWnd