Sleep routine for HTA scripts

2019-01-27 00:52发布

问题:

In several of my .HTA scripts that I created, I had the need for the VBScript WScript.Sleep command which simply waits for a number of milliseconds without utilizing the CPU. And when I browse the web, it appears that I am not the only one looking for this:

https://www.google.nl/search?q=hta+sleep

(I bet that if you read this, you probably need(ed) this as well)

The best solution that I could find appears to be the one which uses the PING command. But especially for a situation were just need to pause the script for a few 100ms, this solution is quiet odd as it uses an external command and triggers all kind of (network) processes that unlikely have anything to do with the concerned .HTA script.

So the first thing that came to my mind was to use the WMI Win32_PingStatus class to avoid the external command but then I started to question why not completely basing it on WMI. It has taken me several hours to get the right WMI classes and methods in place, but finally I succeeded…

回答1:

When writing HTA's you should be thinking asynchronously. Consider rewriting your code to use window.setTimeout. In the following example, I will use window.setTimeout to make a bell sound every 2 seconds:

<!DOCTYPE html>
<html>
<head>
<meta http-equiv="x-ua-compatible" content="ie=8">
<title>Bell Test</title>
<script language="VBScript">
Option Explicit
Dim objWShell
Set objWShell = CreateObject("WScript.Shell")
Sub DoPing
    divText.innerText = Now
    objWShell.Run "%COMSPEC% /c ECHO " & Chr(7), 0, False
    window.setTimeOut "DoPing", 2000
End Sub
Sub window_OnLoad
   window.ResizeTo 240,130
   DoPing
End Sub
</script>
</head>
<body>
<div id="divText">TEST</div>
</body>
</html>


回答2:

I had the same problem with HTA. My solution with vbs ...

Sub sleep (Timesec)
    Set objwsh = CreateObject("WScript.Shell") 
    objwsh.Run "Timeout /T " & Timesec & " /nobreak" ,0 ,true
    Set objwsh = Nothing
End Sub

' example wait for 3 seconds
sleep 3

The routine will call a shell command, minimized and without a keyboard command. Only ^C is permitted, but this will no user given in these situation.



回答3:

Sub Sleep(iMilliSeconds)

    With GetObject("winmgmts:\\.\root\cimv2")
        With .Get("__IntervalTimerInstruction").SpawnInstance_()
            .TimerId = "Sleep"
            .IntervalBetweenEvents = iMilliSeconds
            .Put_()
        End With
        .ExecNotificationQuery("SELECT * FROM __TimerEvent WHERE TimerId='Sleep'").NextEvent
    End With

End Sub

Added 2015-02-11:

Unfortunately, this function doesn’t work when using Internet Explorer 10 (see comments below). With Internet Explorer 11 installed, it appears to work if you run the HTA as administrator.



回答4:

Wait(2000) 'pauses 2 seconds

Sub Wait(Time)
  Dim wmiQuery, objWMIService, objPing, objStatus
  wmiQuery = "Select * From Win32_PingStatus Where Address = '1.1.1.1' AND Timeout = " & Time
  Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
  Set objPing = objWMIService.ExecQuery(wmiQuery)
  For Each objStatus in objPing
  Next
End Sub