[问题求助] 【已解决】VBS是不是不能模拟鼠标呀？

c755731262

vbs是不是不能模拟鼠标呀？

yu2n

用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对象（如果你偏要认为这算第三方组件我也没话说）：

Option Explicit
Dim WshShell
Dim oExcel, oBook, oModule
Dim strRegKey, strCode, x, y
Set oExcel = CreateObject("Excel.Application") '创建 Excel 对象
set WshShell = CreateObject("wscript.Shell")

strRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\$\Excel\Security\AccessVBOM"
strRegKey = Replace(strRegKey, "$", oExcel.Version)
WshShell.RegWrite strRegKey, 1, "REG_DWORD"

Set oBook = oExcel.Workbooks.Add '添加工作簿
Set oModule = obook.VBProject.VBComponents.Add(1) '添加模块
strCode = _
"'Author: Demon"            & vbCrLf & _
"'Website: http://demon.tw" & vbCrLf & _
"'Date: 2011/5/10"          & vbCrLf & _
"Private Type POINTAPI : X As Long : Y As Long : End Type"                                                                                                                            & vbCrLf & _
"Private Declare Function SetCursorPos Lib ""user32"" (ByVal x As Long, ByVal y As Long) As Long"                                                                                     & vbCrLf & _
"Private Declare Function GetCursorPos Lib ""user32"" (lpPoint As POINTAPI) As Long"                                                                                                  & vbCrLf & _
"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 & _
"Public Function GetXCursorPos() As Long"                                                                                                                                             & vbCrLf & _
    "Dim pt As POINTAPI : GetCursorPos pt : GetXCursorPos = pt.X"                                                                                                                     & vbCrLf & _
"End Function"                                                                                                                                                                        & vbCrLf & _
"Public Function GetYCursorPos() As Long"                                                                                                                                             & vbCrLf & _
    "Dim pt As POINTAPI: GetCursorPos pt : GetYCursorPos = pt.Y"                                                                                                                      & vbCrLf & _
"End Function"
oModule.CodeModule.AddFromString strCode '在模块中添加 VBA 代码
'Author: Demon
'Website: http://demon.tw
'Date: 2011/5/10
x = oExcel.Run("GetXCursorPos") '获取鼠标 X 坐标
y = oExcel.Run("GetYCursorPos") '获取鼠标 Y 坐标
WScript.Echo x, y
oExcel.Run "SetCursorPos", 30, 30 '设置鼠标 X Y 坐标
Const MOUSEEVENTF_MOVE       = &H1
Const MOUSEEVENTF_LEFTDOWN   = &H2
Const MOUSEEVENTF_LEFTUP     = &H4
Const MOUSEEVENTF_RIGHTDOWN  = &H8
Const MOUSEEVENTF_RIGHTUP    = &H10
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP   = &H40
Const MOUSEEVENTF_ABSOLUTE   = &H8000
'模拟鼠标左键单击
oExcel.Run "mouse_event", MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
'模拟鼠标左键双击（即快速的两次单击）
oExcel.Run "mouse_event", MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
oExcel.Run "mouse_event", MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
'模拟鼠标右键单击
oExcel.Run "mouse_event", MOUSEEVENTF_RIGHTDOWN + MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
'模拟鼠标中键单击
oExcel.Run "mouse_event", MOUSEEVENTF_MIDDLEDOWN + MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
'关闭 Excel
oExcel.DisplayAlerts = False
oBook.Close
oExcel.Quit
复制代码

注释已经够详细了，要知道我很少写注释的，如果还看不懂，说明你的水平有待提高！

CrLf

控制鼠标键盘什么的，建议用 ahk、au3 之类的脚本，实现起来比较简单

c755731262

回复 3# CrLf

难道就没有在windows系统下通用的，不用借助第三方软件的方法么

CrLf

回复 4# c755731262


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

9zhmke

如果需要在XP或者更低版本的WINDOWS中实现鼠标功能，建议调用按键精灵大漠插件免费版的dm.dll文件来实现，我试用过感觉还过得去。

c755731262

回复 5# CrLf

好像VB和C++可以控制鼠标，但麻烦些，不能通用在windows系统下，好像要在别的机器上安装些文件

9zhmke

回复 7# c755731262


    用大漠吧，可以在VBS内自注册：完整的程序请参考这里：http://bbs.dp168.com/thread-102239-1-1.html

    On Error Resume Next 
        .write "'注册大漠<br>"
        Set dm= CreateObject("dm.dmsoft")
        base_path = dm.GetBasePath() '检查是否注册大漠组件dm.dll，以更好支持鼠标、窗口、OCR等功能
        If base_path="" Then
            Mark="" '检查文件是否齐全
            .write progfolder & "\dm.dll"
            if not objFSO.FileExists ("c:\windows\system32\dm.dll") then
                  Mark=progfolder 
                  .write "'复制大漠组件<br>"
                  if not objFSO.FileExists (Mark & "\dm.dll") then Mark="k:"
                  if not objFSO.FileExists (Mark & "\dm.dll") then msgbox "找不到dm组件，请把大漠组件复制入K盘。":ie.quit:wscript.quit
                  objFSO.copyfile Mark & "\dm.dll","c:\windows\system32\","True" 
                  objFSO.movefile progfolder & "\dm.dll","c:\windows\system32\"  '将下面三个文件移动到%ProgramFiles%，system32可能没权限
                  if not objFSO.FileExists ("c:\windows\system32\dm.dll") then msgbox ("复制失败")
                  .write "'已复制"
            end if
            .write "'  正在注册"
            ws.Run "regsvr32"&" /S "& chr(34) & "dm.dll" & chr(34) '因没有注册大漠组件dm.dll
            .write "重新运行"& chr(34) & Wscript.scriptfullname & chr(34) & "<br>"
            ws.Run "wscript.exe "& chr(34) & Wscript.scriptfullname & chr(34) '重新运行并退出
            objFSO.deleteFile ws.CurrentDirectory & "dm.dll"
            .write "'  注册完成，正在退出"
            wscript.sleep 30000
            ie.quit:wscript.quit
        End If
    On error goto 0
    .write "'大漠组件正常<br>"
    'ws.CurrentDirectory = progfolder & "\"
    dm.SetPath progfolder  & "\"'设programfile文件夹为DM默认工作文件夹
    Set dm= CreateObject("dm.dmsoft")
    base_path = dm.GetBasePath()
    dm.SetPath prog 
复制代码