【vb】老C带你写一个“按键精灵”

cyycoish · 发表于 2015-5-2 01:17:01

欢迎访问技术宅的结界，请注册或者登录吧。

您需要登录才可以下载或查看，没有账号？立即注册→加入我们

×

来来来，让我们做一个“按键精灵”
这第一步嘛，确定软件功能及架构
什么样的按键精灵呢？因为咱们都是vb初学者，先来个简单的
能模拟大部分键盘按键，和鼠标按键即可---目标确定
然后是架构问题，大家不要小看架构这两个字。
虽然老C木有学过《软件工程》但是凭开发经验一个软件的架构决定了软件生存周期的长短
一个好的架构，可以使软件可维护性大大增强。
我是这样决定的：制作一个脚本解释器，用来解释按键脚本。然后做一个界面友好的编辑器
将按键方式以脚本保存在文件中，编辑器的运行功能来调用解释器将按键脚本加以解释。
好的，既然涉及到脚本，我们不妨先来想想用何种脚本语言
那都说了，我们是初学者，老C不会让大家制作一个vbs或者js的解释器，我所想象的脚本，大概是这样：
命令    参数规定             例
:       一个字符串加“:”即为 a:
            行号
fc       为一个窗口标题,程序运行 fc 无标题 - 记事本
            时会激活这个窗口。
cl       设置一个运算器的值
            “==”初始化cl的值    cl == 1
            “-=”cl = cl - 值    cl += 2
            “*=”cl = cl * 值    cl -= 5
            “/=”cl = cl / 值    cl /= 5
sk       为一个或多个按键。
            特殊功能键：对于    sk a
            需要与Shift、Ctrl、Alt sk abc
               三个控制键组合的按键， sk ^
                  XSendKeys使用特殊字符 sk ^({f4})
               来表示：Shift - +； sk {down}
               Ctrl - ^；Alt - %。 sk {a 10}
            如要发送的组合按键是同 sk {cl}
               时按下Ctrl＋E，用 ^e
               表示，如果要发送的组合
               按键是按住Ctrl键的同时
               按下E与C两个键，这时应
               使用小括号把字母键括起
               来，书写格式为 ^(ec)。
               注意 ^(ec)与 ^ec 的区
               别，后者表示组合按键是
               同时按住Ctrl和E键，然
               后松开Ctrl键，单独按下
               “C”字母键。
            由于“+”、“^”这些字
               符用来表示特殊的控制按
               键了，如何表示这些按键
               呢？只要用大括号括住这
               些字符即可。例如，要发
               送加号“+”，
               可使用 {+}
            对于一些不会生成字符的
            控制功能按键，也同样需
               要使用大括号括起来按键
               的名称，例如要发送回车
               键，需要用 {ENTER} 表
               示，发送向下的方向键用
                  {DOWN} 表示。
               如果需要发送多个重复的
               单字母按键，不必重复输
               入该字母，XSendKeys允
               许使用简化格式进行描述
               ，使用格式为
               “{按键数字}”，例如要
               发送10个字母“x”，则
               输入 {x 10} 即可。
               若要发送一个运算器的值
               则输入{cl}即可。
sl       sl加一个数字是暂停几个 sl 100
            毫秒
mp       该命令将鼠标移至某位置 mp 1000,200
            第一个参数是鼠标的x 值
            第二个参数是鼠标的y 值
mc       模拟鼠标按键，l是鼠标  mc l
            左键，r是鼠标右键    mc r
if goto if 整数 goto 行号
            如果循环次数小于整数就
            转至行号，否则执行下面
            的语句。如果整数为零则
            执行死循环。
例子
begin:
fc a.xss - 记事本
cl == 5
sk ^({f4})
a:
cl += 1
sk {cl}
sl 2000
mp 2000,3
mc l
if 3 goto a:
end:

这个例子表示：激或标题为“a.xss - 记事本”的窗体，将运算器的初值设为“5”
然后发送按键Alt + F4，再将运算器的值加一，发送运算器的值，接着暂停2000毫秒（2秒）
将鼠标移至x为2000，y为3之处按下鼠标左键，如果循环次数小于3就转到“a:”处执行

好了，有了详尽的语法规定，我们可以来写解释器了（有没有发现老C在偷懒：sk就是vb sendkeys的用法：P）

Attribute VB_Name = "XSSMain"
Option Explicit
'定义要用到的api
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
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 SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
Dim fso As FileSystemObject
Dim fNameS As String
Sub Main()
On Error GoTo ErrH
Dim f As Object
Dim prog() As String
Dim cL As Double
Dim ctr() As Long
Dim loopCtr As Long
Dim ifShowLine() As Long
'用fso来读取文件
Set fso = CreateObject("Scripting.FileSystemObject")
'将传入的文件位置给fnames变量
fNameS = Command$
If Not fso.FileExists(fNameS) Then
ErrorMsg "文件未找到", 101
End
End If
Dim i As Long
Dim s1 As String
Dim s3 As String
i = 0
loopCtr = 0
'以下是解释器错误处理
Set f = fso.OpenTextFile(fNameS, ForReading, False)
Do Until f.AtEndOfStream
ReDim Preserve prog(i) As String
prog(i) = f.ReadLine
s1 = LCase(prog(i))
Select Case Mid(s1, 1, 2)
Case "fc"
If FindWindow(vbNullString, Mid(s1, InStr(s1, " ") + 1)) = 0 Then
ErrorMsg "未找到标题为 " & Mid(s1, InStr(s1, " ") + 1) & " 的窗口" & vbCrLf & "行:" & i + 1 & vbCrLf & "源:" & fNameS, 102
End
End If
Case "cl"
s3 = Mid(s1, InStr(s1, " ") + 1, 2)
If (s3 <> "+=") And (s3 <> "-=") And (s3 <> "*=") And (s3 <> "/=") And (s3 <> "==") Then
ErrorMsg "运算符错误" & vbCrLf & "行:" & i + 1 & vbCrLf & "源:" & fNameS, 103
End
End If
If Not IsNumeric(Mid(s1, InStr(s1, " ") + 3)) Then
ErrorMsg "非法赋值" & vbCrLf & "行:" & i + 1 & vbCrLf & "源:" & fNameS, 104
End
End If
Case "sl"
If Not IsNumeric(Mid(s1, 3)) Then
ErrorMsg "非有效数字" & vbCrLf & "行:" & i + 1 & vbCrLf & "源:" & fNameS, 105
End
End If
Case "mp"
If (Not IsNumeric(Mid(s1, InStr(s1, " "), InStr(s1, ",") - 3))) Or (Not IsNumeric(Mid(s1, InStr(s1, ",") + 1))) Then
ErrorMsg "非有效数字" & vbCrLf & "行:" & i + 1 & vbCrLf & "源:" & fNameS, 105
End
End If
Case "mc"
If (Mid(s1, 4) <> "l") And (Mid(s1, 4) <> "r") Then
ErrorMsg "非可用的鼠标按键" & vbCrLf & "行:" & i + 1 & vbCrLf & "源:" & fNameS, 106
End
End If
Case "if"
ReDim ctr(loopCtr) As Long
ReDim Preserve ifShowLine(loopCtr) As Long
ifShowLine(loopCtr) = i
loopCtr = loopCtr + 1
s3 = Mid(s1, 4)
If Not IsNumeric(Mid(s3, 1, InStr(1, s3, " ") - 1)) Then
ErrorMsg "非有效数字" & vbCrLf & "行:" & i + 1 & vbCrLf & "源:" & fNameS, 105
End
End If
End Select
i = i + 1
Loop
f.Close
loopCtr = 0
Dim j As Long
'这是解释器执行核心，原理很简单，大家应该看得懂
For i = 0 To UBound(prog)
s1 = LCase(prog(i))
Select Case Mid(s1, 1, 2)
Case "sk"
SendKeys Replace(Mid(s1, InStr(s1, " ") + 1), "{cl}", cL), True
Case "fc"
Dim hwndA As Long
hwndA = FindWindow(vbNullString, Mid(s1, InStr(s1, " ") + 1))
If hwndA <> 0 Then
SetForegroundWindow hwndA
Else
ErrorMsg "未找到标题为 " & Mid(s1, InStr(s1, " ") + 1) & " 的窗口" & vbCrLf & "行:" & i + 1 & vbCrLf & "源:" & fNameS, 102
End
End If
Case "sl"
Sleep (CLng(Mid(s1, 3)))
Case "mp"
SetCursorPos CLng(Mid(s1, InStr(s1, " "), InStr(s1, ",") - 3)), CLng(Mid(s1, InStr(s1, ",") + 1))
Case "mc"
If Mid(s1, 4) = "l" Then
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
ElseIf Mid(s1, 4) = "r" Then
mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End If
Case "if"
s3 = Mid(s1, 4)
If Val(Mid(s3, 1, InStr(1, s3, " ") - 1)) <> 0 Then
If ctr(loopCtr) + 1 < Val(Mid(s3, 1, InStr(1, s3, " ") - 1)) Then
For j = 0 To UBound(prog)
If prog(j) = Mid(s1, InStr(1, s1, "goto") + 5) Then
i = j
End If
Next
Else
If i <> ifShowLine(loopCtr) Then
loopCtr = loopCtr + 1
ctr(loopCtr - 1) = 0
End If
End If
ctr(loopCtr) = ctr(loopCtr) + 1
Else
MsgBox Mid(s1, InStr(1, s1, "goto") + 5)
For j = 0 To UBound(prog)
If prog(j) = Mid(s1, InStr(1, s1, "goto") + 5) Then
i = j
End If
Next
End If
Case "cl"
s3 = Mid(s1, InStr(s1, " ") + 1, 2)
Select Case s3
Case "=="
cL = Val(Mid(s1, InStr(s1, " ") + 3))
Case "+="
cL = cL + Val(Mid(s1, InStr(s1, " ") + 3))
Case "-="
cL = cL - Val(Mid(s1, InStr(s1, " ") + 3))
Case "*="
cL = cL * Val(Mid(s1, InStr(s1, " ") + 3))
Case "/="
cL = cL / Val(Mid(s1, InStr(s1, " ") + 3))
End Select
End Select
Next
ErrH:'未知错误处理
If Err <> 0 Then ErrorMsg vbCrLf & Err.Description, Err.Number
End Sub
Function ErrorMsg(inpStr As String, errNum As Integer)
ErrorMsg = MsgBox("错误:" & errNum & vbCrLf & inpStr, vbOKOnly + vbCritical, "XSendKeys")
End Function

复制代码

接下来的任务是做一个脚本编辑器：
关于怎样用vb编写一个记事本，老C在这篇帖子有详尽细数，
【入门向】Counterfeit Notepad
http://www.0xaa55.com/forum.php? ... 109&fromuid=418
(出处: 技术宅的结界)

脚本编辑器，无非是在记事本中添加运行功能，这里不再赘述
界面大致做成这样即可：
捕获.PNG

好了，在编辑器中写一个自己的脚本试试吧

源码回复可见下载地址：

游客，如果您要查看本帖隐藏内容请回复

米古月 · 发表于 2015-12-18 02:51:53

謝謝大大的教學讓我又多學了一課

uudesn · 发表于 2016-7-11 11:41:02

】老C带你写一个“按键精灵”

qytom · 发表于 2017-1-5 10:45:26

感谢大神，学习了。

qytom · 发表于 2017-1-5 10:46:03

感谢大神，在此学习了。

tbage2012 · 发表于 2017-2-25 19:43:51

学习学习，再学习

LiquidHero · 发表于 2017-6-20 16:09:37

Very Nice!很感谢分享代码!

风城烟沐 · 发表于 2017-6-28 21:56:00

新人想问一下，要是写一个脚本的话，是在计事本上运行？那怎么做出一个应用般的界面？

rrreee · 发表于 2017-9-8 22:29:07

6666666666666666666666666666

cxx · 发表于 2017-10-16 12:18:24

感谢大神，在此学习了。

二十六 · 发表于 2017-10-18 12:30:42

太牛了，谢谢分享

dedefans · 发表于 2017-11-26 09:51:01

求大神代码研究

dedefans · 发表于 2017-11-26 09:52:48

我想问下下载密码多少？

dsm · 发表于 2017-12-23 17:30:05

受教了。谢谢

7KY6 · 发表于 2018-1-14 12:54:58

支持楼主!!

qaxecc · 发表于 2018-4-3 10:09:09

学习学习

xxdoc · 发表于 2018-5-6 07:19:19

前台按键.哈哈.有点用

annpan88 · 发表于 2018-5-28 15:11:09

想學一下，謝謝大大

fz493254090 · 发表于 2018-9-3 09:07:43

学习了，谢谢大佬

搬砖工 · 发表于 2018-9-15 00:09:21

这个我之前看人写过

账号		自动登录	找回密码
密码			立即注册→加入我们

【vb】老C带你写一个“按键精灵”

欢迎访问技术宅的结界，请注册或者登录吧。

本帖被以下淘专辑推荐: