使用 VBScript 检查网络连接
Check network connection with VBScript
我是 运行 多台计算机上的基于网络的幻灯片。我有一个在启动时运行的 VBScript,打开 IE 并以全屏模式导航到特定页面。只要启动时有 Internet 连接,一切都很好。如果没有,则该页面永远不会加载。 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
参考这个==>
是的,您可以使用此代码轻松完成:
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
'**********************************************************************************************
如果 Hackoo 的代码不适合您,您可以尝试以下方法。并非所有服务器都会响应 ping 请求,但您可以发出 HTTP 请求并查看服务器是否发送有效响应(状态 = 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
我是 运行 多台计算机上的基于网络的幻灯片。我有一个在启动时运行的 VBScript,打开 IE 并以全屏模式导航到特定页面。只要启动时有 Internet 连接,一切都很好。如果没有,则该页面永远不会加载。 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
参考这个==>
是的,您可以使用此代码轻松完成:
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
'**********************************************************************************************
如果 Hackoo 的代码不适合您,您可以尝试以下方法。并非所有服务器都会响应 ping 请求,但您可以发出 HTTP 请求并查看服务器是否发送有效响应(状态 = 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