上一篇
下一篇
模拟鼠标点击(脚本版)
作者:JiaJia 日期:2008-03-04
引用内容'窗体部分:
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
'模块部分:
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
文章来自: 
引用通告: 
Tags: 评论: 0 | 引用: 0 | 查看次数: -
发表评论