自编的 模拟按键程序 希望大家给出意见
感觉每次 要用点什么模拟按键一类的东西 由于每次记不住代码 还要查半天 就打算自己做一个类似脚本的东西可以 简化代码 简化操作 这个是初期的制作 功能不全
希望各位大侠给出意见
没找到上传文件 就发源代码吧
还没好好整理过
Private 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)
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_ABSOLUTE = 32768
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
Private Type POINTAPI
x As Long
y As Long
End Type
Dim mousepoint As POINTAPI
Dim n() As String
Dim num As Integer
Private Sub Command1_Click()
mouse_event 32769, 1000, 0, 0, 0
End Sub
Private Sub Command2_Click()
If Timer2.Enabled = True Then Timer2.Enabled = False Else Timer2.Enabled = True
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub Command4_Click()
If Timer1.Enabled = True Then Timer1.Enabled = False Else Timer1.Enabled = True
End Sub
Private Sub Command5_Click()
Open App.Path & "\a.txt" For Input As #1
num = -1
Do While Not EOF(1)
num = num + 1
ReDim Preserve n(num) As String
Line Input #1, n(num)
Loop
Close #1
End Sub
Private Sub Command6_Click()
Set a = CreateObject("wscript.shell")
For i = 0 To num
pro = Split(n(i), " ")
If pro(0) = "sta" Then Shell pro(1), vbNormalFocus
If pro(0) = "mov" Then mouse_event 32769, 65535 * pro(1) / (Screen.Width / 15), 65535 * pro(2) / (Screen.Height / 15), 0, 0
If pro(0) = "clk" Then mouse_event 32775, 65535 * pro(1) / (Screen.Width / 15), 65535 * pro(2) / (Screen.Height / 15), 0, 0
If pro(0) = "rlk" Then mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_RIGHTUP Or MOUSEEVENTF_MOVE, 65535 * pro(1) / (Screen.Width / 15), 65535 * pro(2) / (Screen.Height / 15), 0, 0
If pro(0) = "rgb" Then
If GetPixel(GetDC(0), pro(1), pro(2)) <> pro(3) Then
i = i - rgb1
Sleep pro(4) * 1000
Else
rgb1 = rgb1 + 1
End If
Sleep 50
Else
rgb1 = 1
End If
If pro(0) = "slp" Then Sleep pro(1) * 1000
If pro(0) = "sdk" Then a.SendKeys pro(1)
pro(0) = 0
Next i
End Sub
Private Sub Form_Load()
If Command() <> "" Then
Open Command() For Input As #1
num = -1
Do While Not EOF(1)
num = num + 1
ReDim Preserve n(num) As String
Line Input #1, n(num)
Loop
Close #1
Set a = CreateObject("wscript.shell")
For i = 0 To num
pro = Split(n(i), " ")
If pro(0) = "sta" Then Shell pro(1), vbNormalFocus
If pro(0) = "mov" Then mouse_event 32769, 65535 * pro(1) / 1920, 65535 * pro(2) / 1080, 0, 0
If pro(0) = "clk" Then mouse_event 32775, 65535 * pro(1) / 1920, 65535 * pro(2) / 1080, 0, 0
If pro(0) = "rlk" Then mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_RIGHTUP Or MOUSEEVENTF_MOVE, 65535 * pro(1) / 1920, 65535 * pro(2) / 1080, 0, 0
If pro(0) = "rgb" Then
If GetPixel(GetDC(0), pro(1), pro(2)) <> pro(3) Then
i = i - rgb1
Sleep pro(4) * 1000
Else
rgb1 = rgb1 + 1
End If
Sleep 50
Else
rgb1 = 1
End If
If pro(0) = "slp" Then Sleep pro(1) * 1000
If pro(0) = "sdk" Then a.SendKeys pro(1)
pro(0) = 0
Next i
End
End If
End Sub
Private Sub Timer2_Timer()
Dim h As Long, dc As Long
ldc = GetDC(0)
Label4.Caption = ldc
GetCursorPos mousepoint
Label1.Caption = mousepoint.x
Label2.Caption = mousepoint.y
Label3.BackColor = GetPixel(ldc, mousepoint.x, mousepoint.y)
Label3.Caption = GetPixel(ldc, mousepoint.x, mousepoint.y)
End Sub
*****************************************
label 1-4
command 1-6
timer 2
*****************************************
还需要 注册表设置
HKEY_CLASSES_ROOT
项 .cp = CP(默认 跟下一个项的项名一样 )
项 CP = My Application(默认 随便什么都行 )
子项-- Shell
子项-- open
子项-- command = c:\mydir\my.exe %1(默认)(生成程序所放的目录)
以后只要 用TXT文本 编辑后缀为.cp 就可以了
sta 程序地址(短名) 打开程序
mov x坐标 y坐标 鼠标移动
clk x坐标 y坐标 鼠标左击
rlk x坐标 y坐标 鼠标右击
rgb x坐标 y坐标 坐标颜色 判断延迟(秒) 每隔N秒判断坐标颜色是否正确 可连续判断N点坐标的颜色 连着写即可
slp 延迟(秒) 等待N秒
sdk 输入内容 和SENDKEYS的一样
例子 我打开魔兽 并输入账号
打开软件的地址 需要输入短名 或者地址里不带空格的
sta D:\WORLDO~1\Wow.exe
rgb 904 525 51199 1
rgb 997 519 51199 1
rgb 960 608 51199 1
sdk 账号
sdk {tab}
sdk 密码
sdk {enter}
********************************************
http://dl.twin.walkbox.vip.(程序下载地址)
