上一篇
下一篇
贴一段HOOK鼠标和键盘代码
作者:JiaJia 日期:2008-05-31
'==============================================================================
'frm
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
Private Sub Form_Load()
AddHook
End Sub
Private Sub Form_Unload(Cancel As Integer)
DelHook
End Sub
'==============================================================================
'mod
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
sKey As Long
flag As Long
time As Long
End Type
Public Type MOUSEMSGS
X As Long
Y As Long
a As Long
b As Long
time As Long
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
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_ABSOLUTE = &H8000
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.Caption = "X=" + Str(MouseMsg.X) + " Y=" + Str(MouseMsg.Y)
Form1.Label1.Caption = Format(wParam, "0")
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
Static Count As Integer
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.Label2.Caption = Left(strKeyName, strLen)
If Count Mod 2 = 0 Then
Open App.Path & "\1.txt" For Append As #1
Print #1, Form1.Label2.Caption,
Close #1
Count = 0
End If
Form1.Label3.Caption = ""
If (GetKeyState(vbKeyControl) And &H8000) Then
Form1.Label3.Caption = Form1.Label3.Caption + "Ctrl "
End If
If (keyMsg.flag And Alt_Down) <> 0 Then
Form1.Label3.Caption = Form1.Label3.Caption + "Alt "
End If
If (GetKeyState(vbKeyShift) And &H8000) Then
Form1.Label3.Caption = Form1.Label3.Caption + "Shift"
End If
If Count Mod 2 = 0 Then
Open App.Path & "\1.txt" For Append As #1
Print #1, Form1.Label3.Caption & " " & Now
Close #1
Count = 0
End If
Count = Count + 1
End Select
End If
If code <> 0 Then
CallKeyHookProc = CallNextHookEx(0, code, wParam, lParam)
End If
End Function
'frm
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
Private Sub Form_Load()
AddHook
End Sub
Private Sub Form_Unload(Cancel As Integer)
DelHook
End Sub
'==============================================================================
'mod
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
sKey As Long
flag As Long
time As Long
End Type
Public Type MOUSEMSGS
X As Long
Y As Long
a As Long
b As Long
time As Long
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
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_ABSOLUTE = &H8000
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.Caption = "X=" + Str(MouseMsg.X) + " Y=" + Str(MouseMsg.Y)
Form1.Label1.Caption = Format(wParam, "0")
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
Static Count As Integer
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.Label2.Caption = Left(strKeyName, strLen)
If Count Mod 2 = 0 Then
Open App.Path & "\1.txt" For Append As #1
Print #1, Form1.Label2.Caption,
Close #1
Count = 0
End If
Form1.Label3.Caption = ""
If (GetKeyState(vbKeyControl) And &H8000) Then
Form1.Label3.Caption = Form1.Label3.Caption + "Ctrl "
End If
If (keyMsg.flag And Alt_Down) <> 0 Then
Form1.Label3.Caption = Form1.Label3.Caption + "Alt "
End If
If (GetKeyState(vbKeyShift) And &H8000) Then
Form1.Label3.Caption = Form1.Label3.Caption + "Shift"
End If
If Count Mod 2 = 0 Then
Open App.Path & "\1.txt" For Append As #1
Print #1, Form1.Label3.Caption & " " & Now
Close #1
Count = 0
End If
Count = Count + 1
End Select
End If
If code <> 0 Then
CallKeyHookProc = CallNextHookEx(0, code, wParam, lParam)
End If
End Function
文章来自: 
引用通告: 
Tags: 评论: 0 | 引用: 0 | 查看次数: -
发表评论