Check network connection with VBScript

前端 未结 2 659
北荒
北荒 2020-12-10 19:33

I\'m running a web-based slideshow on multiple computer units. I have a VBScript that runs on startup, opens IE and navigates to a specific page in fullscreen mode. Everythi

相关标签:
2条回答
  • 2020-12-10 20:30

    Refer to this ==> Loop a function?

    Yes, you can do it easily with this code :

    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
    '**********************************************************************************************
    
    0 讨论(0)
  • 2020-12-10 20:30

    If Hackoo's code doesn't work for you, you can try the following. Not all servers will respond to ping requests but you could just make an HTTP request and see if the server sends a valid response (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
    
    0 讨论(0)
提交回复
热议问题