有关使用 VB 制作全局 HOOK 的问题

Question

看了很多文章，但是总结下来，　纯用 VB　不能作全局的钩子，原因就在于　VB 只能做　ACTIVEX　DLL　想问一下是否真的如此？　是否有人曾经做过纯用VB制作的全局的HOOK　？

Answer 1

上次好像看见有人说可以用　VB　制作标准　DLL找不到了．　谁有？　麻烦贴出来看一下

Answer 2

'这样可以做全局键盘钩子，不知实现的功能是否是你说的全局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 Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPublic Const SW_SHOW = 5
Public Const SW_HIDE = 0
Public Const SW_RESTORE = 9Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As LongType EVENTMSG
        message As Long
        paramL As Long
        paramH As Long
        time As Long
        hwnd As Long
End TypePublic Const WH_KEYBOARD_LL = 13
Public Const Alt_Down = &H20'消息
Public Const HC_ACTION = 0
Public Const HC_SYSMODALOFF = 5
Public Const HC_SYSMODALON = 4Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105Public msg As EVENTMSGPublic lHook As Long
Public lNum As Long
Public Function CallHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim bflag  As Boolean
    bflag = False
    If code = HC_ACTION Then
      CopyMemory msg, lParam, LenB(msg)
      Select Case wParam
        Case WM_SYSKEYDOWN, WM_SYSKEYUP, WM_KEYDOWN, WM_KEYUP:
            'Win键  Menu键
            bflag = (msg.message = 91) Or (msg.message = 92) Or (msg.message = 93)
            'Ctrl+ESC
            bflag = bflag Or ((GetKeyState(vbKeyControl) And &H8000) <> 0 And (msg.message = vbKeyEscape))
            'Alt+Tab
            bflag = bflag Or ((msg.message = vbKeyTab) And (msg.paramH And Alt_Down) <> 0)
            'Alt+ESC
            bflag = bflag Or ((msg.paramH And Alt_Down) <> 0 And (msg.message = vbKeyEscape))
       End Select
    End If
        
    If bflag = True Then
      CallHookProc = 1
    Else
      CallHookProc = 0
    End If
    
    If code <> 0 Then
      CallHookProc = CallNextHookEx(0, code, wParam, lParam)
    End If’加钩子
 lHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf CallHookProc, App.hInstance, 0)‘卸钩子
If lHook <> 0 Then
      UnhookWindowsHookEx lHook
   End If
  
End Function

Answer 3

Delphi深入Windows核心编程中有关这方面的东东，不是VB作的

Answer 4

多谢两位不过我要的是　VB　的 yefanqiu(叶帆) 的好像还不算是全局的

Answer 5

这有篇文章，有兴趣的看看：http://www.51study.net/view.asp?TuId=17&ChId=107

Answer 6

我这有段代码，能否解释一下，为什么在调试时是好的，编译成　ｅｘｅ　后就不行了呢？
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim Pt As POINTAPI
Private Sub Form_Load()
    'redirect all mouse input to this form
    SetCapture Me.hwnd
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture
    SetCapture Me.hwnd
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Get the current cursor position
    GetCursorPos Pt
    Me.CurrentX = 0
    Me.CurrentY = 0
    'Clear the screen
    Me.Cls
    Me.Print "Cursor position:"
    'Print the mouse co&ouml;rdinates to the form
    Me.Print "X:" + Str$(Pt.X) + " Y:" + Str$(Pt.Y)
    Me.Print " (Press ALT-F4 to unload this form)"
    SetCapture Me.hwnd
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture
    SetCapture Me.hwnd
End Sub===============================================================================
编译成　ｅｘｅ　后　，SetCapture 失去了该有的作用.(本来应该在窗体外面也能打印出鼠标坐标的，调试的时候是可以的)为什么？

Answer 7

这是　MSDN 的解释：HWND SetCapture(hwnd)
说明：SetCapture函数向属于当前线程的给定窗口设置鼠标捕获。一旦某一窗口捕获了鼠标，则不管光标是否在该窗口的边界内，所有鼠标输入都直接对着该窗口。同时只能有一个窗口捕获鼠标。
若鼠标光标正在其他线程创建的窗口之上，则仅当按下了一个鼠标按钮时，系统才将鼠标输入指向给定的窗口。
　　参数：hwnd 标识当前线程中将捕获鼠标的窗口。
返回值：若函数成功，返回值是原来捕获鼠标的窗口的句柄。若没有这个窗口，则返回值为NULL。
　　注释：只有前台窗口可捕获鼠标。当后台窗口试图这样做时，该窗口只能接收光标热点位于该窗口可见部分中时发生的鼠标事件的消息。另外，即使前台窗口未捕获鼠标，用户也可单击另一个窗口使其进入前台。
当窗口不再需要所有鼠标输入时，创建该窗口的线程应调用PeleaseCapture函数释放鼠标。
不得调用该函数为其它过程捕获鼠标输入。按这样的解释应该不会出现上面的情况，但是为什么出现了呢？

Answer 8

调用api算不算，不是用vb开发呢？

Answer 9

只要是动态库，不管是标准的还是activex的都可以写出全局钩子，不信你在activex dll的全局钩子过程中加入一个向某个固定窗口发消息的语句，你就可以看到，不管调用的应用程序是不是激活的，那个窗口都可以接收到。

Answer 10

我试了你的程序，可以呀？
Win2000 sp3   VB6.0

Answer 11

to : icnetcn(yoyo之无双)  and   yefanqiu(叶帆) 你们可以试试用全局钩子来实现我在这里贴的代码吗？如果你说可以＂不管是标准的还是activex的都可以写出全局钩子＂

Answer 12

就是这个帖子的内容：
http://expert.csdn.net/Expert/topic/1663/1663477.xml?temp=.3203852

Answer 13

你的程序我看了，我调试了一下，可以加全局鼠标钩子。
由于在VB中，大家都用WH_MOUSE参数加鼠标钩子，而此钩子不是全局钩子
要使用在API参数中找不到的WH_MOUSE_LL。‘－－－－－－－－－－sub form_load()
   '加钩子
   '注意是WH_MOUSE_LL，不是WH_MOUSE，WH_MOUSE_LL是我在VC头文件中搜索到的！！！
   'WH_MOUSE不是全局，只对本身有效，你可以与WH_MOUSE_LL比较试试
   lHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf CallHookProc, App.hInstance, 0)
   
End SubPrivate Sub Form_DblClick()
   '卸钩子，一定要卸，否则VB本身崩溃
   If lHook <> 0 Then
      UnhookWindowsHookEx lHook
   End If   Unload Me
   
End Sub
’－－－
‘模块'---------
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 Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPublic Const SW_SHOW = 5
Public Const SW_HIDE = 0
Public Const SW_RESTORE = 9Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As LongType EVENTMSG
        message As Long
        paramL As Long
        paramH As Long
        time As Long
        hwnd As Long
End TypePrivate Type POINTAPI
    x As Long
    y As Long
End TypePublic Const WH_KEYBOARD_LL = 13
Public Const WH_MOUSE_LL = 14
Public Const Alt_Down = &H20
Public Const WH_MOUSE = 7'消息
Public Const HC_ACTION = 0
Public Const HC_SYSMODALOFF = 5
Public Const HC_SYSMODALON = 4Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
Private Const WM_MOUSEMOVE = &H200Public msgs As EVENTMSGPublic lHook As Long
Public lNum As Long'注意,该程序里的代码一旦有错，它会使VB本身崩溃，所以...
Public Function CallHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim pt As POINTAPI
    
    bflag = False
    If code = HC_ACTION Then
      CopyMemory msgs, lParam, LenB(msgs)
      Select Case wParam
        Case WM_MOUSEMOVE
           pt.x = msgs.message    '我试的，可是好奇怪。它就是X
           pt.y = msgs.paramL     'Y
           '你在窗体添一个TextBox
           Form1.Text1 = Str(pt.x) + "," + Str(pt.y)    '它确实显示了正确的鼠标位置
          '既然有鼠标位置,你的程序也就解决了      End Select
    End If
'
    If code <> 0 Then
      CallHookProc = CallNextHookEx(0, code, wParam, lParam)
    End If
  
End Function

Answer 14

GOOD !非常好！
WH_MOUSE_LL　我在　MSDN　中有看到，只是思想放松了，认为不是我要的，就没有试再次感谢