Be seen. Boost your question’s priority for more expert views and faster solutions
Rem Runs Ping command, outputs results to text file.
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery _
("Select * From Win32_LogicalDisk Where DriveType = 3")
For Each objItem in colItems
strDriveLetter = objItem.DeviceID
strCommand = "ping 192.xxx.x.xxx -w 999"
Set objExecObject = objShell.Exec(strCommand)
Do While Not objExecObject.StdOut.AtEndOfStream
strResults = objExecObject.StdOut.ReadAll()
Loop
strText = strText & strResults
Next
Rem Sends email alert
Set objFile = objFSO.CreateTextFile("C:\PingFailed.txt")
objFile.Write strText
objFile.Close
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "VPN_Dissconnect@domain.com"
objEmail.To = "admin@domain.com"
objEmail.Subject = "VPN from office to RemoteSite just disconnected"
objEmail.Textbody = "The ping time from the Office to RemoteSite was just over 999ms, indicating the VPN probably disconnected." & strDate
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
"SMTP_server_name"
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
Rem Renames text file with time and date
'########################################################################################
'# #
'# Name: PingServers.vbs #
'# Version: 1.1.0 #
'# Created: August 3rd, 2007 #
'# Modified: August 20th, 2007 #
'# Author: Martin Roeske #
'# #
'# Description: This script will test connectivity to an array of servers and #
'# send a notification when a server is unreachable. #
'# #
'# Notes: This script uses PING to test for connectivity. It will also #
'# log any failures and create a "cookie" so that the email #
'# notifications are only sent every 15 minutes or so. When a #
'# failure does occur, the script will wait 15 seconds before #
'# making a second attempt. If that fails, then a notification #
'# will be sent. #
'# #
'# Sub Function Description #
'# --------------------------------------------------------------- #
'# func_ReadFile() This function will read a text file and #
'# fill an array with each line from the #
'# file becoming an element of the array. #
'# #
'# ping() This function will Ping a computer and #
'# output a TRUE for a successful ping, or #
'# FALSE for after two failures. #
'# #
'# func_Cookie() This function will create a "cookie" #
'# if the ping connectivity test fails. It #
'# will also check the cookie so that a #
'# notification is sent every 15 minutes. #
'# #
'# func_Log() This function will write the product #
'# information to a network share. It will #
'# also rotate out any data that is older #
'# than 90 days. #
'# #
'# func_TimeStamp() This function will generate a timestamp #
'# in this format: YYYYMMDD HH:MM:SS AM #
'# #
'# func_Notify() This function will send an notification #
'# via email stating that the server has #
'# failed its test. #
'# #
'########################################################################################
'---------------------------------------------------------------------------
'
' Main Function
'
'---------------------------------------------------------------------------
Option Explicit
DIM FSO
DIM SrvFile
DIM arrServers
DIM Server
DIM TimeStamp
set FSO = CreateObject("Scripting.FileSystemObject")
SrvFile = "Servers.txt"
arrServers = func_ReadFile(SrvFile)
For Each Server in arrServers
If ping(Server) = FALSE then
TimeStamp = func_TimeStamp()
func_Log TimeStamp,Server
End If
Next
set FSO = Nothing
set SrvFile = Nothing
set arrServers = Nothing
set Server = Nothing
set TimeStamp = Nothing
wscript.quit
'---------------------------------------------------------------------------
'
' Sub Functions
'
'---------------------------------------------------------------------------
Function func_ReadFile(strFile)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
' This function will read a file and generate an array
' with each element being a line from the file
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DIM rFile
DIM rLine
DIM arrFile
set rFile = FSO.OpenTextFile(strFile)
Do until rFile.AtEndOfStream
rLine = rFile.ReadLine
if rLine <> "" then
arrFile = arrFile & rLine & ";"
End If
Loop
rfile.Close
arrFile = ucase(arrFile)
arrFile = Left(arrFile, len(arrFile) -1)
arrFile = split(arrFile, ";")
func_ReadFile = arrFile
set rFile = Nothing
set rLine = Nothing
set arrFile = Nothing
End Function
Function ping(Server)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
' This function will Ping a computer and output a TRUE
' for a successful ping, or FALSE for after two failures.
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DIM WShell,objExec,strPingResults
set WShell = CreateObject("WScript.Shell")
set objExec = WShell.Exec("ping -n 2 -w 1000 " & Server)
strPingResults = LCase(objExec.StdOut.ReadAll)
If InStr(strPingResults, "reply from") then
ping = TRUE
else
wscript.sleep 15000
set objExec = WShell.Exec("ping -n 2 -w 1000 " & Server)
strPingResults = LCase(objExec.StdOut.ReadAll)
If InStr(strPingResults, "reply from") then
ping = TRUE
else
ping = FALSE
End If
End If
set WShell = Nothing
set objExec = Nothing
set strPingResults = Nothing
End Function
Function func_Cookie(Server, test)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
' This function will create a "cookie" should the ping
' test fail for the server. It will also check the
' cookie so that a notification is sent every 15 minutes.
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DIM strCFold,strCook,blCookie
DIM rFile,rLine,rDate,cFile,nTime
strCFold = "\\Servers\Result$\Cookies\"
strCook = strCFold & "Ping_" & Server & ".Cookie"
If FSO.FileExists(strCook) then
Set rFile = FSO.OpenTextFile(strCook)
Do Until rFile.AtEndOfStream
rLine = rFile.ReadLine
If rLine <> "" then
rDate = CDate(split(rLine, vbtab)(0))
nTime = Now()
If DateDiff("N", rDate, nTime) < 15 then
blCookie = FALSE
Else
blCookie = TRUE
End If
End If
Loop
Else
blCookie = TRUE
End If
If blCookie = TRUE then
set cFile = FSO.OpenTextFile(strCook, 2, True)
cFile.Write func_TimeStamp() & vbtab & Server
cFile.close
func_Cookie = TRUE
Else
func_Cookie = FALSE
End If
set strCFold = Nothing
set strCook = Nothing
set blCookie = Nothing
set rFile = Nothing
set rLine = Nothing
set rDate = Nothing
set cFile = Nothing
set nTime = Nothing
End Function
Function func_Log(TimeStamp,Server)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
' This function will Log the failed pings to a file on
' the network. It will also check to ensure the data is
' not duplicated in the log.
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DIM strFold,strFile,blTest,wFile
DIM rFile,rLine,rLog,rDate,nTime
strFold = "\\Server\Result$"
strFile = strFold & "\Server_Ping.Log"
If FSO.FileExists(strFile) then
Set rFile = FSO.OpenTextFile(strFile)
Do Until rFile.AtEndOfStream
rLine = rFile.ReadLine
If rLine <> "" then
rDate = CDate(split(rLine, vbtab)(0))
nTime = Now()
If DateDiff("D", rDate, nTime) < 90 then
rLog = rLog & rLine & vbcrlf
End If
End If
Loop
rFile.close
End If
blTest = func_Cookie(Server,rLog)
set wFile = FSO.OpenTextFile(strFile, 2, True)
wFile.write TimeStamp & vbtab & Server & vbtab & "PING failure" & vbcrlf
If blTest = TRUE then
wFile.Write TimeStamp & vbTab & Server & vbTab & "**** Email Sent ****" & vbcrlf
func_Notify(Server)
End If
wFile.Write rLog
wFile.Close
set strFold = Nothing
set strFile = Nothing
set blTest = Nothing
set wFile = Nothing
set rFile = Nothing
set rLine = Nothing
set rLog = Nothing
set rDate = Nothing
set nTime = Nothing
End Function
Function func_TimeStamp()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
' This function will generate a timestamp in this format:
'
' YYYYMMDD HH:MM:SS AM/PM
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DIM strYear
DIM strMonth
DIM strDay
DIM strTime
DIM strStamp
strYear = Year(Now)
strMonth = Month(Now)
strDay = Day(Now)
strTime = Time()
If len(strMonth) < 2 then
strMonth = "0" & strMonth
End If
If len(strDay) < 2 then
strDay = "0" & strDay
End If
strStamp = strYear & "-" & strMonth & "-" & strDay & " " & strTime
if len(strStamp) <> 22 then
Do Until len(strStamp) > 21
strStamp = strStamp & " "
Loop
end If
func_TimeStamp = strStamp
set strYear = Nothing
set strMonth = Nothing
set strDay = Nothing
set strTime = Nothing
set strStamp = Nothing
End Function
Function func_Notify(Server)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
' This function will send an email notification stating
' that Server has failed it's ping test.
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DIM strName,strRecip,strSubject,strMsg
DIM strSrv,strSend,strServer,strPort
DIM Msg
strName = "PingFailure@domain.com" 'Sender's Email
strSrv = "smtp.domain.com" 'SMTP Server
strSubject = Server & "-- FAILED PING!!!" 'Email Subject
strRecip = "recipient@domainc.om" 'Recipient's Email
strMsg = "Failed to ping " & ucase(Server) & " at " & Now()
strSend = "http://schemas.microsoft.com/cdo/configuration/sendusing"
strServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
strPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Set Msg = CreateObject("CDO.Message")
Msg.Configuration.Fields.Item(strSend) = 2
Msg.Configuration.Fields.Item(strServer) = strSrv
Msg.Configuration.Fields.Item(strPort) = 25
Msg.Configuration.Fields.Update
Msg.Subject = strSubject
Msg.From = strName
Msg.To = strRecip
Msg.TextBody = strMsg
Msg.Send
set strName = Nothing
set strRecip = Nothing
set strSubject = Nothing
set strMsg = Nothing
set strSrv = Nothing
set strSend = Nothing
set strServer = Nothing
set strPort = Nothing
set Msg = Nothing
End Function
Rem Runs Ping command, outputs results to text file.
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strComputer = "."
strCommand = "ping -n 1 -w 999 192.xxx.x.xxx"
strResults=""
while not InStr(1,StrResults,"Request timed out")>0
wscript.sleep 30000 ' Sleep for thirty seconds - when the script is first run, no ping for first thirty seconds
Set objExecObject = objShell.Exec(strCommand)
Do While Not objExecObject.StdOut.AtEndOfStream
strResults = objExecObject.StdOut.ReadAll()
Loop
wend
strText = strText & strResults
Rem Sends email alert
Set objFile = objFSO.CreateTextFile("C:\PingFailed.txt")
objFile.Write strText
objFile.Close
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "VPN_Dissconnect@domain.com"
objEmail.To = "admin@domain.com"
objEmail.Subject = "VPN from office to RemoteSite just disconnected"
objEmail.Textbody = "The ping time from the Office to RemoteSite was just over 999ms, indicating the VPN probably disconnected." & strDate
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
"SMTP_server_name"
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
Rem Renames text file with time and date
Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.
Have a better answer? Share it in a comment.
Open in new window