'SCRIPT TO GET CUSTOM EVENT VIEWER ERRORS, ZIP, and EMAIL IT
'Auhour: Felipe Ferreira Date: 11/07/07 Version:1.0
'Maybe Schedulle it to Check , if erros send an email
'REQUIRES: LOGPARSER!
Dim oLogQuery
Dim oEVTInputFormat
Dim oCSVOutputFormat 
Dim strQuery
Dim outputfile, inputfile, ifso, zipfile
Const ForReading=1,ForWriting=2,ForAppending=8
Dim ErrorFound 'Control error to send emails

ErrorFound = False

'#########VARIABLES TO EDIT
outputfilepath="c:\Events\logs\"
zipfile="c:\Events\zip\ServiceMonitor.zip"
inputfile = "servers.txt"    
'ALSO LINE FOR SMTP RELAY SERVER!
'#############

Set ifso = CreateObject("Scripting.FileSystemObject")
Set iFile = ifso.OpenTextFile(inputfile, ForReading, False)'list of servers to get logs from

DeleteLog   'DELETE ALL .TXT FILES IN THE LOG FOLDER

Do While Not iFile.AtEndOfStream 'read the text file for input each line is one server
	strcomputer=iFile.ReadLine
	outputfile= outputfilepath & "Event_" & strcomputer & "_" + cstr(Month(now()))+"_"+cstr(day(now()))+".txt" 'Should be DYNAMIC
	Set oLogQuery = CreateObject("MSUtil.LogQuery")
	' Create Input Format object
	Set oEVTInputFormat = CreateObject("MSUtil.LogQuery.EventLogInputFormat")
	oEVTInputFormat.direction = "BW"
	' Create Output Format object
	Set oCSVOutputFormat = CreateObject("MSUtil.LogQuery.CSVOutputFormat")
	oCSVOutputFormat.tabs = TRUE
	oCSVOutputFormat.oDQuotes = "OFF"
	oCSVOutputFormat.oTsFormat = "yyyy-MM-dd"
	oCSVOutputFormat.oCodepage = -1
	' Create query text
	dim fields
	fields = "'EventLog','SourceName','TimeGenerated','Strings','Message'"
	fields = "Strings"
	strQuery = "SELECT TimeGenerated, SourceName, EventCategoryName, Strings INTO " & outputfile & " FROM '\\"& strcomputer &"\Customizations'"
	strQuery = strQuery & " WHERE SourceName = 'Custom Exchange Services 2' AND EventTypeName = 'Error event'" 
	strQuery = strQuery & " AND TimeGenerated >= TO_LOCALTIME( SUB( SYSTEM_TIMESTAMP(), TIMESTAMP( '01', 'hh' )))"
	oLogQuery.ExecuteBatch strQuery, oEVTInputFormat, oCSVOutputFormat
loop

'@@@@@@@@@@@@@CALL SUBS, FUNCTIONS@@@@@@@@@@@@@@
CheckIfError

fZip outputfilepath,zipfile


sub CheckIfError
'CODE TO CHECK IF ANY .TXT IS > 0KB, IF SO RAR IT AND SEND THE EMAIL
'Costanti per decidere la modalità di apertura file
	Dim fs					'oggetto FileSystem
	Dim f					'oggetto folder 
	Dim f1					'oggetto file SmtpLog da cancellare
	Dim fc					'array di file SmtpLog
	'Creo l'oggetto FileSystem
	Set fs = CreateObject("Scripting.FileSystemObject")
	
	If (fs.FolderExists(outputfilepath)) Then
		Set f = fs.GetFolder(outputfilepath)
		Set fc = f.Files
		For Each f1 in fc
			strFile=f1.name
			nSize=f1.size 
			If ( (nSize=0) And (UCase(right(strFile,4))=UCase(".txt")) ) Then
				f1.delete
			else if ( (nSize>2) And (UCase(right(strFile,4))=UCase(".txt")) ) Then
				ErrorFound = True
			end if	
			end if
		Next
	Else
	End If	
end sub

'############ZIP FILES
Function fZip(sSourceFolder,sTargetZIPFile)
'This function will add all of the files in a source folder to a ZIP file
'using Windows' native folder ZIP capability.
'Wscript.Echo "Zipping Folder: " & sSourceFolder & " to: " & sTargetZIPFile
Dim oShellApp, oFSO, iErr, sErrSource, sErrDescription
Set oShellApp = CreateObject("Shell.Application")
Set oFSO = CreateObject("Scripting.FileSystemObject")
 'The source folder needs to have a \ on the End
 If Right(sSourceFolder,1) <> "\" Then sSourceFolder = sSourceFolder & "\"
On Error Resume Next 
  'If a target ZIP exists already, delete it
  If oFSO.FileExists(sTargetZIPFile) Then oFSO.DeleteFile sTargetZIPFile,True 
 iErr = Err.Number
 sErrSource = Err.Source
 sErrDescription = Err.Description
On Error GoTo 0
 If iErr <> 0 Then   
  fZip = Array(iErr,sErrSource,sErrDescription)
  Exit Function
 End If
On Error Resume Next
 'Write the fileheader for a blank zipfile.
 oFSO.OpenTextFile(sTargetZIPFile, 2, True).Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
 iErr = Err.Number
 sErrSource = Err.Source
 sErrDescription = Err.Description
On Error GoTo 0
 If iErr <> 0 Then   
  fZip = Array(iErr,sErrSource,sErrDescription)
  Exit Function
 End If
On Error Resume Next 
 'Start copying files into the zip from the source folder.
 oShellApp.NameSpace(sTargetZIPFile).CopyHere oShellApp.NameSpace(sSourceFolder).Items
 iErr = Err.Number
 sErrSource = Err.Source
 sErrDescription = Err.Description
On Error GoTo 0
 If iErr <> 0 Then   
  fZip = Array(iErr,sErrSource,sErrDescription)
  Exit Function
 End If
  'Because the copying occurs in a separate process, the script will just continue.  Run a DO...LOOP to prevent the function
  'from exiting until the file is finished zipping.
  Do Until oShellApp.NameSpace(sTargetZIPFile).Items.Count = oShellApp.NameSpace(sSourceFolder).Items.Count
   WScript.Sleep 3500
  Loop
fZip = Array(0,"","")
End Function 

sub DeleteLog

Dim fs,f,f1,fc	'oggetto FileSystem 'oggetto folder 	'oggetto file da cancellare 'array di file
	Set fs = CreateObject("Scripting.FileSystemObject")
If (fs.FolderExists(outputfilepath)) Then
		Set f = fs.GetFolder(outputfilepath)
		Set fc = f.Files
		For Each f1 in fc
			'Ricavo il nome del file
			strFile=f1.name
			If(UCase(right(strFILE,4))=UCase(".txt"))  Then
				f1.delete 'DELETE ALL .TXT FILES IN THE LOG FOLDER
			End If
		Next
	Else
		WScript.Echo "Folder non esiste"
	End If	
end sub

'############SEND EMAIL SUB 7 PARAMETERS
sub send_mail(strPassDA, strPassA, strPassCC, strPassBCC, strPassO, strPassT, strPassAttach)
		Dim iMsg
		Dim iConf
		Dim Flds
		Dim strHTML
		Const cdoSendUsingPort = 2
		set iMsg = CreateObject("CDO.Message")
		set iConf = CreateObject("CDO.Configuration")
		Set Flds = iConf.Fields
		' CDOSYS configuration for SMTP server.
		With Flds
		.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
		'ToDo: Enter name or IP address of remote SMTP server.
		.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.something.com"
		.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
		.Update
		End With
		' Apply the settings to the message.
		With iMsg
		Set .Configuration = iConf
		.To = strPassA
		.From = strPassDA
		.CC = strPassCC
		.BCC = strPassBCC
		.Subject = strPassO
		.HTMLBody = strPassT
		if strPassAttach<>"" then
			.AddAttachment strPassAttach
		end if
		.Send
		End With	
		' Clean up variables.
		Set iMsg = Nothing
		Set iConf = Nothing
		Set Flds = Nothing	
end sub

strBody = "Trovato errori sul Exchange Custom Services, detagli in file allegato"

if ErrorFound = True then
	'Wscript.echo "ERRORS FOUND, Sending email"
	send_mail "mail@cmam.com", "monitor23@cmam.com", "", "", "Sun Service Monitor", strBody , zipfile
end if
wscript.quit