I am using to monitor about 80 servers and its doing the job...
I want to release a better version, just did not had the time. anybody is welcome to improve this
'script to Monitor Hosts/Ports
'Requires: w3Sockets , Download here : http://tech.dimac.net/default3.asp?M=FreeDownloads/Menu.asp&P=FreeDownloads/FreeDownloadsstart.asp
'Author: Felipe Ferreira
'Date 26/06/2008
'Version:2.0
' To avoid duplicate emails, should keep track of of hosts/ports down in HostsDown.txt - OK
' and before sending an email check that file, if host come back up should also send email and remove from hostDown.txt - OK
'TODO:
' Same Logic for Ports if port down/up
' If server is down for over X minutes Send again the email, or send to another recipient
' Use just One host file for control, add DOWN to the line, and Time
'Notes:
'cdown = 0 ' HOST IS ALREADY SET AS DOWN
'cdown = 1 ' HOST WAS NOT SET AS DOWN
Const ForReading=1,ForWriting=2,ForAppending=8
Dim fcheckfound
Dim sPath, strScriptFile,strStatus
Dim arrServers, arrPorts
dim Verbose
Dim intServersChecked
dim strMailServer
Dim cdown
Dim arrDown
Dim strEmailTo,strEmailFrom, strSub, strBody
Dim LogOpen, LogFile,LogDown ' Write the Logs of each email sent out
Dim oFS
strScriptFile = WScript.ScriptFullname
sPath = Left(strScriptFile, Len(strScriptFile) - Len(WScript.Scriptname)) 'used to define the path from where the script file is located
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
Dim objShell : Set objShell = CreateObject("WScript.Shell") ' Run cmds
'##################EDIT#######################
Verbose = 1 'OUTPUTS ENABLE = 1 to DISABLE = 0
LogFile = "c:\scripts\logs\logs_emails_" & GetFormatedDate(Date) & ".txt"
strEmailTo = "ffe@mp.net"
strEmailFrom = "oan@mp.net"
strMailServer = "mail.oasismp.net"
strSub = "Monitor de Servidores"
LogOpen = sPath & "HostsOpen.txt"
LogDown = sPath & "HostsDown.txt"
arrServers = Array("Server12","server20")
arrPorts = Array("3389","25","110") 'TS, SMTP, POP3
'##################EDIT#######################
Dim F : Set F = Fso.CreateTextFile(LogOpen, TRUE)
call scan()
wscript.quit
'####################### FUNCTIONS AND SUBS ################################
Sub scan()
for each strHost in ArrServers
for each intPort in arrPorts
stdout strHost & " , " & intPort
If PingStatus(strHost) = "True" then 'if Host dont respond to ICMP, dont Scanit
call fcheck(strHost, intPort)
intServersChecked = intServersChecked + 1
end if
next 'loop of services
next 'loop of server
end sub
Function fcheck(strhostp,intportp)
'REQUIRES Socket.dll download w3wsockets from http://tech.dimac.net/default3.asp?M=FreeDownloads/Menu.asp&P=FreeDownloads/FreeDownloadsstart.asp
err.clear
Dim oSocket, iErr, sSocketText
sSocketText = "asdasdasasdasdasdasd"
Set oSocket = CreateObject("Socket.TCP")
oSocket.DoTelnetEmulation = True
oSocket.TelnetEmulation = "TTY"
oSocket.Host = strhostp & ":" & intportp
oSocket.timeout = 100 '100 ms
On Error Resume Next
oSocket.Open
iErr = Err.Number
If iErr <> 0 Then
'Log That Server Refused connection and send EMAIl
stdout " Host : " & strhostp & " port : " & intportp & " failed!"
strSub = " Servidor : " & strhostp & " Puerto : " & intportp & " no contesta " & time
call SendEMail(strEmailFrom,strEmailTo,"",strSub,strBody)
Exit Function
End If
sSocketText = oSocket.GetLine
oSocket.SendLine "quit"
fcheckfound = 1
'#########WRITE LOG
F.WriteLine strHostp & " | " & intportp
oSocket.Close
On Error GoTo 0
End Function
Function PingStatus(strComputer)
On Error Resume Next
strWorkstation = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strWorkstation & "\root\cimv2")
Set colPings = objWMIService.ExecQuery _
("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'")
For Each objPing in colPings
'Quickly Identify, Ping Status is 0 then OK, otherwise do not add server to list, no ping response!
If objPing.StatusCode = 0 then
PingStatus = "True"
'Should control in Down if present Remove
CheckIfDown(strComputer)
if cdown = 0 then
'Was in LogDown list, but now it is back Online, remove from down and send an email
RemoveDown(strComputer)
stdout "Servidor " & strComputer & " vuelto Online " & time
strSub = "Servidor " & strComputer & " vuelto Online " & time
call SendEMail(strEmailFrom,strEmailTo,"",strSub,strBody)
end if
else
PingStatus = "False"
stdout "Servidor " & strComputer & " DOWN!!!" & time
strSub = "Servidor " & strComputer & " DOWN " & time
'Should Send Email only If it is the first time its Down
CheckIfDown(strComputer)
if cdown = 0 then
'Already Reported as Down so DO NOT send Email
stdout strComputer & " was Already down, not sending email..."
else if cdown = 1 then
'First Report of Server Down
stdout "down 1st time, sending an email..."
SetDown(strComputer)
call SendEMail(strEmailFrom,strEmailTo,"",strSub,strBody)
end if
end if
end if
Next
on error goto 0
End Function
'------------------------------------------------------------------------
' Sub SendEmail
'------------------------------------------------------------------------
Sub SendEMail(sFrom,sTo,sCC,sSub,sBody)
'BEFORE SENDING SHOULD VERIFY IN LOGS_EMAILS IF SERVERNAME IS ALREADY THERE IS SO IN THE LAST 1HOUR DO NOT RESEND...
err.clear
Dim objEmail : Set objEmail = CreateObject("CDO.Message")
objEmail.From = sFrom
objEmail.To = sTo
ObjEmail.CC = sCC
objEmail.Subject = sSub
objEmail.Textbody = sBody
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strMailServer
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
if err.number <> 0 then
stdout "Error sending email : " & err.descprition
wscript.quit
else
stdout "Email Enviado a: " & sTo
log "-------------------------" & vbcrlf & time & " Email enviado a: " & strEmailTo & " -Subject: " & strSub & " -Body: " & sBody
end if
end sub
Function Log(msgLog)
on error resume next
Set oFS = CreateObject( "Scripting.FileSystemObject" )
IF oFS.FileExists(LogFile)= false then
oFS.CreateTextFile(LogFIle)
call log(msgLog)
else
Set oFile = oFS.OpenTextFile(LogFile,ForAppending, True)
oFile.Writeline msgLog
end if
oFile.close
set oFS = nothing
end function
Function GetFormatedDate(inputDate)
'Format Date DD_MM
Dim intMonth : intMonth = Right("00" & Month(inputDate), 2)
Dim intDay : intDay = Right("00" & Day(inputDate), 2)
Dim intYear : intYear = Year(inputDate)
GetFormatedDate = intDay &"_"& intMonth & "_" & intYear
End Function
Function CheckIfDown(strHost)
'__OPENS THE LOG FILE AND CHECK IF EMAIL WAS ALREADY SENT (AVOID DUPLICATE EMAILS)
cdown = 1 'In case file is Empty
Set oFS = CreateObject( "Scripting.FileSystemObject" )
Set oFile = oFs.GetFile(logdown)
sizeFile = oFile.size
IF oFS.FileExists(LogDown)= true and sizeFile <> 0 then
Set oFile = oFS.OpenTextFile(LogDown,ForReading)
aLines = Split(ofile.ReadAll,VbCrLf)
oFile.Close
for each line in aLines
If Trim(line) <> "" Then
' Parse each line
'stdout line
if instr(line,strHost) then
'Do not resend email maybe calculate last email time?
cdown = 0 ' HOST IS ALREADY SET AS DOWN
else
cdown = 1 ' HOST WAS NOT SET AS DOWN
end if
end if
next 'line
else ' FILE DOES NOT EXISTS
if not sizeFile = 0 then
Set oFile= oFS.CreateTextFile(LogDown, True)
set OFs = nothing
CheckIfDown(strHost)
end if
end if 'File Exist
set oFS = nothing
end function
Function SetDown(strHost)
Set oFS = CreateObject( "Scripting.FileSystemObject" )
IF oFS.FileExists(LogDown)= true then
Set oFile = oFS.OpenTextFile(LogDown,ForAppending,True)
stdout "Writing to LogDown " & strHost & " | " & time
oFile.Writeline strHost & " | " & time
oFile.Close
end if
set oFS = nothing
end function
Function RemoveDown(strHost)
on error resume next
Dim Line,wLine
Set oFS = CreateObject( "Scripting.FileSystemObject" )
Set oFS2 = CreateObject( "Scripting.FileSystemObject" )
IF oFS.FileExists(LogDown)= true then
Set oFile = oFS.OpenTextFile(LogDown,ForReading)
aLines = Split(ofile.ReadAll,VbCrLf) 'IF FILE IS EMPTY GETS AN ERROR!
oFile.Close
set oFile = nothing
'Should Check if FIle is empty if so Do not Open for writing
Set oFile = oFS.OpenTextFile(LogDown,ForWriting,True)
for each iline in alines
if iline <> "" then
'stdout iline
if instr(iline, strHost) then
stdout "Removing from LogDown, Host : " & iline
line = replace(iline,strHost,"-----")
oFile.writeline line 'wLine = replace(wLine,strHost,"----") 'SHOULD CLEAR THE LINE
else
Ofile.WriteLine iline
end if
end if ' Line is not empty
next 'line
oFile.close
end if
set oFS = nothing
end function
Function stdout(msgTxt)
'Prints msg on screen only if Verbose is set
if Verbose = 1 then
wscript.echo msgTXT
end if
end Function