'Get Event Viewer Filering by: event,source,id,days,server USING: dumpel.exe
'Be able to get Multiple Evens from Multiple Servers(servers array ?) events in array (?) 
'NOTES: dumpel.exe is much faster then WMI or LogParser API
'Author: Felipe Ferreira
'Date: 24/10/07
'Version: 3.0 - Working

'TODO:
'Get Comments Dynamicly and instert into strBody
'Allow to set Comments in EventsList

'@@GLOBAL VARS
Dim t1 : t1 = Timer  'time the script
dim strScriptFile : strScriptFile = WScript.ScriptFullname
dim strScriptPath : strScriptPath = Left(strScriptFile, Len(strScriptFile) - Len(WScript.Scriptname)) 
Dim EventDumpPath : EventDumpPath = strScriptPath & "log\"
Dim ofso : Set ofso = CreateObject("Scripting.FileSystemObject")
Dim blnErrorFound : blnErrorFound = false
Dim EventDumplog, strLine, strBody, Server
Dim dumpFileCnt, cntServers, cntServersOK, cntServersErr
Dim k,i,s
Dim intLineCnt : intLineCnt = 0
'Main OutputFile Name
Dim outputfile : outputfile= strScriptPath & "Events_Check_" & cstr(day(now())) &"_" & cstr(Month(now()))& ".txt"
Dim outFile: Set outFile = ofso.CreateTextFile(outputfile, True)

'@@@@@@@@@@@@DEFINE, or get dynamic from  TXT or Array
Dim arrTodo(10,10)
Dim inputFile : inputFile = strScriptPath & "EventsList.txt"
Dim EventDaysOld : EventDaysOld = 1
Dim strMailServer : strMailServer = "mail.coco.com"
dim ix 
'@@@@@@@@@@@@DEFINE, or get dynamic from  TXT or Array

'Declare Servers Groups to Search Events
'servers = "EX01,EX02"
'GET Events List from TXT and build arrToDo 
ReadTxtToArray(inputFile)

strbody = "Checking for " & intLineCnt & " events. Event Ids - Details - Servers: " & vbCrlf &_	 
	 "   4830 - Low Memory Warnings - EX" & vbCrlf &_
	 "   1004,1000 - Exchange Application Errors - EX" & vbCrlf &_
	 "   11   - Control Doube UPN - DMC" & vbCrlf &_
	 "   5641   - BizTalk for Disabled Recieve Locations - BIZ" & vbCrlf & vbCrlf 
	 

For s=0 to intLineCnt	'arrTdo Loop = Number of Lines in TXT = number of Events to Query
 'Dynamicly changes according to GROUP EX, BIZ, DMC
  for k=1 to 11 ' ciclo per  Server     
	if arrtodo(s,3) <> "EX" then 'AVOID BIZ, DMC loop	 
	ix = 1 'NO LOOP THRU CLUSTER NODES
	else
	ix = 8 'GO THRU ALL 8 CLUSTER NODES
	end if 	
' ciclo per Cluster Node
	For i=1 to ix 
	
'DYNAMICLY FORMAT SERVERS NAME ACCORDING TO ITS GROUP	
	if arrtodo(s,3)="MST" then
		if K = 5 or K = 6 or K = 7 or K = 9 or K = 10 or K = 11 then
		Server = "SRVR"& arrtodo(s,3) &"0"& K & "C0" & i   'DYNAMIC SERVERNAME 
		else 'Not 
			exit for
		end if		
	end if	
	if arrtodo(s,3)="DMC" and k <= 7 Then
	Server = "SRVR"& arrtodo(s,3) & "1" & K   'DYNAMIC SERVERNAME 
	elseif arrtodo(s,3)="DMC" and k >= 8 then 		
		exit for 'Do nothing	
	end if
	if arrtodo(s,3)="BIZ" and k <= 8 Then
	Server = "SRVR"& arrtodo(s,3) & "02B0" & K   'DYNAMIC SERVERNAME 
	elseif arrtodo(s,3)="BIZ" and k >= 8 then 		
		exit for 'Do nothing	
	end if
	
	'wscript.echo "Checking: " & Server & " Event Source: " & arrToDo(s,1) & " EventID: " & arrToDo(s,2) & vbCrlf
	outFile.writeline date & time & " - Checking: " & Server & " EventID: " & arrToDo(s,2) 
	

	if arrToDo(s,2) <> "" Then
	
'FUNCTION CALLS:    (eType,eSource,eError,eServer,eDays) Application, Id, Type		
	Call Execute(arrToDo(s,0),arrToDo(s,1),arrToDo(s,2),Server,EventDaysOld)	
	Call CheckifError(Server & "_" & arrToDo(s,2) & ".txt",EventDumpPath)
	
	cntServers = cntServers + 1
	end if
'If errors/events found output	
	if blnErrorFound = true then
	'Event Found, Outputs to Txt and to Email Body		
		
		'@@@@@@@@@@@@OUTPUT	FILE
		outFile.writeline date & " " & time & " - Events Found: " & Server & " EventID: " & arrToDo(s,2) & dumpFileCnt 
		outfile.writeline EventType & " " & EventSource & " Events  " & " Older then " & EventDaysOld
		outfile.writeline strline
		outfile.writeline "----------------------------------------------------------"
		
		'@@@@@@@@@@@@OUTPUT	EMAIL
		strBody = strBody & vbCrlf & "Found Errors on: " & Server & " EventID: " & arrToDo(s,2)
		
		cntServersErr = cntServersErr + 1

		elseif blnErrorFound = False then		
		outFile.writeline date & time & " - Nothing Found"
		cntServersOK = cntServersOK + 1
	end if
  next 'next EVS
 next ' NEXT CLUSTER  
 	outFile.writeline vbCrlf
next 'S, Next arrToDo 

RunTime = Left(Timer  - t1, 4)


outfile.writeline   "----------------------------------------------------------"
outfile.writeline "Checked : " & cntServers & " servers. "
outfile.writeline "Servers with Errors : " & cntServersErr & " Servers OK: " & cntServersOK
outfile.writeline "Script Runtime: " & Runtime & " sec."	
outFile.close

strBody = strbody & vbCrlf &  "----------------------------------------------------------"
strBody = strbody & vbCrlf &  "Checked : " & cntServers & " servers. "
strBody = strbody & vbCrlf & "Servers with Errors : " & cntServersErr & " Servers OK: " & cntServersOK
strBody = strbody & vbCrlf & "Script Runtime: " & Runtime & " sec."	

sendmail "mailperf@coco.com", "F@coco.com","", "Event Viewer Controls", strBody , outputfile	 
'wscript.echo "DONE"
wscript.quit



'@@@@@@@@@@@@@@@@@@@@@@@FUNCTIONS AND SUBS@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Function Execute(eType,eSource,eError,eServer,eDays)
	on error resume next
	blnErrorFound = False
	EventDumplog = EventDumpPath & eServer & "_" & eError & ".txt"
	dim strCmd,strCmdOut
	dim objShell : Set objShell = WScript.CreateObject("WScript.Shell")	

	strCmd = strScriptPath & "dumpel.exe -f " & EventDumpLog & " -l " & eType & " -m " & eSource & " -e " & eError & " -s " & eServer & " -d " & eDays	
	'wscript.echo strCmd	
	Dim objExecObject : Set objExecObject = objShell.Exec(strCmd)	
'MUST GET STDOUT, SOMETIMES APP DONT RUN!
	Do While objExecObject.Status <> 1		
		wscript.sleep 2000	
		'Wscript.StdOut.Write(".")		
	Loop	
	
	if err.number = 0 and objExecObject.Status = 1 then 	
		
	end if


end function

sub CheckIfError(eLog,ePath)
'Looks into Log folder if any .txt and not 0kb turn ErrorFound=true that will zip and send email
	Dim fs,f,f1,fc
	dumpFileCnt = 0
	'wscript.echo "Checking if errors: " & epath & eLog
	Dim ofso : Set ofso = CreateObject("Scripting.FileSystemObject")	
	Set fs = CreateObject("Scripting.FileSystemObject")	
		Set f = fs.GetFolder(ePath)
		Set fc = f.Files
		For Each f1 in fc			
			'IF 0KB then Delete				
			If ( (f1.size =0) And (UCase(right(f1.name,4))=UCase(".txt")) ) Then
				f1.delete
			elseif  (f1.size <> 0) and (f1.name = eLog) Then									
				if f1.size < 900000 then 'If over 200Kb dont even Open
					Dim dumpFile: Set dumpFile = ofso.OpenTextFile(f1.path, 1)
					Do While Not dumpFile.AtEndOfStream 						
							dumpFileCnt = dumpFileCnt + 1
							if DumpFilecnt = 1 then 
								strLine = dumpFile.ReadLine
							elseif DumpFilecnt > 450 then
							 exit do
							end if
					loop										
				end if 'File Dump Size Check
				DumpFilecnt = "Event dump File Size = " & toMegabytes(f1.size)
				blnErrorFound = True
			end if	
		Next ' Next File	
end sub


Function toMegaBytes(bytes) 
	if bytes > 1000000  then 'only if over 1 mb
                toMegabytes = int ((bytes / 1024) /1024) 
				toMegabytes = FormatNumber(toMegaBytes,2) & " mb"
	elseif bytes < 1000000 then
				toMegabytes = bytes & " bytes"
	end if			
End Function

Sub SendMail(sFrom,sTo,sCC,sSub,sBody,sAttch)
	err.clear
	Set objEmail = CreateObject("CDO.Message")
	objEmail.From = sFrom
	objEmail.To = sTo
	ObjEmail.CC = sCC
	objEmail.Subject = sSub
	objEmail.Textbody = sBody
	objEmail.AddAttachment sAttch
	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
			wscript.echo "Error sending email : " & err.descprition
			wscript.quit
		end if
end sub



Function ReadTxtToArray(strInputFilePath)
'Get parameters(eventType,eventSource,EventID,SRVGroup,DEscription from TXT
 Dim strLineIn 
 Dim arrTxt
 Dim iFSO : Set iFSO = CreateObject("Scripting.FilesyStemObject")
 Dim ifile : Set ifile = iFSO.OpenTextFile(strInputFilePath,1) 
 	'Start to read the inputfile and goes thru each line
	Do until ifile.AtEndOfLine		
			strLineIn = ifile.ReadLine				
			arrTxt = Split(strLineIn, ",")			
			if  Ubound(arrTxt) = 4 then 						
				arrTodo(intLineCnt,0) = arrTxt(0)  'EventType
				arrTodo(intLineCnt,1) = chr(34) & arrTxt(1) & chr(34) 'EventSource
				arrTodo(intLineCnt,2) = arrTxt(2)  'EventID
				arrTodo(intLineCnt,3) = arrTxt(3)  'Server GROUP: MST,PRV,DMC
				arrTodo(intLineCnt,4) = arrTxt(4)  'Comments
				intLineCnt = intLineCnt + 1				
			elseif Ubound(arrTxt) <> 4 then
				Wscript.echo "Check inputfile, parameters errors"
				wscript.quit
			end if		
   loop
      ' close the file
      iFile.Close
  End Function