VBS定时密码验证脚本求助：超时检测与Bug修复

原脚本的核心问题 #

• 嵌套循环逻辑混乱：一次密码错误会连续弹出两次输入框，不符合“两次输错触发登出”的设计
• 未处理用户关闭/取消输入框的场景：此时Input值为空，会直接计入错误次数，逻辑不合理
• 原生InputBox不支持超时：无法检测用户60秒内无响应的情况

解决方案 #

方案1：简易超时实现（用Popup前置提示） #

先弹出带60秒超时的提示，超时直接登出；用户确认后再验证密码，逻辑简单易维护：

Dim Password, Input, count, objShell
Password = "qq"
count = 0
Set objShell = CreateObject("WScript.Shell")

Do
    ' 60秒超时提示：点击确定返回1，超时返回-1
    popupRes = objShell.Popup("请在60秒内输入密码，超时将自动登出", 60, "密码验证", 0 + 32)
    
    If popupRes = -1 Then
        ' 超时无响应，直接登出
        objShell.Run "shutdown /l", 0, True
        WScript.Quit
    End If
    
    Input = InputBox("请输入密码:", "密码验证", "")
    
    If Input = Password Then
        ' 密码正确，重置计数，等待60秒后再次提示
        count = 0
        WScript.Sleep 60000
    Else
        count = count + 1
        If count >= 2 Then
            objShell.Run "shutdown /l", 0, True
            WScript.Quit
        Else
            ' 第一次输错，直接要求重输
            Input = InputBox("密码错误，请重新输入:", "密码验证", "")
            If Input <> Password Then
                objShell.Run "shutdown /l", 0, True
                WScript.Quit
            Else
                count = 0
                WScript.Sleep 60000
            End If
        End If
    End If
Loop

方案2：精准超时InputBox（调用Windows API） #

如果需要原生InputBox带超时关闭的体验，可通过调用user32.dll实现：

Dim Password, count, objShell
Password = "qq"
count = 0
Set objShell = CreateObject("WScript.Shell")

' 声明所需API函数
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Const WM_CLOSE = &H10
Dim timerId

' 定时器回调函数：60秒后关闭InputBox
Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    Dim inputBoxHwnd
    inputBoxHwnd = FindWindow("#32770", "密码验证")
    If inputBoxHwnd <> 0 Then
        SendMessage inputBoxHwnd, WM_CLOSE, 0, 0
        KillTimer 0, idEvent
    End If
End Sub

Do
    ' 设置60秒定时器
    timerId = SetTimer(0, 0, 60000, AddressOf TimerProc)
    Input = InputBox("请在60秒内输入密码:", "密码验证", "")
    KillTimer 0, timerId ' 输入完成，销毁定时器
    
    ' 处理输入结果：空值/取消视为无响应，计入错误次数
    If IsEmpty(Input) Or Input = "" Then
        count = count + 1
    ElseIf Input = Password Then
        count = 0
        WScript.Sleep 60000
        Continue Do
    Else
        count = count + 1
    End If
    
    ' 两次错误/无响应，触发登出
    If count >= 2 Then
        objShell.Run "shutdown /l", 0, True
        WScript.Quit
    End If
Loop

修复要点说明 #

• 修正错误计数逻辑：将用户关闭输入框、超时无响应都纳入触发登出的条件
• 解决嵌套循环的混乱问题：确保每一次输入都对应一次计数，避免重复弹框
• 实现超时检测：两种方案分别适配“简易快速”和“原生体验”的需求

内容的提问来源于stack exchange，提问作者Tim Li