Board logo

标题: [问题求助] 【已解决】VBS是不是不能模拟鼠标呀? [打印本页]

作者: c755731262    时间: 2015-2-9 10:13     标题: 【已解决】VBS是不是不能模拟鼠标呀?

本帖最后由 c755731262 于 2015-2-21 06:00 编辑

vbs是不是不能模拟鼠标呀?
作者: yu2n    时间: 2015-2-9 20:35

本帖最后由 yu2n 于 2015-2-9 20:37 编辑

用VBS控制鼠标(获取鼠标坐标、鼠标移动、鼠标单击、鼠标双击、鼠标右击)
http://demon.tw/programming/vbs-control-mouse.html
用VBS控制鼠标(获取鼠标坐标、鼠标移动、鼠标单击、鼠标双击、鼠标右击)
标签: Excel.Application, VB, VBS, VBScript, Windows API, 鼠标

标题: 用VBS控制鼠标(获取鼠标坐标、鼠标移动、鼠标单击、鼠标双击、鼠标右击)
作者: Demon
链接: http://demon.tw/programming/vbs-control-mouse.html
版权: 本博客的所有文章,都遵守“署名-非商业性使用-相同方式共享 2.5 中国大陆”协议条款。

不止一个人问过我怎样用VBS控制鼠标操作,比如:怎么用VBS获取鼠标指针的坐标位置?怎么用VBS移动鼠标?怎么用VBS模拟鼠标左键单击、左键双击、右键单击?……

网上搜到的答案普遍是VBS无法实现,或者是要用第三方COM(ActiveX?)组件。我对第三方组件是很反感的,使用第三方组件毫无可移植性可言,因为别人的系统中不一定注册了这个组件。我的建议是,尽量不要在VBS代码中调用第三方组件,除非你的程序只是写来自己用。(顺便说一下,也尽量不要用不靠谱的Sendkeys方法,原因不解释)


好了,废话就说这么多,现在说说用VBS控制鼠标的方法。我以前写过一篇《VBS调用Windows API函数》,本以为既然都能调用API了,用VBS控制鼠标还不是很简单是事?事实证明我错了,不明真相的同学永远是大多数,不知道API是什么的VBSer大有人在。不贴出实实在在的代码,他们根本不会自己写!

使用此代码的前提是你的系统上安装了Excel,因为要用到Excel.Application对象(如果你偏要认为这算第三方组件我也没话说):
  1. Option Explicit
  2. Dim WshShell
  3. Dim oExcel, oBook, oModule
  4. Dim strRegKey, strCode, x, y
  5. Set oExcel = CreateObject("Excel.Application") '创建 Excel 对象
  6. set WshShell = CreateObject("wscript.Shell")
  7. strRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\$\Excel\Security\AccessVBOM"
  8. strRegKey = Replace(strRegKey, "$", oExcel.Version)
  9. WshShell.RegWrite strRegKey, 1, "REG_DWORD"
  10. Set oBook = oExcel.Workbooks.Add '添加工作簿
  11. Set oModule = obook.VBProject.VBComponents.Add(1) '添加模块
  12. strCode = _
  13. "'Author: Demon"            & vbCrLf & _
  14. "'Website: http://demon.tw" & vbCrLf & _
  15. "'Date: 2011/5/10"          & vbCrLf & _
  16. "Private Type POINTAPI : X As Long : Y As Long : End Type"                                                                                                                            & vbCrLf & _
  17. "Private Declare Function SetCursorPos Lib ""user32"" (ByVal x As Long, ByVal y As Long) As Long"                                                                                     & vbCrLf & _
  18. "Private Declare Function GetCursorPos Lib ""user32"" (lpPoint As POINTAPI) As Long"                                                                                                  & vbCrLf & _
  19. "Private Declare Sub mouse_event Lib ""user32"" Alias ""mouse_event"" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)" & vbCrLf & _
  20. "Public Function GetXCursorPos() As Long"                                                                                                                                             & vbCrLf & _
  21.     "Dim pt As POINTAPI : GetCursorPos pt : GetXCursorPos = pt.X"                                                                                                                     & vbCrLf & _
  22. "End Function"                                                                                                                                                                        & vbCrLf & _
  23. "Public Function GetYCursorPos() As Long"                                                                                                                                             & vbCrLf & _
  24.     "Dim pt As POINTAPI: GetCursorPos pt : GetYCursorPos = pt.Y"                                                                                                                      & vbCrLf & _
  25. "End Function"
  26. oModule.CodeModule.AddFromString strCode '在模块中添加 VBA 代码
  27. 'Author: Demon
  28. 'Website: http://demon.tw
  29. 'Date: 2011/5/10
  30. x = oExcel.Run("GetXCursorPos") '获取鼠标 X 坐标
  31. y = oExcel.Run("GetYCursorPos") '获取鼠标 Y 坐标
  32. WScript.Echo x, y
  33. oExcel.Run "SetCursorPos", 30, 30 '设置鼠标 X Y 坐标
  34. Const MOUSEEVENTF_MOVE       = &H1
  35. Const MOUSEEVENTF_LEFTDOWN   = &H2
  36. Const MOUSEEVENTF_LEFTUP     = &H4
  37. Const MOUSEEVENTF_RIGHTDOWN  = &H8
  38. Const MOUSEEVENTF_RIGHTUP    = &H10
  39. Const MOUSEEVENTF_MIDDLEDOWN = &H20
  40. Const MOUSEEVENTF_MIDDLEUP   = &H40
  41. Const MOUSEEVENTF_ABSOLUTE   = &H8000
  42. '模拟鼠标左键单击
  43. oExcel.Run "mouse_event", MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
  44. '模拟鼠标左键双击(即快速的两次单击)
  45. oExcel.Run "mouse_event", MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
  46. oExcel.Run "mouse_event", MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
  47. '模拟鼠标右键单击
  48. oExcel.Run "mouse_event", MOUSEEVENTF_RIGHTDOWN + MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
  49. '模拟鼠标中键单击
  50. oExcel.Run "mouse_event", MOUSEEVENTF_MIDDLEDOWN + MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
  51. '关闭 Excel
  52. oExcel.DisplayAlerts = False
  53. oBook.Close
  54. oExcel.Quit
复制代码
注释已经够详细了,要知道我很少写注释的,如果还看不懂,说明你的水平有待提高!

作者: CrLf    时间: 2015-2-10 20:15

控制鼠标键盘什么的,建议用 ahk、au3 之类的脚本,实现起来比较简单
作者: c755731262    时间: 2015-2-12 09:05

回复 3# CrLf

难道就没有在windows系统下通用的,不用借助第三方软件的方法么
作者: CrLf    时间: 2015-2-12 15:56

回复 4# c755731262


bat、vbs、js 都不能直接调用 api,也没有自带控制鼠标的功能。
通用的办法就是用 .net 自带的 jsc、vbc、csc 之类的编译工具临时编译一个程序来控制鼠标...
你什么系统?有装 powershell 的话可以考虑这个:http://www.pstips.net/automation ... nd-mouse-click.html
作者: 9zhmke    时间: 2015-2-12 23:46

如果需要在XP或者更低版本的WINDOWS中实现鼠标功能,建议调用按键精灵大漠插件免费版的dm.dll文件来实现,我试用过感觉还过得去。
作者: c755731262    时间: 2015-2-17 08:30

回复 5# CrLf

好像VB和C++可以控制鼠标,但麻烦些,不能通用在windows系统下,好像要在别的机器上安装些文件
作者: 9zhmke    时间: 2015-3-25 21:15

回复 7# c755731262


    用大漠吧,可以在VBS内自注册:完整的程序请参考这里:http://bbs.dp168.com/thread-102239-1-1.html
  1.     On Error Resume Next
  2.         .write "'注册大漠<br>"
  3.         Set dm= CreateObject("dm.dmsoft")
  4.         base_path = dm.GetBasePath() '检查是否注册大漠组件dm.dll,以更好支持鼠标、窗口、OCR等功能
  5.         If base_path="" Then
  6.             Mark="" '检查文件是否齐全
  7.             .write progfolder & "\dm.dll"
  8.             if not objFSO.FileExists ("c:\windows\system32\dm.dll") then
  9.                   Mark=progfolder
  10.                   .write "'复制大漠组件<br>"
  11.                   if not objFSO.FileExists (Mark & "\dm.dll") then Mark="k:"
  12.                   if not objFSO.FileExists (Mark & "\dm.dll") then msgbox "找不到dm组件,请把大漠组件复制入K盘。":ie.quit:wscript.quit
  13.                   objFSO.copyfile Mark & "\dm.dll","c:\windows\system32\","True"
  14.                   objFSO.movefile progfolder & "\dm.dll","c:\windows\system32\"  '将下面三个文件移动到%ProgramFiles%,system32可能没权限
  15.                   if not objFSO.FileExists ("c:\windows\system32\dm.dll") then msgbox ("复制失败")
  16.                   .write "'已复制"
  17.             end if
  18.             .write "'  正在注册"
  19.             ws.Run "regsvr32"&" /S "& chr(34) & "dm.dll" & chr(34) '因没有注册大漠组件dm.dll
  20.             .write "重新运行"& chr(34) & Wscript.scriptfullname & chr(34) & "<br>"
  21.             ws.Run "wscript.exe "& chr(34) & Wscript.scriptfullname & chr(34) '重新运行并退出
  22.             objFSO.deleteFile ws.CurrentDirectory & "dm.dll"
  23.             .write "'  注册完成,正在退出"
  24.             wscript.sleep 30000
  25.             ie.quit:wscript.quit
  26.         End If
  27.     On error goto 0
  28.     .write "'大漠组件正常<br>"
  29.     'ws.CurrentDirectory = progfolder & "\"
  30.     dm.SetPath progfolder  & "\"'设programfile文件夹为DM默认工作文件夹
  31.     Set dm= CreateObject("dm.dmsoft")
  32.     base_path = dm.GetBasePath()
  33.     dm.SetPath prog
复制代码





欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2