vb6钩子问题。大哥哥大姐姐们帮帮忙啊

SmallBear 2011-03-07 02:33:55

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
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
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetKeyboardState Lib "user32 " (pbKeyState As Byte) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirkey As Long) As Long
Private Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
'Private Declare Sub CopyMemory1 Lib "kernel32" Alias "RtlMoveMemory" (lpvdest As Any, ByVal lpsource As Long, ByVal cbcopy As Long)
Private JPhHook As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Type KEYMSGS
vKey As Long
sKey As Long
flag As Long
time As Long
End Type
Private keyMsg As KEYMSGS
'消息
Private Const WH_KEYBOARD_LL As Long = 13
Private Const HC_ACTION = 0
Private Const HC_SYSMODALOFF = 5
Private Const HC_SYSMODALON = 4
'键盘消息
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_SYSKEYDOWN = &H104
Private Const WM_SYSKEYUP = &H105

Public Sub EnableHook()
If JPhHook = 0 Then
JPhHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf JPHookProc, App.hInstance, 0)
End If
End Sub

Public Sub FreeHook()
If JPhHook <> 0 Then
Call UnhookWindowsHookEx(JPhHook)
End If
End Sub

Public Function JPHookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim IKey As Long
Dim strKeyName As String * 255
Dim strLen As Long
If nCode = HC_ACTION Then
CopyMemory keyMsg, lParam, LenB(keyMsg)
Select Case wParam
Case WM_SYSKEYDOWN, WM_KEYDOWN, WM_SYSKEYUP, WM_KEYUP:
IKey = keyMsg.sKey And &HFF
IKey = IKey * 65536
strLen = GetKeyNameText(IKey, strKeyName, strLen)
Debug.Print "键名:" & Left(strKeyName, strLen)
Debug.Print "虚拟:" & Left(keyMsg.vKey And &HFF, "0")
Debug.Print "扫描码:" & Format(IKey / 65536, "0")
End Select

End If
End Function




为什么输出来的 键名和虚拟是空的啊。
...全文
291 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
KissVeggieg 2012-08-15
  • 打赏
  • 举报
回复
[Quote=引用 5 楼 的回复:]
很简单的改动。主要是CopyMemory 的参数传输:
VB code
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Priv……
[/Quote]

高人您好!!请教您如何修改才能在EXCEL中使用?
holam01 2012-02-07
  • 打赏
  • 举报
回复
没什么用,但还是谢谢了
SmallBear 2011-03-07
  • 打赏
  • 举报
回复
成功了。
chenjl1031
谢谢哥哥了。
东方之珠 2011-03-07
  • 打赏
  • 举报
回复
还有个地方有误:
Debug.Print "扫描码:" & Format(IKey / 65536, "0")
改成下面就OK了:
Debug.Print "扫描码:" & IKey/65536
东方之珠 2011-03-07
  • 打赏
  • 举报
回复
很简单的改动。主要是CopyMemory 的参数传输:
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
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
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetKeyboardState Lib "user32 " (pbKeyState As Byte) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirkey As Long) As Long
Private Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
'Private Declare Sub CopyMemory1 Lib "kernel32" Alias "RtlMoveMemory" (lpvdest As Any, ByVal lpsource As Long, ByVal cbcopy As Long)
Private JPhHook As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Type KEYMSGS
vKey As Long
sKey As Long
flag As Long
time As Long
End Type
Private keyMsg As KEYMSGS
'消息
Private Const WH_KEYBOARD_LL As Long = 13
Private Const HC_ACTION = 0
Private Const HC_SYSMODALOFF = 5
Private Const HC_SYSMODALON = 4
'键盘消息
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_SYSKEYDOWN = &H104
Private Const WM_SYSKEYUP = &H105

Public Sub EnableHook()
If JPhHook = 0 Then
JPhHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf JPHookProc, App.hInstance, 0)
End If
End Sub

Public Sub FreeHook()
If JPhHook <> 0 Then
Call UnhookWindowsHookEx(JPhHook)
End If
End Sub

Public Function JPHookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim IKey As Long
Dim strKeyName As String * 255
Dim strLen As Long
If nCode = HC_ACTION Then
CopyMemory ByVal keyMsg, ByVal lParam, Len(keyMsg)
Select Case wParam
Case WM_SYSKEYDOWN, WM_KEYDOWN, WM_SYSKEYUP, WM_KEYUP:
IKey = keyMsg.sKey And &HFF
IKey = IKey * 65536
strLen = 256
strLen = GetKeyNameText(IKey, strKeyName, strLen)
Debug.Print "键名:" & Left(strKeyName, InStr(strKeyName, Chr(0)) - 1)
Debug.Print "虚拟:" & keyMsg.vKey
Debug.Print "扫描码:" & Format(IKey / 65536, "0")
End Select

End If
End Function
dianyancao 2011-03-07
  • 打赏
  • 举报
回复
[Quote=引用 2 楼 smallbear888 的回复:]

哈哈哼、vb调试太烂了。真受不了了。
你帮我看看啊。
[/Quote]
实在不会对不起了,MM会撒谎哈哈
  • 打赏
  • 举报
回复
死草的灌水机器人……
SmallBear 2011-03-07
  • 打赏
  • 举报
回复
哈哈哼、vb调试太烂了。真受不了了。
你帮我看看啊。
dianyancao 2011-03-07
  • 打赏
  • 举报
回复
叫夜闻香过来哼哼哈

1,486

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧