'Atuhor Felipe Ferreira
'Date:  21/11/2007 updated 02/11/08
'Version 9.0

'This script will generate a List of all Top Email Senders by default of yestaday,
'Get Top SPammers/Emails Sent Out and Send Output Via Email.


'TO DO(nagios version):
'1.Clean up Useless CODE, OK
'2.Better Argument Handlers, OK
'3.If first time, need to register logparser.dll, OK
'4.Get ServerName from argument, OK


Const ForReading=1,ForWriting=2,ForAppending=8,adLockOptimistic = 3,adOpenDynamic = 1
Const adOpenStatic = 3
Const adUseClient = 3
Const intOK = 0
Const intICritical = 2
Const intIWarning = 1
Const intUnknown = 3
Dim DisabledUPNS,sFile 
Dim strScriptFile : strScriptFile = WScript.ScriptFullname
Dim sPath : sPath = Left(strScriptFile, Len(strScriptFile) - Len(WScript.Scriptname)) 
Dim nomelog, i,strQuery
Dim SpammersCnt : SpammersCnt = 0
Dim objFSO ,body
Dim intWarning,intCritical
dim intSpamTot : intSpamTot  = 0

'@@@@@@@@@@DB FORMAT@@@@@@@@@@
Dim arrFields(2)
Dim arrValues
arrFields(0) = "DATE"
arrFields(1) = "UPN"
arrFields(2) = "COUNT"
'@@@@@@@@@@FILE NAMES@@@@@@@@
Dim strDB : strDB = sPath & "SpamDB.mdb"          ' name and location of access file
Dim strDBTable : strDBTable = "SPAMCOPOUT"
dim whitelist : whitelist  = "whitelist.txt"	  'WHITELIST, conatins UPNs allowed to send 
Dim strFileTop : strFileTop = "TopSpammers.txt"
Dim outputfile : outputfile = spath & "logs\Spammers_"& cstr(day(now())-intDaySpam) &"_" & cstr(Month(now()))&".txt"
Dim argcountcommand
Dim arg(25)

'@@@@@@@@@@----------EDIT-------------@@@@@@@@@@@@@
Dim Verbose : Verbose = 0 '=1 Display Msgs, =0 QUIET MODE
Dim intRLimit : intRLimit = 10      'Max Recipient Limit To be set
Dim intSpamMin : intSpamMin = 10    'More then 500 a day(24hr) is considered SPAMMER
Dim intTopSpam : intTopSpam = 3    'How many of Top Spammers to report
Dim intDaySpam : intDaySpam = 1     'How many days ago to check (ONLY SAME MONTH), default yestarday
Dim strLDAP 			    'NOW AUTOMATIC: strLDAP = "'" & "LDAP://GC.DOMAIN.local/DC=local" & "'"
Dim serverOUT(0) 		    'Array with SMTP OUT Servers, nagios only One
'@@@@@@@@@@----------EDIT-------------@@@@@@@@@@@@@


'@@@@@@@@@@@ HANDLES THE ARGUMENTS @@@@@@@@@@@@@@@
GetArgs()
if ((UCase(wscript.arguments(0))="-Help") Or (UCase(wscript.arguments(0))="--HELP")) and (argcountcommand=1) or (argcountcommand=0)  then
	 wscript.echo "Missing arguments,usages  <hostname>  <warningnumber> <criticalnumber>"
	 wscript.echo "Atuhor Felipe Ferreira  Date:  21/11/2007 updated 02/11/08, for Nagios - Version 9.0"
	 wscript.quit
elseif(3 < argcountcommand < 4) then	
	'Verbose = CInt(GetOneArg("-v"))
	serverOUT(0) = CStr(wscript.arguments(0))
	intWarning = CInt(wscript.arguments(1))
	intCritical = CInt(wscript.arguments(2))
end if

DisplayMsg "(-v)Verbose = " & Verbose & " (-h)Hostname = " & Serverout(0) & " (-t) TopSpam = " & intTopSpam & " (-w)Warn = " & intWarning & " (-c)Critical = " & intCritical & "."

'______________LOGPARSER
call GetLDAP()
call CheckFiles(spath & "logparser.dll")    'Verify if logparser.dll(and is registred) 
call CheckFiles(spath & "SpamDB.mdb")    'and SpamDB.mdb are present!
'call CheckFiles(spath & "whitelist.txt")    'OPTIONAL, whitelist.txt so it will not (COUNT)consider these emails.

wscript.sleep 100
Dim objLogParser : Set objLogParser = CreateObject("MSUtil.LogQuery")
Dim objInputFormat : Set objInputFormat = CreateObject("MSUtil.LogQuery.W3CInputFormat")	
Dim objOutputFormat : Set objOutputFormat = CreateObject("MSUtil.LogQuery.CSVOutputFormat")

'________________________MAIN CALLS___________
call main()
call TotalSpams(outputfile)
if SpammersCnt <> 0 then
 call uDB(strFileTop)
 call queryDB(date - intDaySpam ,intTopSpam)
 call DisplayMSG(DisabledUPNS)   'Print on Screen
end if

'_________________________ OUTPUT RESULT ___________
if intSpamTot >= intCritical then
	wscript.echo "CRITICAL - " & intSpamTot & body
	wscript.quit(intICritical)
end if
if intSpamTot >= intWarning then
	wscript.echo "WARNING - " & intSpamTot & body
	wscript.quit(intIWarning)
end if
if intSpamTot < intWarning then
	wscript.echo "OK - " & intSpamTot & body
	wscript.quit(intOK)
end if


'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FUNCTIONS AND SUBS@@@@@@@@@@@@@@@@@@@@@
Sub Main
'Does the Querying In Remote Servers, or local, mutiple or single
	nomelog = GetFormatedDate(date)
	'Export UPN already in BlackList  to blacklist.txt	
	i= 0
	For i = 0 To UBound(serverOUT)
	if serverOUT(i) <> "" then
		sFile = sPath & "logs\log_" & serverOUT(i) & ".txt" 			
		strQuery ="SELECT sender-address as sa, Count(*) as Hits into " & sFile & "  FROM \\" & serverOUT(i) & "\" & serverOUT(i) & ".log\" & nomelog & ".log WHERE event-id = '1031' group by sender-address having count(*) > " & intSpamMin & " order by hits desc"
		call DisplayMsg( "Querying : " & serverOUT(i) & " , SMTP LogFile : " & nomelog & ".log , for over " & intSpamMin & " emails sent" )
		objLogParser.ExecuteBatch strQuery, objInputFormat, objOutputFormat	
		call ParseResult(sFile,outputfile,"clean")
	end if
	next
end sub


Function ParseResult(inFile, outFile, strType)
'Parse logparser output and put into a txt, Case to define what to parse 
on error resume next
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Dim obj2FSO : Set obj2FSO = CreateObject("Scripting.FileSystemObject")
  Dim oFileOut, oFileIn 
  dim blnanswer
 'Open Out File For Creating/Appending
    If objFSO.FileExists(outFile) = false Then
         Set oFileOut= objFSO.CreateTextFile(outFile, True)        
   Elseif objFSO.FileExists(outFile) = true Then
        Set oFileOut= objFSO.OpenTextFile(outFile, ForAppending, True)        
   End If
 'Open In File For Reading
  If objFSO.FileExists(inFile) = true Then  
        set	oFileIn = objFso.OpenTextFile(inFile, ForReading)       
    select case LCase(strType)
        case "clean"    
            Do While Not oFileIn.AtEndOfStream	
			strLine = oFileIn.ReadLine		
			if instr(strLine, "@") Then	
					strline = Replace(strLine, "-,",",")
					strline = Trim(strLine)					
'Call RegEx To get CLEAN EMAIL ADDRES
					strUPN = GetEmail(strLine)	
					arrLine = Split(strLine,",")				
					if strUPN="" then 										
						strUPN = arrLine(0)
					end if
					strUPN = Trim(strUPN)	
'CHECK IF NOT IN WHITE LIST				
					blnAnswer = CheckIfWhiteCheckIfWhite(strUPN)					
					if blnAnswer=false then
						oFileOut.WriteLine strUPN &	";" & trim(arrLine(1))
						Call DisplayMsg("|"& strUPN &"|"& trim(arrLine(1))&"|")
						SpammersCnt	= SpammersCnt + 1
					elseif blnAnswer=true then
						DisabledUPNS = DisabledUPNS & vbCrlf & "|"& strUPN &"|"& trim(arrLine(1))&"|WHITELISTED|"						
						Call DisplayMsg("|"& strUPN &"|"& trim(arrLine(1))&"|WHITELISTED|")
					end if
			 end if		
		Loop				
		'Loop to read thru inFIle		
		'NEVER USED YET,maybe not needed
		Case "normal"	
		Do While Not oFileIn.AtEndOfStream	
			strLine = oFileIn.ReadLine		
			if instr(strLine, "@") Then	
					strline = Replace(strLine, "-,",",")
					strline = Trim(strLine)					
'Call RegEx To get CLEAN EMAIL ADDRES
					strUPN = GetEmail(strLine)	
					arrLine = Split(strLine,",")				
					if strUPN="" then 											
						strUPN = arrLine(0)
					end if
					strUPN = Trim(strUPN)	
					DisplayMsg strUpn
			end if
		Loop
	    End select  	    
	End If 'inFile Check 
	oFileIn.Close 'close scan txt
	oFileOut.Close 'close scan txt  
    Set objFSO = Nothing
end Function

Function GetFormatedDate(inputDate)
 Dim intMonth : intMonth = Right("00" & Month(inputDate), 2)
 Dim intDay : intDay = Right("00" & Day(inputDate), 2) 
 intDay = intDay - intDaySpam 
 if len(intDay) = 1 then
 intDay = 0 & intDay  
 end if
 
 Dim intYear : intYear = Year(inputDate)
 GetFormatedDate = intYear & intMonth & intDay
End Function


'___________PART 2 ->  Function Regarding OUTPUT, DB, FORMATING, Etc...
function TotalSpams(CountFile)
'Goes thru Text File and Counts total of Emails sent from each email and Puts INTO A single line in a new Text File
	Dim oFS       : Set oFS     = CreateObject( "Scripting.FileSystemObject" )	
	Dim dicSpam   : Set dicSpam = CreateObject( "Scripting.Dictionary" )
	Dim oTS, aParts, sKey
	 IF OFS.FileExists(CountFile)= false then
	  Call DisplayMsg("File " & outputfile & " not Found")
	  exit function
	 end if
	Set oTS = oFS.OpenTextFile(CountFile)
	Do Until oTS.AtEndOfStream
		aParts = Split( oTS.ReadLine(), ";" )		
		aParts(0) = RTrim(aParts(0))				
		if UBound(aParts)=1 and isNumeric(aParts(1))=true then
			dicSpam(aParts(0)) = CStr(CLng(aParts(1)) + dicSpam(aParts(0)))
		end if
	Loop
	oTS.Close
	Set oTS = oFS.CreateTextFile(strFileTop)
	For Each sKey In dicSpam.Keys			   
		oTS.WriteLine date - intDaySpam  & ";" & trim(sKey) & ";"& dicSpam(sKey)		
	Next
	oTS.Close
	set oFS = Nothing
	set dicSpam = nothing
end function

Sub uDB(txtfile)
'Updated DB from a TXT file (uses updateDB function)	
	Dim linein, ifile
	Dim iFSO : Set iFSO = CreateObject("Scripting.FilesyStemObject")
	   Call DisplayMsg( "Processing file : " & txtfile)
	   Set ifile = iFSO.OpenTextFile(txtfile)  				
	   Do until ifile.AtEndOfLine 
	        linein = ifile.ReadLine			
			ReDim arrValues(2)
	        arrValues = Split(linein, ";", 3 )			
			arrValues(1) = trim(arrValues(1))			    
			if arrValues(0) <> "" then
			call updateDB(arrFields,arrValues)
			end if
			wscript.sleep 500
		 loop
end Sub

sub updateDB(arr1,arr2)	
'Updated DB, using array
    err.clear
	on error resume next
	Dim objConn : Set objConn = CreateObject("ADODB.Connection")
	objConn.Provider="Microsoft.Jet.OLEDB.4.0"	
	objConn.Open strDB
	Dim objRS : Set objRS = CreateObject("ADODB.Recordset")
	strSQL = "SELECT * FROM " & strDBTable 
	objRS.Open strSQL, objConn, 3, 3
	objRS.AddNew arr1, arr2
	objRS.Update
	objRS.Close	
	If err.number <> 0 Then 
	 Call DisplayMsg( "Error occurred connecting to the database " & strDB & " , ERROR: " & err.number)
	 exit sub
	end if
	objConn.Close
	set objRS = Nothing
	set objConn = Nothing
End sub

Function GetEmail(strString)
    Dim RegEx,arrMatches
    Set RegEx = New RegExp
    RegEx.IgnoreCase = True
    RegEx.Global=True                   
    RegEx.Pattern="\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}\b"
    Set arrMatches=RegEx.Execute(strString)
    For Each item In arrMatches
        strResults=strResults & " "& item.value
    Next
    GetEmail=strResults
End Function

Sub QueryDB(day,top)
'Queries DB based on Day and TOP Spammers (how many to output)
'should Also form email body and call disable for all top 5 upn
	Dim objConn : Set objConn = CreateObject("ADODB.Connection")
	Dim objRS : Set objRS = CreateObject("ADODB.Recordset")
	objRS.CursorLocation = adUseClient	
	Call DisplayMsg( "Querying day " & day & " top " & top)
	Dim strSQL : strSQL = "SELECT DISTINCT TOP "& top &" UPN, COUNT FROM " & strDBTable & " WHERE DATE = '"& day &"' ORDER BY COUNT DESC"		
	If QueryTable(objConn, objRS, strSQL) Then        
     Call Displaymsg( "Record count:  " & objRS.RecordCount)
     ' loop through all records returned
	Call DisplayMsg( String( 70, "-" ))
	Call DisplayMsg("Data        ;  Emails Sent  ;  Email Address")
     Do Until objRS.EOF
         Call DisplayMsg(     date - intDaySpam  & "  ;  " & FormatNumber(objRS.Fields.Item("COUNT"),0) & "  ;  " &  objRS.Fields.Item("UPN"))
		 body = body & " - " &  objRS.Fields.Item("UPN") & "(" & FormatNumber(objRS.Fields.Item("COUNT"),0) & ") " 
		 intSpamTot = intSpamTot + objRS.Fields.Item("COUNT")	
		 objRS.MoveNext
     Loop
	 Else
     Call DisplayMsg( "No record found matching you query!")
     End If
	 Call DisplayMsg( String( 70, "-" ))
	 'body = body & vbCrlf & String( 70, "-" )
 ' close connections
 objRS.Close
 objConn.Close
End Sub

Function QueryTable(objConn, objRS, strSQL)
'Queries the Table verifies query result is <> NULL 'Use with QueryDB
 objConn.Open "Provider = Microsoft.Jet.OLEDB.4.0; Data Source=" & strDB
 objRS.Open strSQL, objConn, adOpenStatic, adLockOptimistic
 ' if the query returns a value then move to the first record & return true
 If Not objRS.EOF Then 
     objRS.MoveFirst
     QueryTable = True
 Else
     ' return false if query do not return anything
     QueryTable = False
 End If
End Function

'_____________________________FUNCTIONS REGARDING DISABLE ACT/ADD EX BL ___________

Sub CheckFiles(sFile)
'Check if the required files(logparser.dll & SpamDB.mdb are present
    dim oFolder
    dim oFileCOllection
    dim intFileSize : intFileSize = 0
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set oFSO = CreateObject("Scripting.FileSystemObject")  
    Set objShell = WScript.CreateObject( "WScript.Shell" ) 

 Select Case sFile
 Case spath & "logparser.dll"
	If (objFSO.FileExists(sFile)) Then 
	 call DisplayMsg ("File logparser.dll OK...")
'Check if registred
'seach in \logs\ if size more then 4kb then dont search in registry
		If oFSO.FolderExists(spath & "\logs") = False Then	     	
			Wscript.echo "Folder " & spath & "\logs not found!"
			wscript.quit(IntError)
		else		
			Set oFolder = oFSO.GetFolder(spath & "\logs")
	  		Set oFileCollection = oFolder.Files        'gets all files of current folder
'Walk through each file in this folder collection.
			For each oFile in oFileCollection 'Gets its size based on the name.
			    intFileSize = intFileSize + oFile.size		
			next

			if intFileSize > 50 then	
'This scripts worked fine before, there will be some logs indicating it ran fine.
  			 displaymsg "no need to registry logparser.dll"
	 		 exit sub	
			else 
'Resitry the .dll and exit sub
			  objShell.Run "regsvr32 /s " & spath & "logparser.dll", , True 	
			  displaymsg "logparser.dll was registred"
	 		 exit sub
			end if
		end if 
	else
	 DisplayMsg "Downloading LogParser for you..."
	 call GetFile("logparser.dll")	 
	 wscript.sleep 2200   'wait for file to arraive

	 objShell.Run "regsvr32 /s " & spath & "logparser.dll", , True 	 	 
	 call DisplayMsg ("File logparser.dll Downloaded OK")
	End If 

 case spath & "SpamDB.mdb"
	Set objFSO = CreateObject("Scripting.FileSystemObject") 
	If (objFSO.FileExists(spath & "SpamDB.mdb")) Then 
	call DisplayMsg ("File SpamDB.mdb OK...")
	else
	DisplayMsg "Downloading SpamDB.mdb for you..."
	 call GetFile("SpamDB.mdb")
	 wscript.sleep 1200   'wait for file to arraive
	 call DisplayMsg ("File SpamDB.mdb Downloaded OK")
	end if
 case spath & "whitelist.txt"
 	Set objFSO = CreateObject("Scripting.FileSystemObject") 
	If (objFSO.FileExists(spath & "whitelist.txt")) Then 
	 call DisplayMsg ("File whitelist OK...")
	else
	 objFSO.CreateTextFile("whitelist.txt") 
	  call DisplayMsg ("File whitelist Created OK")	  
	end if
 End Select 
	set objFso = nothing
end sub

sub getLDAP()
	'Auto created the LDAP String for querying AD
	'// Create an instance of the wshShell object
	set WshShell = CreateObject("WScript.Shell")
	strDomain = WshShell.ExpandEnvironmentStrings("%USERDNSDOMAIN%")
	if strDomain = "" then 
		DisplayMsg "You are not in a Domain, this script will not work!"
		wscript.quit
	end if
	strLogonServ = WshShell.ExpandEnvironmentStrings("%LOGONSERVER%")
	arrDC = split(strDomain,".")
	strLogonServ = Right(strLogonServ,len(strLogonServ) - 2 )
	trim(strLogonServ)
	'This Auto Generate the LDAP String to connect to GC and Make a Query  WARNING: Might not work with long domain names like coco.ex.com.local 
	'FORMAT 'strLDAP = "'" & "LDAP://<GC>.<DOMAIN>.local/DC=local" & "'"
	strLDAP = "'" & "LDAP://" & strLogonServ & "." & strDomain & "/DC=" & arrDC(Ubound(arrDC)) &"'"
	'DisplayMsg StrLDAP
	set WshShell = nothing
end sub

sub GetFile(filename)
'Download needed files from FTP
	Dim objMyFile, objShell, strFTPScriptFileName
	Dim strFileGet1, strFileGet2 
	Dim strFTPServerName, strLoginID 
	Dim strPassword, strFTPServerFolder,spathT
	
	strFTPServerName = "xoroz.com" 
	strLoginID = "files@xoroz.com" 
	strPassword = "files" 
	strFTPServerFolder = "/" 

	'Generate FTP command 
	strFTPScriptFileName = spath & "FTP.txt" 
	Set objFSO = CreateObject("Scripting.FileSystemObject") 
	If (objFSO.FileExists(strFTPScriptFileName)) Then 
	 objFSO.DeleteFile (strFTPScriptFileName) 
	End If 
	
	If (objFSO.FileExists(spath & "\" & filename)) Then 
	  DisplayMsg "File " & filename & " already exists, will not replace, quiting..."
	  wscript.quit
	End If 
	'Remove last slash from spath name
	spathT = left(spath,len(spath) - 1) 
	Set objMyFile = objFSO.CreateTextFile(strFTPScriptFileName, True) 
	objMyFile.WriteLine ("open " & strFTPServerName) 
	objMyFile.WriteLine (strLoginID) 
	objMyFile.WriteLine (strPassword) 
	objMyFile.WriteLine ("cd " & strFTPServerFolder) 
	objMyFile.WriteLine ("bin") 
	objMyFile.WriteLine ("lcd " & spathT) 
	objMyFile.WriteLine ("prompt off") 
	objMyFile.WriteLine ("mget " & filename) 
	objMyFile.WriteLine ("disconnect") 
	objMyFile.WriteLine ("bye") 
	objMyFile.Close 
	
	'Execute the FTP script. 
	Set objShell = WScript.CreateObject( "WScript.Shell" ) 
	'call DisplayMsg( "ftp -s:" & Chr(34) & strFTPScriptFileName & Chr(34))
	'exec "cmd /c ftp -s:" & Chr(34) & strFTPScriptFileName & Chr(34)
	objShell.Run "ftp -s:" & Chr(34) & strFTPScriptFileName & Chr(34), , True 	 
	If (objFSO.FileExists(strFTPScriptFileName)) Then 	
	 objFSO.DeleteFile (strFTPScriptFileName) 
	End If  
	Set objFSO = Nothing 
	Set objMyFile = Nothing 
	Set objShell = Nothing 
end sub


Function CheckIfWhite(strEMAIL)
'Check if in WhiteList, shuold parse dirty emails, with -
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Dim wLine
 if objFSO.FileExists(whitelist) = false Then
	call displayMsg("WhiteList file NOT FOUND, just created one for you.")
    Set oWhite= objFSO.CreateTextFile(whitelist, True) 
	exit function
 end if
 Dim oWhite : Set oWhite = objFSO.OpenTextFile(whitelist, ForReading)      
 Do While Not oWhite.AtEndOfStream	
	wLine = oWhite.ReadLine
	if instr(wLine, strEMAIL) Then
		call DisplayMsg(strEMAIL & " is in whitelist")			
		'DisabledUPNS = DisabledUPNS & strEMAIL & " is in whitelist"
		CheckIfWhite = true
		exit function		
	end if	
 loop 
 CheckIfWhite = false
 'call displaymsg("WhitelistCheck: " & strEMAIL & " = " & CheckIfWhite)
 oWhite.close
 set objFSO = nothing
end Function

function exec(execCmd)
	'on error resume next
	dim strCmd
	dim objShell : Set objShell = WScript.CreateObject("WScript.Shell")		
	strCmd = sPath & execCmd
	call DisplayMsg( strCmd	)
	Dim objExecObject : Set objExecObject = objShell.Exec(strCmd)	
	Do While objExecObject.Status <> 1		
		wscript.sleep 500			
	Loop	
	if err.number = 0 and objExecObject.Status = 1 then 				
		'call DisplayMsg("done")
	else
		call DisplayMsg("error")
	end if
end function

Function GetArgs()
'Get ALL arguments passed to the script
	On Error Resume Next		
	Dim i		
	argcountcommand=WScript.Arguments.Count		
	for i=0 to argcountcommand-1
		arg(i)=WScript.Arguments(i)
	DisplayMsg i & " - " & arg(i)
	next		
End Function
Function GetOneArg(strName)
	On Error Resume Next
	Dim i
	for i=0 to argcountcommand-1
		if (Ucase(arg(i))=Ucase(strName)) then
			GetOneArg=arg(i+1)
			Exit Function
		end if
	next		
End Function


Function DisplayMsg(msgTxt)
'Prints msg on screen only if Verbose is set	
	if Verbose = 1 then		
		wscript.echo msgTXT
	end if
end Function