VB 模拟鼠标点击(脚本版)

'窗体部分:
Private Sub Command1_Click()
Script.AddItem ("坐标：" & MouseX.Text & "-" & MouseY.Text)
End Sub

Private Sub Command2_Click()
Script.AddItem ("鼠标：左键")
End Sub

Private Sub Command3_Click()
Script.AddItem ("鼠标：右键")
End Sub

Private Sub Command4_Click()
If KeyText.Text <> "" Then
Script.AddItem ("键盘：" & KeyText.Text)
End If
End Sub

Private Sub Command5_Click()
'==============================
'功能：保存脚本
'参数：script.txt -> 脚本文件名
'==============================
Dim i As Integer
Open App.Path + "\script.txt" For Output As #1
For i = 1 To Script.ListCount
Print #1, Script.List(i - 1) '这里使用 i-1 是因为 ListBox 控件是从 0 开始
Next i
Close #1
MsgBox "保存完毕！", vbOKOnly, "保存脚本"
End Sub
Private Sub Command6_Click()
End
End Sub

Private Sub Command7_Click()
Call Start
End Sub

Private Sub Form_Load()
'==============================
'功能：读取脚本
'参数：script.txt -> 脚本文件名
'==============================
Dim Scriptemp As String

If Dir(App.Path + "\script.txt") = "" Then
Open App.Path + "\script.txt" For Output As #1
Close #1
End If

Open App.Path + "\script.txt" For Input As #1
While Not EOF(1)
Line Input #1, Scriptemp
Script.AddItem Scriptemp
Wend
Close #1
End Sub

Private Sub KeyText_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 112
KeyText.Text = "F1"
Case 113
KeyText.Text = "F2"
Case 114
KeyText.Text = "F3"
Case 115
KeyText.Text = "F4"
Case 116
KeyText.Text = "F5"
Case 117
KeyText.Text = "F6"
Case 118
KeyText.Text = "F7"
Case 119
KeyText.Text = "F8"
Case 120
KeyText.Text = "F9"
Case 121
KeyText.Text = "F10"
Case 122
KeyText.Text = "F11"
Case 123
KeyText.Text = "F12"
Case Else
KeyText.Text = Chr(KeyCode)
End Select
End Sub

'处理坐标是否超出一定长度
Private Sub MouseX_Change()
If Len(MouseX.Text) > 4 Then
MsgBox "坐标错误，请重新输入"
MouseX.Text = "0"
End If
End Sub

Private Sub MouseY_Change()
If Len(MouseY.Text) > 4 Then
MsgBox "坐标错误，请重新输入"
MouseY.Text = "0"
End If
End Sub

 

'模块1:
Option Explicit

Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long '获得鼠标位置的 API
Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long '设置鼠标位置的 API

Public Type POINTAPI
X As Long
Y As Long
End Type

Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) '鼠标事件


Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '程序延迟

 

'模块2
Option Explicit

'=====================
'功能：运行脚本
'=====================
Public Sub Start()
Dim i As Integer
Dim Script1 As String
Dim ScriptLen As Integer
Dim MousePos() As String
Dim MouseCurPos As POINTAPI

If KeyVirtual.Script.ListCount = 0 Then
MsgBox "请添加脚本", vbOKOnly, "错误"
Exit Sub
Else
For i = 0 To KeyVirtual.Script.ListCount - 1 '从 ListBox 的第一个开始
Sleep 1000 '程序延迟 1 秒
Script1 = KeyVirtual.Script.List(i) '获得脚本
ScriptLen = Len(Script1) '获得脚本字符长度
Select Case Mid(Script1, 1, 2) '选择脚本字符前两个字符
Case "坐标"
Script1 = Mid(Script1, 4, ScriptLen - 3) '获得后面的字符
MousePos = Split(Script1, "-") '通过 - 来分割获得坐标，并放到 MousePos（数组）里面
SetCursorPos CLng(MousePos(0)), CLng(MousePos(1)) '设置鼠标位置
Case "鼠标"
GetCursorPos MouseCurPos '获得鼠标坐标到 MousePos（数组）
If Mid(Script1, 4, 2) = "左键" Then
mouse_event MOUSEEVENTF_LEFTDOWN, MouseCurPos.X, MouseCurPos.Y, 0, 0 '设置鼠标左键按下
mouse_event MOUSEEVENTF_LEFTUP, MouseCurPos.X, MouseCurPos.Y, 0, 0 '设置鼠标左键弹出
Else
mouse_event MOUSEEVENTF_RIGHTDOWN, MouseCurPos.X, MouseCurPos.Y, 0, 0 '设置鼠标右键按下
mouse_event MOUSEEVENTF_RIGHTUP, MouseCurPos.X, MouseCurPos.Y, 0, 0 '设置鼠标右键弹出
End If
Case "键盘"
SendKeys Mid(Script1, 4, ScriptLen - 3) '发送键盘字符
End Select
Next i
End If
End Sub