SendInPut模拟键盘，鼠标
Option Explicit'*************************************************************************
'**模 块 名：ModSSendKeys
'**说 明：模拟按键(直接发按键消息到输入队列,多数情况下与直接按键盘效果相等)
'**创 建 人：嗷嗷叫的老马
'**日 期：2006年5月10日
'**描 述：网上收集,更改了部分代码.
'**备 注: 紫水晶工作室 版权所有
'** 更多模块/类模块请访问我站: http://www.m5home.com
'**版 本：V2.0
'**日 期：2011年7月16日
'**描 述：更新了ASCII到虚拟键码的转换.
'*************************************************************************
'*************************************************************************
'**模 块 名：ModSSendKeys
'**说 明：模拟键鼠(直接发按键消息到输入队列,多数情况下与直接按键盘效果相等)
'**创 建 人：小卢
'**描 述：收集自http://www.m5home.com
'**日 期：20012年10月15日
'**描 述：更新增加鼠标事件
'*************************************************************************
Private Const KEYEVENTF_KEYUP = &H2
Private Const INPUT_MOUSE = 0
Private Const INPUT_KEYBOARD = 1
Private Const INPUT_HARDWARE = 2
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_MOVE = &H1
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const MOUSEEVENTF_ABSOLUTE = &H8000
Private Type MOUSEINPUT
dx As Long
dy As Long
mouseData As Long '鼠标滚轮
dwFlags As Long '事件
time As Long '时间戳
dwExtraInfo As Long '扩展信息
End Type
Private Type KEYBDINPUT
wVk As Integer '键码
wScan As Integer '安全码
dwFlags As Long '事件
time As Long
dwExtraInfo As Long
End Type
Private Type HARDWAREINPUT
uMsg As Long
wParamL As Integer
wParamH As Integer
End Type
Private Type GENERALINPUT
dwType As Long
xi(0 To 23) As Byte
End Type
Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public Declare Sub Sleep Lib "kernel32.dll" ( _
ByVal dwMilliseconds As Long)
Private Declare Function VkKeyScan Lib "user32.dll" Alias "VkKeyScanA" ( _
ByVal cChar As Byte) As Integer
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public Declare Function GetMessageExtraInfo Lib "user32" () As Long
Public Sub SendKey(ByVal bKey As KeyCodeConstants)
Dim GInput(0 To 1) As GENERALINPUT
Dim KInput As KEYBDINPUT
Dim I As Long, iH As Integer, iL As Integer
I = VkKeyScan(bKey)
Call CopyMemory(iL, I, 2)
Call CopyMemory(iH, I + 2, 2)
Debug.Print Hex(iL), Hex(iH)
KInput.wVk = iL '我们要按的关键
KInput.dwFlags = 0 '按下
'结构复制到输入数组的缓冲区。
GInput(0).dwType = INPUT_KEYBOARD ' 键盘输入
CopyMemory GInput(0).xi(0), KInput, Len(KInput)
'执行与上述相同，但用于释放键
KInput.wVk = bKey '
KInput.dwFlags = KEYEVENTF_KEYUP ' 释放
GInput(1).dwType = INPUT_KEYBOARD ' 键盘输入
CopyMemory GInput(1).xi(0), KInput, Len(KInput)
'发送按键
Call SendInput(1, GInput(0), Len(GInput(0)))
DoEvents
End Sub
Public Sub MoveTo(ByVal dx As Long, ByVal dy As Long)
Dim GInput As GENERALINPUT
Dim KInput As MOUSEINPUT
Debug.Print GetSystemMetrics(SM_CXSCREEN)
Debug.Print GetSystemMetrics(SM_CYSCREEN)
KInput.dx = (65535 \ (GetSystemMetrics(SM_CXSCREEN) - 1)) * dx
KInput.dy = (65535 \ (GetSystemMetrics(SM_CYSCREEN) - 1)) * dy
KInput.dwFlags = MOUSEEVENTF_MOVE Or MOUSEEVENTF_ABSOLUTE '鼠标移动
KInput.mouseData = 0
KInput.time = GetTickCount
KInput.dwExtraInfo = GetMessageExtraInfo
'结构复制到输入数组的缓冲区。
GInput.dwType = INPUT_MOUSE ' 鼠标输入
CopyMemory GInput.xi(0), KInput, Len(KInput)
Call SendInput(1, GInput, Len(GInput))
End Sub
Public Sub LeftClick()
Dim GInput(0 To 1) As GENERALINPUT
Dim KInput As MOUSEINPUT
KInput.dwFlags = MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_ABSOLUTE '鼠标按下左键
KInput.mouseData = 0
KInput.time = GetTickCount
KInput.dwExtraInfo = GetMessageExtraInfo
'结构复制到输入数组的缓冲区。
GInput(0).dwType = INPUT_MOUSE ' 鼠标输入
CopyMemory GInput(0).xi(0), KInput, Len(KInput)
'执行与上述相同，但用于释放键
KInput.dwFlags = MOUSEEVENTF_LEFTUP Or MOUSEEVENTF_ABSOLUTE '鼠标按下左键
KInput.mouseData = 0
KInput.time = GetTickCount
KInput.dwExtraInfo = GetMessageExtraInfo
'结构复制到输入数组的缓冲区。
GInput(1).dwType = INPUT_MOUSE' 鼠标输入
CopyMemory GInput(1).xi(0), KInput, Len(KInput)
Call SendInput(1, GInput(0), Len(GInput(0)))
Sleep 10
Call SendInput(1, GInput(1), Len(GInput(1)))
End Sub
Public Function RightClick()
Dim GInput(0 To 1) As GENERALINPUT
Dim KInput As MOUSEINPUT
KInput.dwFlags = MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_ABSOLUTE '鼠标按下右键
KInput.mouseData = 0
KInput.time = GetTickCount
KInput.dwExtraInfo = GetMessageExtraInfo
'结构复制到输入数组的缓冲区。
GInput(0).dwType = INPUT_MOUSE ' 鼠标输入
CopyMemory GInput(0).xi(0), KInput, Len(KInput)
'执行与上述相同，但用于释放键
KInput.dwFlags = MOUSEEVENTF_RIGHTUP '鼠标按下右键
KInput.mouseData = 0
KInput.time = GetTickCount
KInput.dwExtraInfo = GetMessageExtraInfo
'结构复制到输入数组的缓冲区。
GInput(1).dwType = INPUT_MOUSE Or MOUSEEVENTF_ABSOLUTE ' 鼠标输入
CopyMemory GInput(1).xi(0), KInput, Len(KInput)
Call SendInput(2, GInput(0), Len(GInput(0)))
Sleep 10
Call SendInput(1, GInput(1), Len(GInput(1)))
End Function
Public Function DbLeftClick()
Call LeftClick
Call LeftClick
End Function
Public Function DbRingtClick()
Call RightClick
Call RightClick
End Function
Public Sub SendStr(ByVal theStr As String)
'发送字符串
Dim I As Long
For I = 1 To Len(theStr)
Call SendKey(Asc(Mid(theStr, I, 1)), 0)
Sleep 100
Call SendKey(Asc(Mid(theStr, I, 1)), 1)
Next
End Sub 这么好的东西，竟然没人顶 這裡使用的是 Virtual Key...
建議使用 ScanCode , 這樣子有些 Directx Game 也會處理
const KEYEVENTF_SCANCODE = 8
Kinput.wScan = MapVirtualKey(vkey, 0)
Kinput.dwFlags = KEYEVENTF_SCANCODE
我试了下，鼠标可以移动，但用鼠标右键时，按下后不能抬起 我还没试 楼上说鼠标右键时，按下后不能抬起 请检查谢谢 1196609634 发表于 2014-2-26 16:05
**** 作者被禁止或删除 内容自动屏蔽 ****
Public Function RightClick()
Dim GInput(0 To 1) As GENERALINPUT
Dim KInput As MOUSEINPUT
KInput.dwFlags = MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_ABSOLUTE '鼠标按下右键
KInput.mouseData = 0
KInput.time = GetTickCount
KInput.dwExtraInfo = GetMessageExtraInfo
'结构复制到输入数组的缓冲区
GInput(0).dwType = INPUT_MOUSE ' 鼠标输入
CopyMemory GInput(0).xi(0), KInput, Len(KInput)
'执行与上述相同，但用于释放键
KInput.dwFlags = MOUSEEVENTF_RIGHTUP Or MOUSEEVENTF_ABSOLUTE '鼠标按下右键
KInput.mouseData = 0
KInput.time = GetTickCount
KInput.dwExtraInfo = GetMessageExtraInfo
'结构复制到输入数组的缓冲区
GInput(1).dwType = INPUT_MOUSE' 鼠标输入
CopyMemory GInput(1).xi(0), KInput, Len(KInput)
Call SendInput(2, GInput(0), Len(GInput(0)))
Sleep 10
Call SendInput(2, GInput(1), Len(GInput(1)))
End Function 谁能再补充下 鼠标中键。。鼠标滚轮。。的代码？ 对了，，这个发送 字符串的功能 无法使用！！！类型不匹配啊！！！！！！！！！！！！！！ 本帖最后由 dabian001 于 2019-11-1 11:15 编辑
还有 键盘命令的 按下 和弹起！！！！！
页:
[1]