技术宅的结界

 找回密码
 立即注册→加入我们

QQ登录

只需一步,快速开始

搜索
热搜: 下载 VB C 实现 编写
查看: 4952|回复: 23
收起左侧

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

[复制链接]

85

主题

263

帖子

3637

积分

用户组: 管理员

No. 418

UID
418
精华
13
威望
52 点
宅币
1969 个
贡献
1236 次
宅之契约
0 份
在线时间
252 小时
注册时间
2014-8-9
发表于 2015-5-2 01:17:01 | 显示全部楼层 |阅读模式

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

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

x
来来来,让我们做一个“按键精灵”
这第一步嘛,确定软件功能及架构
什么样的按键精灵呢?因为咱们都是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)
[Visual Basic] 纯文本查看 复制代码
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

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

源码回复可见下载地址:

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

本帖被以下淘专辑推荐:

In the beginning I was not the best.
And the world was also not the best.
But I still know that I am who I am.
Because I think that it is good.
I have been working hard.
I have been keeping growth with the world.
And it was so.

0

主题

1

帖子

10

积分

用户组: 初·技术宅

UID
1340
精华
0
威望
1 点
宅币
7 个
贡献
0 次
宅之契约
0 份
在线时间
0 小时
注册时间
2015-12-18
发表于 2015-12-18 02:51:53 | 显示全部楼层
  謝謝大大的教學  讓我又多學了一課

1

主题

5

帖子

17

积分

用户组: 初·技术宅

UID
1819
精华
0
威望
1 点
宅币
10 个
贡献
0 次
宅之契约
0 份
在线时间
0 小时
注册时间
2016-7-11
发表于 2016-7-11 11:41:02 | 显示全部楼层
】老C带你写一个“按键精灵”

0

主题

8

帖子

27

积分

用户组: 初·技术宅

UID
2163
精华
0
威望
0 点
宅币
19 个
贡献
0 次
宅之契约
0 份
在线时间
1 小时
注册时间
2017-1-5
发表于 2017-1-5 10:45:26 | 显示全部楼层
感谢大神,学习了。

0

主题

8

帖子

27

积分

用户组: 初·技术宅

UID
2163
精华
0
威望
0 点
宅币
19 个
贡献
0 次
宅之契约
0 份
在线时间
1 小时
注册时间
2017-1-5
发表于 2017-1-5 10:46:03 | 显示全部楼层
感谢大神,在此学习了。

0

主题

4

帖子

14

积分

用户组: 初·技术宅

UID
2282
精华
0
威望
1 点
宅币
8 个
贡献
0 次
宅之契约
0 份
在线时间
0 小时
注册时间
2017-2-25
发表于 2017-2-25 19:43:51 | 显示全部楼层
学习学习,再学习

0

主题

1

帖子

9

积分

用户组: 初·技术宅

UID
2612
精华
0
威望
0 点
宅币
8 个
贡献
0 次
宅之契约
0 份
在线时间
0 小时
注册时间
2017-6-20
发表于 2017-6-20 16:09:37 | 显示全部楼层
Very Nice!很感谢分享代码!

0

主题

1

帖子

17

积分

用户组: 初·技术宅

UID
2628
精华
0
威望
0 点
宅币
16 个
贡献
0 次
宅之契约
0 份
在线时间
3 小时
注册时间
2017-6-27
发表于 2017-6-28 21:56:00 | 显示全部楼层
新人想问一下,要是写一个脚本的话,是在计事本上运行?那怎么做出一个应用般的界面?

0

主题

1

帖子

10

积分

用户组: 初·技术宅

UID
2850
精华
0
威望
1 点
宅币
7 个
贡献
0 次
宅之契约
0 份
在线时间
0 小时
注册时间
2017-9-8
发表于 2017-9-8 22:29:07 | 显示全部楼层
6666666666666666666666666666

1

主题

15

帖子

15

积分

用户组: 初·技术宅

UID
2735
精华
0
威望
0 点
宅币
0 个
贡献
0 次
宅之契约
0 份
在线时间
6 小时
注册时间
2017-7-28
发表于 2017-10-16 12:18:24 | 显示全部楼层

感谢大神,在此学习了。

0

主题

6

帖子

25

积分

用户组: 初·技术宅

UID
2974
精华
0
威望
2 点
宅币
15 个
贡献
0 次
宅之契约
0 份
在线时间
4 小时
注册时间
2017-10-18
发表于 2017-10-18 12:30:42 | 显示全部楼层
太牛了,谢谢分享

0

主题

4

帖子

16

积分

用户组: 初·技术宅

UID
3125
精华
0
威望
1 点
宅币
10 个
贡献
0 次
宅之契约
0 份
在线时间
0 小时
注册时间
2017-11-22
发表于 2017-11-26 09:51:01 | 显示全部楼层
求大神代码研究

0

主题

4

帖子

16

积分

用户组: 初·技术宅

UID
3125
精华
0
威望
1 点
宅币
10 个
贡献
0 次
宅之契约
0 份
在线时间
0 小时
注册时间
2017-11-22
发表于 2017-11-26 09:52:48 | 显示全部楼层
我想问下下载密码多少?

0

主题

19

帖子

71

积分

用户组: 小·技术宅

UID
2399
精华
0
威望
0 点
宅币
52 个
贡献
0 次
宅之契约
0 份
在线时间
17 小时
注册时间
2017-4-12
发表于 2017-12-23 17:30:05 | 显示全部楼层
受教了。谢谢

0

主题

41

帖子

45

积分

用户组: 初·技术宅

UID
3351
精华
0
威望
2 点
宅币
0 个
贡献
0 次
宅之契约
0 份
在线时间
0 小时
注册时间
2018-1-14
发表于 2018-1-14 12:54:58 | 显示全部楼层
支持楼主!!
回复

使用道具 举报

0

主题

1

帖子

15

积分

用户组: 初·技术宅

UID
3662
精华
0
威望
2 点
宅币
10 个
贡献
0 次
宅之契约
0 份
在线时间
0 小时
注册时间
2018-4-3
发表于 2018-4-3 10:09:09 | 显示全部楼层
学习学习
回复

使用道具 举报

0

主题

14

帖子

47

积分

用户组: 初·技术宅

UID
3807
精华
0
威望
2 点
宅币
29 个
贡献
0 次
宅之契约
0 份
在线时间
3 小时
注册时间
2018-5-5
发表于 2018-5-6 07:19:19 | 显示全部楼层
前台按键.哈哈.有点用

0

主题

1

帖子

9

积分

用户组: 初·技术宅

UID
3917
精华
0
威望
0 点
宅币
8 个
贡献
0 次
宅之契约
0 份
在线时间
0 小时
注册时间
2018-5-28
发表于 2018-5-28 15:11:09 | 显示全部楼层
想學一下,謝謝大大

0

主题

1

帖子

9

积分

用户组: 初·技术宅

UID
4239
精华
0
威望
0 点
宅币
8 个
贡献
0 次
宅之契约
0 份
在线时间
0 小时
注册时间
2018-9-3
发表于 2018-9-3 09:07:43 | 显示全部楼层
学习了,谢谢大佬

0

主题

34

帖子

105

积分

用户组: 小·技术宅

UID
1457
精华
0
威望
2 点
宅币
67 个
贡献
0 次
宅之契约
0 份
在线时间
6 小时
注册时间
2016-1-29
发表于 2018-9-15 00:09:21 | 显示全部楼层
这个我之前看人写过

本版积分规则

QQ|申请友链||Archiver|手机版|小黑屋|技术宅的结界 ( 滇ICP备16008837号|网站地图

GMT+8, 2019-6-19 13:53 , Processed in 0.125904 second(s), 37 queries , Gzip On.

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表