AppActivate 关闭 Window 不循环

Question

我有一个应用程序经常需要运行没有被主动监视，但是如果它遇到错误，它会弹出一条消息 window 并暂停直到用户按下关。由于我们正在进行压力测试并且无法禁用这些消息，因此目前造成了很多问题，因此必须有人不断关注该过程。我一直在尝试使用 AppActivate 和 SendKeys 函数来编写一些 VBScript，它会不断检查弹出消息并自动关闭它。

问题是我需要它在 GUI 中工作，这样用户就可以通过单击按钮轻松地 start/stop 来自运行ning 的代码。因此，我目前将我的 VBScript 包装在一个带有单个按钮的 HTA 应用程序中，但由于某种原因，它只会关闭消息的第一个实例（可以同时加载多个实例）然后停止。

Sub Testing
    Set objShell = CreateObject("WScript.Shell")
    counter = 1
    Do While counter < 50
        ret = objShell.AppActivate("Test Failure")
        counter = counter + 1
        If ret = True Then
            objShell.SendKeys "~"
        End If
    Loop
End Sub

配一个按钮如下：

<input type="button" value="Run Script" name="run_button" onClick="Testing"><p>

我需要它在后台不断地运行，只有在 "Test Failure" window 是 selected/present 时才执行 SendKeys 并且能够当按下第二个按钮时停止循环。

我显然出错了（VBScript 确实从头到尾执行，不是吗？）而且我以前从未真正使用过这些函数，但似乎都设置正确。

我已将@Ansgar Wiechers 的回答标记为正确，因为它解决了我问题的根本原因。我最终得到的最终代码分为两部分。应用：

<!doctype html>
<head>
<hta:application
    id="AutoCloseFailures"
    applicationname="AutoCloseFailures"
    icon=""
    singleinstance="yes"
    border="thick"
    borderstyle="complex"
    scroll="no"
    maximizebutton="no"
    version="0.1" />
<title>Auto-Close Failure Messages</title>
<meta http-equiv="x-ua-compatible" content="ie=8">
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<script language="VBScript">

    ' Set Global Variables for Subroutines
    script = "#FOLDERPATH#\AutoCloseDEFXErrorsTimer.vbs"
    Set sh  = CreateObject("WScript.Shell")
    Set cmdTest = Nothing
    strVar = "testing2"

    Sub StartLoop
    ' Initiate VB Loop to Target Failure Windows & Close Them
        If cmdTest Is Nothing Then
            Set cmdTest = sh.Exec("wscript.exe """ & script & """")
            strVar = "testing"
        End If
        document.all.start.style.background="#777d84"
        document.all.start.style.color="#bfc4c9"
    End Sub

    Sub StopLoop
    ' Terminate VB Loop Process & Reset Application
        strScriptToKill = "AutoCloseDEFXErrorsTimer.vbs"
        Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\.\root\cimv2")
        Set colProcess = objWMIService.ExecQuery ( _
            "Select * from Win32_Process " & _
            "WHERE (Name = 'cscript.exe' OR Name = 'wscript.exe') " & _
            "AND Commandline LIKE '%"& strScriptToKill &"%'" _
        )
        For Each objProcess in colProcess
            objProcess.Terminate()
        Next
        Set cmdTest = Nothing
        document.all.start.style.background="#587286"
        document.all.start.style.color="#ffffff"
    End Sub

    Sub Window_onLoad
    ' Force Window Size
        window.resizeTo 400,190
        window.moveTo 1530, 0
    End Sub
</script>
<style>
    body {
        margin: 0;
        padding: 0;
        font-family: "Segoe UI", Geneva, sans-serif;
        background: #dae3f2;
    }
    h1 {
        font-size: 15pt;
        text-align: center;
        margin-bottom: 0;
        color: #273754;
    }
    button {
        padding:16px 32px;
        font-family:helvetica;
        font-size:16px;
        font-weight:100;
        color:#fff;
        background: #587286;
        border:0;
    }
    button:hover {
        background: #3B5C76;
    }
    .container {
        width: 100%;
        text-align: center;
    }
</style>
<BODY>
    <h1>Auto-Close Failure Messages</h1>
    <br>
        <div class="container">
            <button id="start" onclick="StartLoop">Start</button>
            <span>&nbsp;&nbsp;&nbsp;</span>
            <button id="stop" onclick="StopLoop">Stop</button>
        </div>
    <br>
</BODY>
</HTML>

以及配套的 vbScript 文件：

Set sh = CreateObject("WScript.Shell")
While True
    active = sh.AppActivate("#WINDOW TITLE#")
    If active Then
        sh.SendKeys "~"
    End If
    WScript.Sleep 100
Wend

Answer 1

您的程序正在毫无延迟地进行 50 次迭代，因此它可能在进入第二个实例之前就已经完成了。你通常做的是运行 AppActivate 和 SendKeys 在一个带有小延迟的无限循环中：

Set sh = CreateObject("WScript.Shell")
While True
    active = sh.AppActivate("Test Failure")
    If active Then
        sh.SendKeys "~"
    End If
    WScript.Sleep 100
Wend

将其放入您从 HTA 异步运行的脚本中：

<html>
<head>
<title>sample</title>
<HTA:APPLICATION
    ID="sample"
    APPLICATIONNAME="oHTA"
    SINGLEINSTANCE="yes">

<script language="VBScript">
script = "C:\path\to\script.vbs"
Set sh  = CreateObject("WScript.Shell")
Set cmd = Nothing

Sub StartLoop
    If cmd Is Nothing Then
        Set cmd = sh.Exec("wscript.exe """ & script & """")
    End If
End Sub

Sub StopLoop
    If Not cmd Is Nothing Then
        cmd.Terminate
        Set cmd = Nothing
    End If
End Sub
</script>
</head>

<body>
<p>
<button id="start" onclick="StartLoop">Start</button>
<button id="stop" onclick="StopLoop">Stop</button>
</p>
</body>
</html>

如果需要，您可以从 HTA 即时创建外部脚本：

Set fso = CreateObject("Scripting.FileSystemObject")
...
Set f = fso.OpenTextFile(script, 2, True)
f.WriteLine "Set sh = CreateObject(""WScript.Shell"")"
f.WriteLine "While True"
f.WriteLine "active = sh.AppActivate(""Test Failure"")"
...
f.Close

终止后删除：

If Not cmd Is Nothing Then
    cmd.Terminate
    Set cmd = Nothing
    fso.DeleteFile script, True
End If

AppActivate 关闭 Window 不循环

AppActivate to Close Window not Looping

vbscript

hta