(view source code of pingsite.vbs as plain text)
Option Explicit
Dim strMsg, strWebsite
If WScript.Arguments.Unnamed.Count <> 1 Then Syntax
If WScript.Arguments.Named.Count <> 0 Then Syntax
If Not IsHostName( WScript.Arguments.Unnamed(0) ) Then Syntax
strWebsite = WScript.Arguments.Unnamed(0)
If PingSite( strWebsite ) Then
WScript.Echo "Web site " & strWebsite & " is up and running!"
Else
WScript.Echo "Web site " & strWebsite & " is down!!!"
End If
Function PingSite( myWebsite )
' This function checks if a website is running by sending an HTTP request.
' If the website is up, the function returns True, otherwise it returns False.
' Argument: myWebsite [string] in "www.domain.tld" format, without the
' "http://" prefix.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim intStatus, objHTTP
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
objHTTP.Open "GET", "http://" & myWebsite & "/", False
objHTTP.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
On Error Resume Next
objHTTP.Send
intStatus = objHTTP.Status
On Error Goto 0
Set objHTTP = Nothing
If intStatus = 200 Then
PingSite = True
Else
PingSite = False
End If
End Function
Function IsHostName( myString )
' Check if a string has a valid host name format
Dim colMatches, objRE
Set objRE = New RegExp
objRE.Global = False
objRE.IgnoreCase = True
objRE.Pattern = "^([a-z][a-z_0-9-]+\.)*[a-z][a-z_0-9-]+\.[a-z]{2,8}$"
Set colMatches = objRE.Execute( myString )
If colMatches.Count = 1 Then
IsHostName = True
Else
IsHostName = False
End If
Set colMatches = Nothing
Set objRE = Nothing
End Function
Sub Syntax( )
strMsg = "PingSite.vbs, Version 1.01" & vbCrLf _
& "Check if a website is up and running" & vbCrLf & vbCrLf _
& "Usage: PINGSITE.VBS www.any_domain.tld" & vbCrLf & vbCrLf _
& "Written by Rob van der Woude" & vbCrLf _
& "http://www.robvanderwoude.com"
WScript.Echo strMsg
WScript.Quit 1
End Sub
page last modified: 2024-04-16; loaded in 0.0056 seconds