VBS检查互联网并延迟脚本直到准备好

编程问答 2022-08-14

问题描述

我有一个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>
delayed-executionvbscript

相关问答

导入项目后报错问题
依赖报错 idea导入项目后依赖报错，解决方案：https://blog....
idea不能识别yaml文件
使用mybatis plus常见错误
错误1：代码生成器依赖和mybatis依赖冲突 启动项目时报错如下...
gradle常见问题与错误
错误1：gradle项目控制台输出为乱码 # 解决方案：https://bl...
Mybatis Plus传入参数0不起作用
错误还原：在查询的过程中，传入的workType为0时，该条件不起...
linux中make编译源码包失败
报错如下，gcc版本太低 ^ server.c:5346:31: 错误：‘struct...