Monitor Hosts

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Monitor Hosts

Logged in as: Guest

arrSession:exec spGetSession 2,16,62108

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Monitor Hosts
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Monitor Hosts - 7/2/2008 12:31:44 AM

4scriptmoni

Posts: 192
Score: 0
Joined: 5/3/2007
Status: offline

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

_____________________________

Enterprise Microsoft Scripts
Exchange, Login/Logout Monitor,TS, Monitoring, Security, AD, etc...
http://www.felipeferreira.net