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