VBS Check internet and delay script until ready

I got a HTA application that runs when the user log on..

The problem is sometimes the HTA file opens to quickly, before the internet is ready and fails to load some of the scripts that need internet connection..

So my plan is to add a ping test before I call the scripts and then pause calls until the internet connection is ready..

Update:

<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, 0, 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>

Solution

Refer to this answer here Error: Object required: 'wscript' in HTA

The HTA engine doesn't provide a WScript object, so things like WScript.Quit or WScript.Sleep or Wscript.Echo don't work in HTAs.

To programmatically exit from an HTA use Self.Close or window.Close.

For replacing the Sleep method see the answers to this question.

I made a little example for you to check the connection and i replaced

the wscript.echo (dosen't work as i said above) by this <span id="DataArea"></span>

And here is the whole HTA :

<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,0,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,0,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>

Edit : 28/08/2020 @ 12:02

<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
    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()
                MsgBox  "You are now connected to the Internet ! " & vbCrLf &_
                "And The splash screen will exit now after you clicked on this Message Box !"
                Call CloseHTA()
'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,0, True
End Sub
'-----------------------------TEST-----------------------------------------
Sub CloseHTA()
    Self.Close
End sub
'----------------------------Execute---------------------------------------
Sub Execute(Program)
    Dim Shell ' You forget here to declare the variable Shell so be careful
    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>