一段源码修改一下，鼠标和键盘钩子

Question

源码见地址http://hi.baidu.com/pylzj/blog/item/8830d75432162c5fd1090617.html这段源码唯一的缺点就是，不能区别开鼠标滚轮向上或向下滚动那位高手修改一下，可以区别鼠标滚轮向上或向下滚动最后70分了，谢谢、、、

Answer 1

把callmousehookproc函数修改成这个样子'鼠标钩子
Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
     Dim pt As POINTAPI     If code = HC_ACTION Then
       CopyMemory MouseMsg, lParam, LenB(MouseMsg)
      
       Form1.txtMsg(1).Text = "X=" + Str(MouseMsg.X) + " Y=" + Str(MouseMsg.Y)
       Form1.txtHwnd(1) = Format(wParam, "0")      
       If wParam = WM_MBUTTONDOWN Then                       '把中键改为左键
            mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
            CallMouseHookProc = 1
       End If
      
       If wParam = WM_MBUTTONUP Then
           mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
           CallMouseHookProc = 1
       End If
       
       If wParam = WM_MOUSEWHEEL Then
           mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
           CallMouseHookProc = 1
       End If
       
        
     End If
    
     If code <> 0 Then
       CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam)
     End If
  
End Function

Answer 2

试了下，好像不行哦，上下滚动返回的是514，和左键弹起是一样的
       If wParam = WM_MBUTTONDOWN Then                       '把中键改为左键
            mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
            CallMouseHookProc = 1
       End If
      
       If wParam = WM_MBUTTONUP Then
           mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
           CallMouseHookProc = 1
       End If这一段不用，我去掉了，用不到

Answer 3

鼠标钩子
Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
     Dim pt As POINTAPI     If code = HC_ACTION Then
       CopyMemory MouseMsg, lParam, LenB(MouseMsg)
      
       Form1.txtMsg(1).Text = "X=" + Str(MouseMsg.X) + " Y=" + Str(MouseMsg.Y)
       Form1.txtHwnd(1) = Format(wParam, "0")      
       If wParam = WM_MBUTTONDOWN Then                       '把中键改为左键
            'mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
            CallMouseHookProc = 1
       End If
      
       If wParam = WM_MBUTTONUP Then
           'mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
           CallMouseHookProc = 1
       End If
       
       If wParam = WM_MOUSEWHEEL Then
           'mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
           CallMouseHookProc = 1
       End If
       
        
     End If
    
     If code <> 0 Then
       CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam)
     End If
  
End Function这样呢？

Answer 4

你的函数设计有问题。
按照常规 WindowProc() 的参数，uMsg 传送 WM_MOUSEWHEEL，wParam 就能传递滚动方向。
你的函数中少了一个参数，当然无法区分滚动方向了。

Answer 5

解决了，你把这段代码覆盖你原来的模块文件中的代码即可：Option Explicit'---------------------------------
'模块文件
Public 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
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)
Public Type KEYMSGS
        vKey As Long           '虚拟码   (and &HFF)
        sKey As Long           '扫描码
        flag As Long           '键按下：128 抬起：0
        time As Long           'Window运行时间
End Type
Public Type MOUSEMSGS
        X As Long             'x座标
        Y As Long             'y座标
        a As Long
        b As Long
        time As Long          'Window运行时间
End Type
Public Type POINTAPI
     X As Long
     Y As Long
End TypePrivate Type MSLLHOOKSTRUCT     '鼠标HOOK时lParam指针指向的结构
    pt As POINTAPI
    dwMouseData As Long
    dwFlags As Long
    dwTime As Long
    dwExtraInfo As Long
End Type
Public Const WH_KEYBOARD_LL = 13
Public Const WH_MOUSE_LL = 14
Public Const Alt_Down = &H20
'-----------------------------------------
'消息
Public Const HC_ACTION = 0
Public Const HC_SYSMODALOFF = 5
Public Const HC_SYSMODALON = 4
'键盘消息
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
'鼠标消息
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209
Public Const WM_MOUSEACTIVATE = &H21
Public Const WM_MOUSEFIRST = &H200
Public Const WM_MOUSELAST = &H209Public Const WM_MOUSEWHEEL = &H20APublic Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public strKeyName As String * 255
Public Declare Function GetActiveWindow Lib "user32" () As Long
Public keyMsg As KEYMSGS
Public MouseMsg As MOUSEMSGS
Public lHook(1) As Long
'----------------------------------------
'模拟鼠标
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 '   absolute movePrivate Const MOUSEEVENTF_WHEEL = &H800
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
'--------------------------------------
'模拟按键
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
'鼠标钩子
Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim pt As POINTAPI
    If code = HC_ACTION Then
        CopyMemory MouseMsg, lParam, LenB(MouseMsg)
        Form1.txtMsg(1).Text = "X=" + Str(MouseMsg.X) + " Y=" + Str(MouseMsg.Y)
        Form1.txtHwnd(1) = Format(wParam, "0")
        If wParam = WM_MOUSEWHEEL Then
            Dim stMLL As MSLLHOOKSTRUCT
            Call CopyMemory(ByVal VarPtr(stMLL), ByVal lParam, Len(stMLL))
            
            If stMLL.dwMouseData / &H10000 = 120 Then
                Form1.Caption = "鼠标滚轮向上滚动"
            ElseIf stMLL.dwMouseData / &H10000 = -120 Then
                Form1.Caption = "鼠标滚轮向下滚动"
            End If
            CallMouseHookProc = 1
        End If
    
    End If
    
    If code <> 0 Then
    CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam)
    End IfEnd Function
'键盘钩子
Public Function CallKeyHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
     Dim lKey As Long
     Dim strKeyName As String * 255
     Dim strLen As Long
   
     If code = HC_ACTION Then
       CopyMemory keyMsg, lParam, LenB(keyMsg)
       Select Case wParam
         Case WM_SYSKEYDOWN, WM_KEYDOWN, WM_SYSKEYUP, WM_KEYUP:
        
             
             lKey = keyMsg.sKey And &HFF            '扫描码
             lKey = lKey * 65536
             strLen = GetKeyNameText(lKey, strKeyName, 250)
             Form1.txtMsg(0).Text = "键名:" + Left(strKeyName, strLen) + " 虚拟码:" + Format(keyMsg.vKey And &HFF, "0") + " 扫描码:" + Format(lKey / 65536, "0") + Chr(13)
            
             Form1.txtHwnd(0) = ""
             If (GetKeyState(vbKeyControl) And &H8000) Then
                Form1.txtHwnd(0) = Form1.txtHwnd(0) + "Ctrl "
             End If
            
             If (keyMsg.flag And Alt_Down) <> 0 Then
                Form1.txtHwnd(0) = Form1.txtHwnd(0) + "Alt "
             End If
            
             If (GetKeyState(vbKeyShift) And &H8000) Then
               Form1.txtHwnd(0) = Form1.txtHwnd(0) + "Shift"
             End If
              
             'keyMsg.vKey And &HFF    虚拟码
             'lKey / 65536            扫描码
            
            ' If (keyMsg.vKey And &HFF) = vbKeyY Then        '把Y键替换为N
             '    If wParam = WM_SYSKEYDOWN Or wParam = WM_KEYDOWN Then
             '       keybd_event vbKeyN, 0, 0, 0
             '    End If
                'CallKeyHookProc = 1         '屏蔽按键
             'End If
            
        End Select
     End If
   
     If code <> 0 Then
       CallKeyHookProc = CallNextHookEx(0, code, wParam, lParam)
     End If
   End Function