实现全局挂钩

Question

在VB中很容易实现线程挂钩,不利用传统的动态联接库如何实现全局挂钩,请高手指点.

Answer 1

只要你的系统是win2000，可以在VB代码里实现全局钩子
我回过这样贴子，你可以搜一下
（其实98也可以，只是这样的钩子，只允许有一个）

Answer 2

yefanqiu(叶帆)查不到阿,再麻烦贴一回,让我学习学习.以后有分一定补

Answer 3

我也在WIN2000， 用VB做过全局钩子。也可以把VB的DLL 注入其它程序的里程中，不过不能显示窗体（模式窗体也不行） 只能显示 消息框 在游戏中如果这样弹出消息框，游戏就自动退出了（出现错误，不过没有提示）********************************************************************
我插入了一个Delphi写的DLL，并设置键盘钩子，当检测到钩子键在弹出窗体时，目标程序（游戏或其它程序）出现错误， 程序终止运行了。 我用VB写的DLL， 效果一样。
这是为什么？？？

Answer 4

'---------------------------------
'Form 
'安装钩子
Private sub AddHook()
  '键盘钩子
  lHook(0) = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf CallKeyHookProc, App.hInstance, 0)
  '鼠标钩子
  lHook(1) = SetWindowsHookEx(WH_MOUSE_LL, AddressOf CallMouseHookProc, App.hInstance, 0)
End Sub
'卸钩子
Private sub DelHook()
  UnhookWindowsHookEx lHook(0)
  UnhookWindowsHookEx lHook(1)
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 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 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 = &H209
Public Const WM_MOUSEWHEEL = &H20A
Public 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

Answer 5

'----------------------------------------
'模拟鼠标
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 '  absolute move
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_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
        
    End If
    
    If code <> 0 Then
      CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam)
    End If
  
End 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")
            
            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

Answer 6

楼上真的高手,多谢,你的一点是非常值得大家学习的,就是无私.希望看到此贴的朋友向 yefanqiu(叶帆)看齐