''
'Place this script in any directory. '
'Execute script and receive MOM alerts.'
'Writes to files in same directory. '
'Logs an Information event if '
'connectivity fails for 3 consecutive '
'minutes (measure of 6). '
'2 echo's each minute. '
'Running total parameters: '
'Line up = 0 '
'50% packet loss = 1 '
'100% packet loss = 2 '
'Logs an event when running total '
'= 6. '
'Author: Jonathan Almquist '
'monsterjta at tek-tips '
'''
Option Explicit
Dim WshShell
Dim Fso
Dim CurDir
Dim TodaysLog
Dim LogName
Dim TempLogName
Dim CreateLog
Dim TodayDate
Dim TomorrowDate
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Set WshShell = CreateObject ("wscript.Shell")
Set Fso = CreateObject ("scripting.filesystemobject")
TodayDate = Date
TomorrowDate = Date + 1
CurDir = CreateObject ("WScript.Shell").CurrentDirectory & "\"
TempLogName = CurDir & "TempLog.txt"
''
'Definitions and ip address array'
''
Dim AddressList
Dim ipAddress
AddressList = Array ("<ip_address or A_Record")
'
'Create the logfiles'
'
Call CreateLogFile
''
'Ping each ip address and write to logfile'
''
Do While TodayDate = Date
For Each ipAddress In AddressList
Call KeepAlive
Next
WScript.Sleep (30000)
For Each ipAddress In AddressList
Call AnalyzeLogs
Next
WScript.Sleep (30000)
'
'New day'
'
If TodayDate <> Date Then
TodayDate = Date
TomorrowDate = Date + 1
Call CreateLogFile
End If
Loop
'
'FUNCTIONS'
'
Function CreateLogFile
For Each ipAddress In AddressList
LogName = CurDir & Replace (TodayDate, "/", "-", 1) & "_"
LogName = LogName & ipAddress & ".txt"
Set CreateLog = Fso.CreateTextFile (LogName, True)
CreateLog.Close
Next
End Function
Function KeepAlive
Dim Ping
Dim Command
Dim CreateTempLog
Dim ReadTempLog
Dim TempLine
Dim CurTime
Dim WriteLog
LogName = CurDir & Replace (TodayDate, "/", "-", 1) & "_"
LogName = LogName & ipAddress & ".txt"
Set WriteLog = Fso.OpenTextFile (LogName, ForAppending)
CurTime = Time
Set CreateTempLog = Fso.CreateTextFile (TempLogName, True)
CreateTempLog.Close
Command = "cmd /C ping -n 2 " & ipAddress & " > " & """" & TempLogName & """"
Ping = WshShell.Run (Command, 0, true)
Set ReadTempLog = Fso.OpenTextFile (TempLogName, ForReading)
Do Until ReadTempLog.AtEndOfStream
TempLine = ReadTempLog.ReadLine
TempLine = Trim (TempLine)
'
'Build string for logfile'
'
If InStr (TempLine, "Packets:") Then
If InStr (TempLine, "(0% loss)") Then WriteLog.WriteLine _
(CurTime & " ::: Line Up! ::: code 0")
If InStr (TempLine, "(50% loss)") Then WriteLog.WriteLine _
(CurTime & " ::: Warning! ::: 50% Packet Loss during this keepalive interval! ::: code 1")
If InStr (TempLine, "(100% loss)") Then WriteLog.WriteLine _
(CurTime & " ::: Critical! ::: 100% Packet Loss during this keepalive interval! ::: code 2")
End If
Loop
ReadTempLog.Close
ReadTempLog = Fso.DeleteFile (TempLogName, True)
End Function
''
'Analyze logs and issue MOM Alert if running totals => 6'
''
Function AnalyzeLogs
Dim LogName
Dim ReadLog
Dim ReadLine
Dim FindCodeNo
Dim CodeNo
Dim RunningTotal
LogName = CurDir & Replace (TodayDate, "/", "-", 1) & "_"
LogName = LogName & ipAddress & ".txt"
Set ReadLog = Fso.OpenTextFile (LogName, ForReading)
RunningTotal = 0
Do Until ReadLog.AtEndOfStream
ReadLine = ReadLog.ReadLine
FindCodeNo = Len (ReadLine)
CodeNo = Mid (ReadLine, FindCodeNo, 1)
''
'Do more measures and calcs here'
''
'If RunningTotal <> 0 And CodeNo = 0 Then
' RunningTotal = RunningTotal - 1
' Else
' RunningTotal = RunningTotal + CodeNo
'End If
RunningTotal = RunningTotal + CodeNo
Loop
If RunningTotal => 6 Then
On Error Resume Next
Dim WSHShell, InsertEvent
Const INFORMATION = 4
Set WSHShell = CreateObject("WScript.Shell")
If Err.Number <> 0 Then
InsertEvent = "KeepAlive:" _
& vbCrLf & vbCrLf & LogName & vbCrLf & vbCrLf & _
"An error has been encountered." _
& vbCrLf & vbCrLf
Else
InsertEvent = "KeepAlive:" _
& vbCrLf & vbCrLf & ipAddress & vbCrLf & vbCrLf & _
"Detected connectivity interruptions." & _
" Check corresponding logfile immediately." _
& vbCrLf & vbCrLf
End If
WSHShell.LogEvent INFORMATION, InsertEvent
On Error Goto 0
End If
End Function
