Submitted By: Keitme

Monitors computer availability and sends email if a computer does not respond.

Visual Basic
Edit|Remove
'pingmonitor_log.vbs
'usage: cscript pingmonitor <Internet_site> <log_file_directory>
'<log_file_directory>. Must end in a "\"
'The log files are named yyyymmdd_pm.txt

option explicit
Dim Timer, pingtarget, aPingInfo, oShell, oFSO
Dim TimeDown, TotalTimeDown, LoopCount, limitupdate, logfile, ologfile
Dim startdate, aDate, dix, logdir, flagdir, oFlagfile
Timer=600000 'Check by pinging at 10 minute intervals
Timedown=0
TotalTimeDown=0
Loopcount=0
Const FromEmailaddress="<source_email_address>"
Const ToEmailAddress="<recipient_email_address(es)>"
Const SMTPServer="<email_server>"  'email server that does not require SMTP authentication
Const ServerPort = 25 'SMTP port number for unsecured input


'configure necessary objects
set oShell=CreateObject("Wscript.Shell")
set oFSO=CreateObject("Scripting.FileSystemObject")
pingtarget=wscript.arguments(0)
logdir=wscript.arguments(1)

'Main Execution control
main

'Main Execution control subroutine
sub main
  createlog
  if oFSO.Fileexists(logfile) then
   set ologfile=oFSO.Opentextfile(logfile,8,False)
  else
   set ologfile=oFSO.Createtextfile(logfile,True)
  end if 
  ologfile.writeline " "
  ologfile.writeline "Pingmonitor is verifying network connection by pinging " & wscript.arguments(0) & "."
  Do while Timer > 0
    If DATE > StartDate then
     startdate=Date
     ologfile.writeline " "
     ologfile.writeline "Date has changed: " & Date
     ologfile.writeline " "
    end if
    Pingmonitor pingtarget
    Loopcount=Loopcount+1
    wscript.sleep Timer
  Loop
end sub

'configure log location
sub createlog
  startdate=date
  adate=split(startdate,"/")
  for dix=0 to ubound(adate)
    if len(adate(dix))<2 then adate(dix)="0" & adate(dix)
    select case dix
    case 0
      logfile=logfile&adate(dix)
    case 1
      logfile=logfile&adate(dix)
    case 2
      logfile=adate(dix)&logfile
    end select
  next
  if len(logfile) < 8 then logfile="0"&logfile
  logfile=logdir&logfile&"_pm.txt"
  logfile=oShell.ExpandEnvironmentStrings(logfile)
end sub

sub PingMonitor(TargetHost)
  Dim cPingResults, oPingResult, recheckflag, recheck
  recheckflag=0
  recheck=0
  Set cPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus " & "WHERE Address = '" + TargetHost + "'")
  For Each oPingResult In cPingResults
    if oPingResult.StatusCode=0 then recheckflag=1
  next
  set cPingResults= nothing
'double check to make sure failure is not transient
  do until recheck > 4
    if recheckflag < 1 then
      recheck=recheck+1
      wscript.sleep 4000 
      Set cPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus " & "WHERE Address = '" + TargetHost + "'")
      For Each oPingResult In cPingResults
        if oPingResult.StatusCode=0 then recheckflag=1
      next
      set cPingResults= nothing
    else
      recheck=10
    end if 
  loop
  if recheckflag < 1 then
    if timedown=0 and timer=600000 then 
      ologfile.writeline Now & " Link is now down!"
      notifymail "Down",Now
      timedown=.1
      limitupdate=0
    end if
    'accumulate and report down time
    if timer=40000 then
      totaltimedown=totaltimedown+1
      timedown=timedown+1
      if int(timedown) > limitupdate+14 then
        ologfile.writeline "This link failure is now at least " & Int(timedown) & " minutes in duration."
        limitupdate=timedown
      end if
    else
    'Link is down, increase frequency of checks!
      Timer=40000
    end if
  else
' Connection is up or back up
    if loopcount=0 then 
      ologfile.writeline Now & " Link is up!"  
    end if
    if totaltimedown>1 and timer=60000 then 
      ologfile.writeline "Total time down for this network connection is now at least " & totaltimedown & " minutes."
    end if
    if timedown>0 then 
      ologfile.writeline Now & " Link is back up!"
      notifymail "Up",Now
    end if
    Timer=600000
    Timedown=0
  end if
end sub

sub Notifymail(status,statustime)
  Dim NotificationString, objEmail
  NotificationString="Internet Connection " & status & " at " & statustime
  Set objEmail = CreateObject("CDO.Message")
  objEmail.From = FromEmailaddress
  objEmail.To = ToEmailAddress
  objEmail.Subject = "Internet Connection " & status
  objEmail.Textbody = NotificationString
  objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer 
  objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = ServerPort
  objEmail.Configuration.Fields.Update
  objEmail.Send
end sub