Option Explicit
'公用计数变量
Dim i As Integer
Dim B As Integer
Dim S As Integer
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) 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 Const MOUSEEVENTF_ABSOLUTE = &H8000 '  absolute move
Private Const MOUSEEVENTF_LEFTDOWN = &H2 '  left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 '  left button up
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 '  middle button down
Private Const MOUSEEVENTF_MIDDLEUP = &H40 '  middle button up
Private Const MOUSEEVENTF_MOVE = &H1 '  mouse move
Private Const MOUSEEVENTF_RIGHTDOWN = &H8 '  right button down
Private Const MOUSEEVENTF_RIGHTUP = &H10 '  right button up
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Integer) As Integer
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Const GW_CHILD = 5
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDLAST = 1
Private Const GW_HWNDNEXT = 2
Private Const GW_HWNDPREV = 3
Private Const GW_OWNER = 4
'GW_CHILD 寻找源窗口的第一个子窗口
'GW_HWNDFIRST 为一个源子窗口寻找第一个兄弟（同级）窗口，或寻找第一个顶级窗口
'GW_HWNDLAST 为一个源子窗口寻找最后一个兄弟（同级）窗口，或寻找最后一个顶级窗口
'GW_HWNDNEXT 为源窗口寻找下一个兄弟窗口
'GW_HWNDPREV 为源窗口寻找前一个兄弟窗口
'GW_OWNER 寻找窗口的所有者

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub FindTitle()
    '查找桌面上的所有窗口标题
    Dim Current_hwnd As Long
    Dim Length As Integer
    Dim ListItem As String
    Combo1.Clear
    Current_hwnd = GetWindow(hwnd, GW_HWNDFIRST) '首先获得第一个顶层窗口句柄
    While Current_hwnd <> 0
        Length = GetWindowTextLength(Current_hwnd) '窗口标题的长度
        ListItem = Space(Length + 1) '得到和窗口标题长度+1的口字符串(全是空格)
        Length = GetWindowText(Current_hwnd, ListItem, Length + 1) '得到窗口字符串
        If Length > 0 Then
            Combo1.AddItem ListItem '添加窗口标题，无标题的窗口不用添加了。
        End If
        Current_hwnd = GetWindow(Current_hwnd, GW_HWNDNEXT) '得到下一个窗口句柄
        If Combo1.ListCount > 0 Then
            Combo1.Text = Combo1.List(0)
            Combo1.ListIndex = 0
        End If
    Wend
End Sub
Sub Sift()
    '测试窗口能否活动
    Dim m As Integer
    m = 0
    Combo2.Clear
    Do
        On Local Error Resume Next
        AppActivate Combo1.List(m)
        If Err = 0 Then
            Combo2.AddItem Combo1.List(m)
        End If
        m = m + 1
    Loop Until m = Combo1.ListCount - 1
    AppActivate Form1.Caption
    If Combo2.ListCount > 0 Then
        Combo2.Text = Combo2.List(0)
        Combo2.ListIndex = 0
    Else
        MsgBox "没有发现可活动窗口", 16, "活动"
    End If
End Sub
Function FindActiveTitle() As String
    '查找活动窗口句柄
    Dim Active_hwnd As Long
    Dim Length As Integer
    Dim ListItem As String
    Combo1.Clear
    Active_hwnd = GetForegroundWindow() '获得活动窗口句柄
    Length = GetWindowTextLength(Active_hwnd) '窗口标题的长度
    ListItem = Space(Length + 1) '得到和窗口标题长度+1的口字符串(全是空格)
    Length = GetWindowText(Active_hwnd, ListItem, Length + 1) '得到窗口字符串
    Combo1.AddItem ListItem '添加窗口标题
    FindActiveTitle = ListItem
End Function

Private Sub Command1_Click()
    Me.Hide
    Me.Timer2.Enabled = True
    'MsgBox FindActiveTitle
End Sub

Private Sub Form_Load()
    'Me.Hide '隐藏窗口
    Me.Timer1.Enabled = False
    Me.Timer2.Enabled = False

    'FindTitle
    'Sift
    S = Val(Me.Text3.Text)
    Me.Timer1.Interval = S * 2000  '2秒计数1
    Me.Timer2.Interval = S * 1000
    Me.Timer3.Interval = S * 1000
End Sub
'不能点击关闭按钮关闭
Private Sub Form_Unload(Cancel As Integer)
    Cancel = True
End Sub

'调整执行速度
Private Sub HScroll1_Change()
    Me.Text3.Text = Me.HScroll1.Value
    S = Me.HScroll1.Value
    Me.Timer1.Interval = S * 2000
    Me.Timer2.Interval = S * 1000
    Me.Timer3.Interval = S * 1000
End Sub

Private Sub Timer1_Timer()
    Dim Temp
    Dim X As Integer
    Dim Y As Integer
    '根据屏幕分辨率设置
    X = Rnd * GetSystemMetrics(SM_CXSCREEN)
    Y = 150 + Rnd * (GetSystemMetrics(SM_CYSCREEN) - 150)
    'X = Screen.Width
    'Y = 100 + (Screen.Height - 100)
    Label3.Caption = X & "  /  " & Y
    'X = Rnd * 1024
    'Y = 100 + Rnd * 600
    i = i + 1
    Dim Title As String
    Title = FindActiveTitle
    Me.Caption = i & Title
    If i = S * 50 Then
        If B = False Then
            If InStr(Title, Me.Text1.Text) = 0 Then   '标题不包含田草博客,则关闭窗口,这里只用三个字是因为可能田草博客出现在最前面也为0
                SendKeys "%+{F4}" 'ALt+F4,关闭窗口
            End If
            B = True
        Else
            SendKeys "%+{F4}" 'ALt+F4,关闭窗口,不管是什么窗口，主要目的防止窗口积累过多
            B = False
        End If
        i = 0
    Else
        Temp = SetCursorPos(X, Y) '随机移动鼠标屏幕位置(X,Y)为坐标，单位为 Pixel(像素)
        'SendKeys "{ENTER}" '按下enter键
        mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0&, 0& '按下左键
        mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0&, 0& '松开左键
    End If
End Sub
'二分钟后开始Timer1,开始模拟点击
Private Sub Timer2_Timer()
    i = i + 1
    Me.Caption = 60 - i
    If i >= 60 Then
        i = 0
        Me.Timer2.Enabled = False
        Me.Timer1.Enabled = True
    End If
End Sub
'用户中止进程
Private Sub Timer3_Timer()
'取键盘Caps Lock键的状态&H14,insert键值是&H2D
'换成#H91就是Scroll Lock键的状态，
'换成&H90就是Num Lock的状态.
    If i = S * 50 Then
        ShellExecute 0, "open", Me.Text2.Text, "", "", 1
    End If
    If GetKeyState(&H14) Then
        End
    End If
End Sub