紫水晶编程技术论坛 - 努力打造成全国最好的编程论坛

 找回密码
 加入我们

QQ登录

只需一步,快速开始

搜索
查看: 5362|回复: 8

[鼠标键盘] SendInPut模拟键盘,鼠标

[复制链接]

1

主题

9

帖子

0

精华

铜牌会员

Rank: 2Rank: 2

积分
34
发表于 2012-10-15 20:17:25 | 显示全部楼层 |阅读模式
  1. Option Explicit
  2. '*************************************************************************
  3. '**模 块 名:ModSSendKeys
  4. '**说    明:模拟按键(直接发按键消息到输入队列,多数情况下与直接按键盘效果相等)
  5. '**创 建 人:嗷嗷叫的老马
  6. '**日    期:2006年5月10日
  7. '**描    述:网上收集,更改了部分代码.
  8. '**备    注: 紫水晶工作室 版权所有
  9. '**          更多模块/类模块请访问我站: http://www.m5home.com
  10. '**版    本:V2.0
  11. '**日    期:2011年7月16日
  12. '**描    述:更新了ASCII到虚拟键码的转换.
  13. '*************************************************************************


  14. '*************************************************************************
  15. '**模 块 名:ModSSendKeys
  16. '**说    明:模拟键鼠(直接发按键消息到输入队列,多数情况下与直接按键盘效果相等)
  17. '**创 建 人:小卢
  18. '**描    述:收集自http://www.m5home.com
  19. '**日    期:20012年10月15日
  20. '**描    述:更新增加鼠标事件
  21. '*************************************************************************
  22. Private Const KEYEVENTF_KEYUP = &H2
  23. Private Const INPUT_MOUSE = 0
  24. Private Const INPUT_KEYBOARD = 1
  25. Private Const INPUT_HARDWARE = 2
  26. Private Const MOUSEEVENTF_LEFTDOWN = &H2
  27. Private Const MOUSEEVENTF_LEFTUP = &H4
  28. Private Const MOUSEEVENTF_MOVE = &H1
  29. Private Const MOUSEEVENTF_RIGHTDOWN = &H8
  30. Private Const MOUSEEVENTF_RIGHTUP = &H10
  31. Private Const SM_CXSCREEN = 0
  32. Private Const SM_CYSCREEN = 1
  33. Private Const MOUSEEVENTF_ABSOLUTE = &H8000

  34. Private Type MOUSEINPUT
  35.     dx As Long
  36.     dy As Long
  37.     mouseData As Long            '鼠标滚轮
  38.     dwFlags As Long             '事件
  39.     time As Long                  '时间戳
  40.     dwExtraInfo As Long             '扩展信息
  41. End Type
  42. Private Type KEYBDINPUT
  43.     wVk As Integer                  '键码
  44.     wScan As Integer                 '安全码
  45.     dwFlags As Long                 '事件
  46.     time As Long
  47.     dwExtraInfo As Long
  48. End Type
  49. Private Type HARDWAREINPUT
  50.     uMsg As Long
  51.     wParamL As Integer
  52.     wParamH As Integer
  53. End Type
  54. Private Type GENERALINPUT
  55.     dwType As Long
  56.     xi(0 To 23) As Byte
  57. End Type
  58. Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long
  59. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
  60. Public Declare Sub Sleep Lib "kernel32.dll" ( _
  61.         ByVal dwMilliseconds As Long)
  62. Private Declare Function VkKeyScan Lib "user32.dll" Alias "VkKeyScanA" ( _
  63.         ByVal cChar As Byte) As Integer
  64. Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  65. Public Declare Function GetTickCount Lib "kernel32" () As Long
  66. Public Declare Function GetMessageExtraInfo Lib "user32" () As Long

  67. Public Sub SendKey(ByVal bKey As KeyCodeConstants)
  68.     Dim GInput(0 To 1) As GENERALINPUT
  69.     Dim KInput As KEYBDINPUT
  70.     Dim I As Long, iH As Integer, iL As Integer
  71.    
  72.     I = VkKeyScan(bKey)
  73.     Call CopyMemory(iL, I, 2)
  74.     Call CopyMemory(iH, I + 2, 2)
  75.    
  76.     Debug.Print Hex(iL), Hex(iH)
  77.    
  78.    
  79.     KInput.wVk = iL '我们要按的关键
  80.     KInput.dwFlags = 0 '按下
  81.     '结构复制到输入数组的缓冲区。
  82.     GInput(0).dwType = INPUT_KEYBOARD ' 键盘输入
  83.     CopyMemory GInput(0).xi(0), KInput, Len(KInput)
  84.     '执行与上述相同,但用于释放键
  85.     KInput.wVk = bKey '
  86.     KInput.dwFlags = KEYEVENTF_KEYUP ' 释放
  87.     GInput(1).dwType = INPUT_KEYBOARD ' 键盘输入
  88.     CopyMemory GInput(1).xi(0), KInput, Len(KInput)
  89.     '发送按键
  90.     Call SendInput(1, GInput(0), Len(GInput(0)))
  91.     DoEvents
  92. End Sub

  93. Public Sub MoveTo(ByVal dx As Long, ByVal dy As Long)
  94.     Dim GInput As GENERALINPUT
  95.     Dim KInput As MOUSEINPUT
  96.     Debug.Print GetSystemMetrics(SM_CXSCREEN)
  97.     Debug.Print GetSystemMetrics(SM_CYSCREEN)
  98.     KInput.dx = (65535 \ (GetSystemMetrics(SM_CXSCREEN) - 1)) * dx
  99.     KInput.dy = (65535 \ (GetSystemMetrics(SM_CYSCREEN) - 1)) * dy
  100.     KInput.dwFlags = MOUSEEVENTF_MOVE Or MOUSEEVENTF_ABSOLUTE '鼠标移动
  101.     KInput.mouseData = 0
  102.     KInput.time = GetTickCount
  103.     KInput.dwExtraInfo = GetMessageExtraInfo
  104.     '结构复制到输入数组的缓冲区。
  105.     GInput.dwType = INPUT_MOUSE ' 鼠标输入
  106.     CopyMemory GInput.xi(0), KInput, Len(KInput)

  107.     Call SendInput(1, GInput, Len(GInput))

  108. End Sub

  109. Public Sub LeftClick()
  110.     Dim GInput(0 To 1) As GENERALINPUT
  111.     Dim KInput As MOUSEINPUT
  112.     KInput.dwFlags = MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_ABSOLUTE '鼠标按下左键
  113.     KInput.mouseData = 0
  114.     KInput.time = GetTickCount
  115.     KInput.dwExtraInfo = GetMessageExtraInfo
  116.     '结构复制到输入数组的缓冲区。
  117.     GInput(0).dwType = INPUT_MOUSE ' 鼠标输入
  118.     CopyMemory GInput(0).xi(0), KInput, Len(KInput)
  119.    
  120.     '执行与上述相同,但用于释放键
  121.     KInput.dwFlags = MOUSEEVENTF_LEFTUP Or MOUSEEVENTF_ABSOLUTE '鼠标按下左键
  122.     KInput.mouseData = 0
  123.     KInput.time = GetTickCount
  124.     KInput.dwExtraInfo = GetMessageExtraInfo
  125.     '结构复制到输入数组的缓冲区。
  126.     GInput(1).dwType = INPUT_MOUSE  ' 鼠标输入
  127.     CopyMemory GInput(1).xi(0), KInput, Len(KInput)
  128.     Call SendInput(1, GInput(0), Len(GInput(0)))
  129.     Sleep 10
  130.     Call SendInput(1, GInput(1), Len(GInput(1)))
  131. End Sub

  132. Public Function RightClick()
  133.     Dim GInput(0 To 1) As GENERALINPUT
  134.     Dim KInput As MOUSEINPUT
  135.     KInput.dwFlags = MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_ABSOLUTE '鼠标按下右键
  136.     KInput.mouseData = 0
  137.     KInput.time = GetTickCount
  138.     KInput.dwExtraInfo = GetMessageExtraInfo
  139.     '结构复制到输入数组的缓冲区。
  140.     GInput(0).dwType = INPUT_MOUSE ' 鼠标输入
  141.     CopyMemory GInput(0).xi(0), KInput, Len(KInput)
  142.    
  143.     '执行与上述相同,但用于释放键
  144.     KInput.dwFlags = MOUSEEVENTF_RIGHTUP '鼠标按下右键
  145.     KInput.mouseData = 0
  146.     KInput.time = GetTickCount
  147.     KInput.dwExtraInfo = GetMessageExtraInfo
  148.     '结构复制到输入数组的缓冲区。
  149.     GInput(1).dwType = INPUT_MOUSE Or MOUSEEVENTF_ABSOLUTE ' 鼠标输入
  150.     CopyMemory GInput(1).xi(0), KInput, Len(KInput)
  151.     Call SendInput(2, GInput(0), Len(GInput(0)))
  152.     Sleep 10
  153.     Call SendInput(1, GInput(1), Len(GInput(1)))
  154. End Function

  155. Public Function DbLeftClick()
  156. Call LeftClick
  157. Call LeftClick
  158. End Function

  159. Public Function DbRingtClick()
  160. Call RightClick
  161. Call RightClick
  162. End Function

  163. Public Sub SendStr(ByVal theStr As String)
  164.     '发送字符串
  165.     Dim I As Long
  166.    
  167.     For I = 1 To Len(theStr)
  168.         Call SendKey(Asc(Mid(theStr, I, 1)), 0)
  169.         Sleep 100
  170.         Call SendKey(Asc(Mid(theStr, I, 1)), 1)
  171.     Next
  172. End Sub
复制代码

30

主题

125

帖子

0

精华

铂金会员

Rank: 5

积分
1547
发表于 2013-6-30 11:08:09 | 显示全部楼层
这么好的东西,竟然没人顶

3

主题

17

帖子

0

精华

银牌会员

Rank: 3Rank: 3Rank: 3

积分
531
发表于 2013-10-26 00:47:14 | 显示全部楼层
這裡使用的是 Virtual Key...
建議使用 ScanCode , 這樣子有些 Directx Game 也會處理

const KEYEVENTF_SCANCODE = 8
Kinput.wScan = MapVirtualKey(vkey, 0)
Kinput.dwFlags = KEYEVENTF_SCANCODE

0

主题

1

帖子

0

精华

初来乍到

Rank: 1

积分
11
发表于 2014-2-26 16:05:53 | 显示全部楼层
我试了下,鼠标可以移动,但用鼠标右键时,按下后不能抬起

30

主题

723

帖子

0

精华

钻石会员

Rank: 6Rank: 6

积分
2815
发表于 2015-3-26 13:17:49 | 显示全部楼层
我还没试 楼上说鼠标右键时,按下后不能抬起 请检查谢谢

30

主题

125

帖子

0

精华

铂金会员

Rank: 5

积分
1547
发表于 2019-11-1 10:46:50 | 显示全部楼层
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

30

主题

125

帖子

0

精华

铂金会员

Rank: 5

积分
1547
发表于 2019-11-1 11:09:38 | 显示全部楼层
谁能再补充下     鼠标中键。。鼠标滚轮。。的代码?

30

主题

125

帖子

0

精华

铂金会员

Rank: 5

积分
1547
发表于 2019-11-1 11:10:51 | 显示全部楼层
对了,,这个发送 字符串的功能 无法使用!!!类型不匹配啊!!!!!!!!!!!!!!

30

主题

125

帖子

0

精华

铂金会员

Rank: 5

积分
1547
发表于 2019-11-1 11:13:00 | 显示全部楼层
本帖最后由 dabian001 于 2019-11-1 11:15 编辑

还有 键盘命令的 按下 和弹起!!!!!
您需要登录后才可以回帖 登录 | 加入我们

本版积分规则

手机版|Archiver|紫水晶工作室 ( 粤ICP备05020336号 )

GMT+8, 2024-3-29 16:14 , Processed in 0.029506 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表