'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 = "logs_emails_" & GetFormatedDate(Date) & ".txt"
strEmailTo = "monitor@monitor.net"
strEmailFrom = "oasismon@monitor.net"
strMailServer = "mail.domain.net"
strSub = "Monitor de Servidores"
LogOpen = sPath & "HostsOpen.txt"
LogDown = sPath & "HostsDown.txt"
arrServers = Array("SERVER1","SERVER2","SERVER3")
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!"
		strBody = " 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
			 strBody = "Servidor " & strComputer & " vuelto Online " & time
			 call SendEMail(strEmailFrom,strEmailTo,"",strSub,strBody)
			end if
			
			
	   else 
			PingStatus = "False"
			stdout "Servidor " & strComputer & " DOWN!!!" & time
			strBody = "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