AppActivate關閉窗口不循環

我有一個應用程序經常需要運行而不主動受到監視，但如果遇到錯誤，它會彈出一個消息窗口並暫停，直到用戶關閉。由於我們正在進行壓力測試，並且無法禁用這些消息，所以目前造成了很多問題，所以有人必須始終關注流程。我一直在想出一些VBScript，它會繼續檢查彈出消息並自動關閉它，使用AppActivate和SendKeys函數。AppActivate關閉窗口不循環

問題是我需要這個在GUI中工作，以便用戶可以通過點擊一個按鈕輕鬆啓動/停止代碼。因此，我現在使用一個按鈕將我的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>

我需要它只是不斷地在後臺運行，只有執行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

來源

2017-02-23 GnorthernGnome

你的程序在做50次迭代無延時，所以它可能已經結束之前甚至有可能得到一個第二個實例。

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>

如果需要你你通常做的是運行AppActivate和SendKeys在一個無限循環的小延遲什麼從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

來源

2017-02-23 12:12:35

謝謝！我認爲可能是這種情況，但是通過打開窗口的兩個實例並且計數值大得多並且它仍然沒有工作來測試它......猜測它不夠大！我剛剛嘗試了您的建議，並且工作更好。我唯一的問題是，當我來「停止」腳本時，我收到一條錯誤消息，提示「無效的窗口句柄」並指向這一行：'cmd.Terminate'。有什麼建議麼？如果我解決了問題，我會繼續玩並更新。 – GnorthernGnome

@GnorthernGnome終止外部腳本後，需要將'cmd'設置爲'Nothing'。查看更新的答案。如果這沒有幫助，請編輯您的問題並顯示您的修改代碼。 –

對延遲道歉，項目突然被擱置了一段時間。值得一提的是，將'cmd'設置爲'Nothing'不起作用，但我設法找到了解決方案。我已經更新了原始文章，並附有最後的代碼供任何感興趣的人使用謝謝你的幫助。 – GnorthernGnome

AppActivate關閉窗口不循環

回答

相關問題