Проверьте сетевое соединение с VBScript

Question

Я запускаю слайд-шоу на нескольких компьютерах в Интернете. У меня есть VBScript, который запускается при запуске, открывает IE и перемещается на определенную страницу в полноэкранном режиме. Все работает отлично, пока есть интернет-соединение при запуске. Если нет, страница никогда не загружается. Есть ли способ в VBScript проверять соединение каждые пару минут, пока соединение не будет найдено, а затем продолжить сценарий? Вот код для справки:

Option Explicit  
Dim WshShell 
set WshShell = WScript.CreateObject("WScript.Shell")   

On Error Resume Next 
    With WScript.CreateObject ("InternetExplorer.Application")  
     .Navigate "http://www.example.com/slideshow" 
     .fullscreen = 1 
     .Visible = 1 
     WScript.Sleep 10000 
    End With  
On Error Goto 0 

Answer 1

Обратитесь к этому ==>Loop a function?

Да, вы можете сделать это легко с помощью этого кода:

Option Explicit 
Dim MyLoop,strComputer,objPing,objStatus 
MyLoop = True 
While MyLoop = True 
    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 
      Call MyProgram() 
      wscript.quit 
     End If 
    Next 
    Pause(10) 'To sleep for 10 secondes 
Wend 
'********************************************************************************************** 
Sub Pause(NSeconds) 
    Wscript.Sleep(NSeconds*1000) 
End Sub 
'********************************************************************************************** 
Sub MyProgram() 
Dim WshShell 
set WshShell = WScript.CreateObject("WScript.Shell")   
On Error Resume Next 
    With WScript.CreateObject ("InternetExplorer.Application")  
     .Navigate "http://www.example.com/slideshow" 
     .fullscreen = 1 
     .Visible = 1 
     WScript.Sleep 10000 
    End With  
On Error Goto 0 
End Sub 
'********************************************************************************************** 

Answer 2

Если код Hackoo в не работа для вас, вы можете попробовать следующее. Не все серверы будут отвечать на запросы ping, но вы можете просто сделать HTTP-запрос и посмотреть, отправляет ли сервер действительный ответ (status = 200).

Function IsSiteReady(strURL) 

    With CreateObject("MSXML2.XMLHTTP") 
     .Open "GET", strURL, False 
     .SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.1)" 
     On Error Resume Next 
     .Send 
     If .Status = 200 Then IsSiteReady = True 
    End With 

End Function