[vb]键盘精灵

这个代码比较不错，保留一下：

[源码]VB 类按键精灵源码[2007-8-22]

窗体部分
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