如何解决VBS检查互联网并延迟脚本直到准备好
我有一个HTA应用程序，可以在用户登录时运行。
问题是有时HTA文件会在互联网就绪之前快速打开，并且无法加载某些需要互联网连接的脚本。
所以我的计划是在调用脚本之前添加ping测试，然后暂停呼叫，直到Internet连接就绪。
更新：
<html>
<head>
<title>Kiosk</title>
<HTA:APPLICATION
APPLICATIONNAME="Kiosk Launcher"
ID="kiosklauncher"
ICON="data/icon.ico"
VERSION="1.0"
CONTEXTMENU = "no"
BORDER="none"
INNERBORDER = "no"
SINGLEINSTANCE = "yes"
SHOWINTASKBAR = "yes"
SCROLL="no"/>
<script Language="VBScript">
'--------------------------------------------------------------------------------------
Option Explicit
Dim Msg_Connected,Msg_NOT_Connected
Msg_Connected = "<h5><font color=""white""><strong>Starter Kiosk<strong></font></h5>"
Msg_NOT_Connected = "<h5><font color=""RED""><strong>Error no internet<strong></font></h5>"
'--------------------------------------------------------------------------------------
Sub Window_OnLoad()
Dim MyLoop,strComputer,objPing,objStatus,ws
Set ws = CreateObject("wscript.shell")
window.resizeTo screen.availWidth/4,screen.availHeight/4
window.moveTo screen.availWidth/2.7,screen.availHeight/2.5
'Call Shortcut()
MyLoop = True
While MyLoop
strComputer = "smtp.gmail.com"
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
("select * from Win32_PingStatus where address = '" & strComputer & "'")
For Each objStatus in objPing
If objStatus.Statuscode = 0 Then
MyLoop = False
DataArea.InnerHTML = Msg_Connected
Call Execute("SomeProgram.exe")
Call Execute("BatScripts.bat")
Call Sleep(1)
Call RefreshExplorer
Call Execute("AnotherProram.exe")
Call Sleep(1)
Call Execute("Launcher.bat")
call test()
Exit for
Else
DataArea.InnerHTML = Msg_NOT_Connected
End If
Next
Sleep(10) 'To sleep for 10 secondes
Wend
End Sub
'-----------------------------Sleep-----------------------------------------
Sub Sleep(seconds)
CreateObject("WScript.Shell").Run "%COMSPEC% /c ping 127.0.0.1 -n " _
& seconds+1,True
End Sub
'-----------------------------TEST-----------------------------------------
sub test()
Window.Close
end sub
'----------------------------Execute---------------------------------------
Sub Execute(Program)
set shell=CreateObject("Shell.Application")
' shell.ShellExecute "application","arguments","path","verb",window
shell.ShellExecute ""&Program&"","data\","runas",0
set shell=nothing
End sub
'-----------------------------RefreshExplorer-----------------------------------
Function RefreshExplorer()
dim strComputer,objWMIService,colProcess,objProcess
strComputer = "."
'Get WMI object
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colProcess = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'explorer.exe'")
For Each objProcess in colProcess
objProcess.Terminate()
Next
End Function
</script>
</head>
<body>
<div class="main">
<center><h2 style="text-align: center;">Kiosk Launcher</h2></center>
<center><div><img src="data/preloader.gif" class="preloader-scale" draggable="false" unselectable="on"></div></center>
<center><h4>Please wait</h4></center>
<center><span id="DataArea"></span></center>
</div>
</body>
</html>解决方法
在此Error: Object required: 'wscript' in HTA
参考此答案 HTA引擎不提供WScript对象，因此WScript.Quit或WScript.Sleep或Wscript.Echo之类的东西在HTA中不起作用。
要以编程方式退出HTA，请使用Self.Close或window.Close。
有关替换Sleep方法的信息，请参见this question的答案。
我为您提供了一个检查连接的小示例，我替换了
此wscript.echo的{{1}}（不起作用，如上所述）
这是整个HTA：
<span id="DataArea"></span>编辑：28/08/2020 @ 12:02
<html>
<head>
<title>Network Diagnostics And Checking Internet Connection by Hackoo 2020</title>
<HTA:APPLICATION
Application ID = "Check_Internet_Connection"
APPLICATIONNAME = "Check_Internet_Connection"
BORDER="THIN"
BORDERSTYLE="NORMAL"
CAPTION = "Yes"
CONTEXTMENU = "Yes"
ICON = "nslookup.exe"
INNERBORDER="NO"
MAXIMIZEBUTTON="NO"
MINIMIZEBUTTON="YES"
SCROLL="NO"
SELECTION="NO
SHOWINTASKBAR = "Yes"
SINGLEINSTANCE = "Yes"
SYSMENU = "Yes"
/>
<style type="text/css">
body {
font-family:Verdana;
font-size: 10x;
color: #49403B;
background: LightGreen;
}
</style>
</head>
<script Language="VBScript">
'--------------------------------------------------------------------------------------
Option Explicit
Dim Msg_Connected,Msg_NOT_Connected
Msg_Connected = "<Marquee DIRECTION=""Right"" SCROLLAMOUNT=""6"" BEHAVIOR=""ALTERNATE"">"&_
"<h2><font color=""GREEN""><strong>You Are Now Connected To The Internet !<strong></font></h2></Marquee><br><br>"&_
"<img src=""https://cdn2.unrealengine.com/Fortnite%2FBoogieDown_GIF-1f2be97208316867da7d3cf5217c2486da3c2fe6.gif""></img>"
Msg_NOT_Connected = "<Marquee DIRECTION=""Right"" SCROLLAMOUNT=""6"" BEHAVIOR=""ALTERNATE"">"&_
"<h3><font color=""RED""><strong>You Are Not Connected to the Internet ... We are trying to establish again your connection<strong></font></h3></Marquee>"
'--------------------------------------------------------------------------------------
Sub CenterWindow( widthX,heightY )
self.ResizeTo widthX,heightY
self.MoveTo (screen.Width - widthX)/2,(screen.Height - heightY)/2
End Sub
'--------------------------------------------------------------------------------------
Sub Window_OnLoad()
Dim MyLoop,strComputer,objPing,objStatus,ws
Set ws = CreateObject("wscript.shell")
CenterWindow 800,600
Call Shortcut()
MyLoop = True
While MyLoop
strComputer = "smtp.gmail.com"
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
("select * from Win32_PingStatus where address = '" & strComputer & "'")
For Each objStatus in objPing
If objStatus.Statuscode = 0 Then
MyLoop = False
DataArea.InnerHTML = Msg_Connected
WAN_IP.InnerHTML = "<h2><font color=""GREEN""><strong> WAN IP : " & Get_WAN_IP & "<strong></font></h2>"
SayIt()
'Call MyProgram() ' You can call all your Programs here after the connection has been established !
Exit for
Else
DataArea.InnerHTML = Msg_NOT_Connected
ws.run "%SystemRoot%\system32\msdt.exe -skip TRUE -path %Windir%\diagnostics\system\networking -ep NetworkDiagnosticsPNI"
End If
Next
Sleep(10) 'To sleep for 10 secondes
Wend
End Sub
'--------------------------------------------------------------------------------------
Sub Sleep(seconds)
CreateObject("WScript.Shell").Run "CMD /c ping 127.0.0.1 -n " & seconds,True
End Sub
'--------------------------------------------------------------------------------------
Function Get_WAN_IP()
Dim http
Set http = CreateObject("Microsoft.XMLHTTP" )
http.Open "GET","http://icanhazip.com",False
http.Send
Get_WAN_IP= http.responseText
End Function
'--------------------------------------------------------------------------------------
Sub SayIt()
Dim fso,WaveFile,ws
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
WaveFile = WS.ExpandEnvironmentStrings("%LocalAppData%\Microsoft\Windows Sidebar\Gadgets\NetworkMonitorII.gadget\media\established.wav")
If fso.FileExists(WaveFile) Then
Play(WaveFile)
Sleep(5)
Play("http://94.23.221.158:9197/stream")
Else
CreateObject("SAPI.SpVoice").Speak "You are Connected to the internet"
Sleep(5)
Play("http://94.23.221.158:9197/stream")
End If
End Sub
'--------------------------------------------------------------------------------------
Sub Play(URL)
Dim ws,fso,f,TempName,TempFile,TempFolder
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Tempname = fso.GetTempName
TempFolder = WS.ExpandEnvironmentStrings("%Temp%")
TempFile = TempFolder & "\" & Tempname & ".vbs"
Set f = fso.OpenTextFile(Tempfile,2,True)
f.Writeline "Call Play(" & chr(34) & URL & chr(34) & ")"
f.Writeline "Sub Play(URL)"
f.Writeline "Set Sound = CreateObject(""WMPlayer.OCX"")"
f.Writeline "Sound.URL = URL"
f.Writeline "Sound.settings.volume = 100"
f.Writeline "Sound.Controls.play"
f.Writeline "do while Sound.currentmedia.duration = 0"
f.Writeline "wscript.sleep 100"
f.Writeline "loop"
f.Writeline "wscript.sleep (int(Sound.currentmedia.duration)+1)*1000"
f.Writeline "End Sub"
f.close
ws.run Tempfile
End Sub
'--------------------------------------------------------------------------------------
Sub Stop_Playing()
Dim Command,ws
Set ws = CreateObject("wscript.Shell")
Command = "Cmd /C Taskkill /IM ""wscript.exe"" /F >nul 2>&1"
ws.run Command,True
Exit Sub
End Sub
'--------------------------------------------------------------------------------------
Sub Window_OnUnload()
Call Stop_Playing()
End Sub
'--------------------------------------------------------------------------------------
sub Shortcut()
dim shell,DesktopPath,Link,CurrentFolder,FullName,arrFN,HTA_Name
Set Shell = CreateObject("WScript.Shell")
CurrentFolder = shell.CurrentDirectory
DesktopPath = Shell.SpecialFolders("Desktop")
FullName = replace(Check_Internet_Connection.commandLine,chr(34),"")
arrFN=split(FullName,"\")
HTA_Name = arrFN(ubound(arrFN))
Link = GetFilenameWithoutExtension(HTA_Name)
Set link = Shell.CreateShortcut(DesktopPath & "\" & Link & ".lnk")
link.Description = HTA_Name
link.IconLocation = "nslookup.exe"
link.TargetPath = CurrentFolder & "\" & HTA_Name
link.WorkingDirectory = CurrentFolder
Link.HotKey = "CTRL+ALT+C"
link.Save
end Sub
'--------------------------------------------------------------------------------------
Function GetFilenameWithoutExtension(FileName)
Dim Result,i
Result = FileName
i = InStrRev(FileName,".")
If ( i > 0 ) Then
Result = Mid(FileName,1,i - 1)
End If
GetFilenameWithoutExtension = Result
End Function
'-------------------------------------------------------------------------------------
</script>
<body>
<center>
<span id="DataArea"></span>
</br></br>
<span id="WAN_IP"></span>
</center>
</body>
</html>
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。