'Atuhor Felipe Ferreira
'Date:  21/11/2007 updated 27/05/08
'Version 8.0
'based on: Lorenzo Stefani autodisable.vbs

'This script will generate a List of all Top Email Senders by default of yestaday, it can then perfom some actions using DisableAct.
'Set 3 levels of DisableAct:  level 0 do nothing, 1 REDUCE MAX RECIPIENT, 2 Disable /add to BL (There is also a WHITELIST!)
'Get Top SPammers/Emails Sent Out and Send Output Via Email (maybe task schedulle daily?)

'Improvements Version 8.0:
'Auto download logparser.dll, spamDB.mdb  and register logparser.dll   - OK
'Auto  CREATE c:\script and c:\script\log (copy .vbs and .mdb files to c:\script) OK
'Auto- Find current Domain and autoget strLDAP - OK
'autocreate whielist.txt  -	  OK

'TO DO:
'1.  Dynamic Configure Script (right now its to hard to set parameters by hand)
'2.  Auto Discover exchange log files 
'3.  Verify exchange log files are found or pormpt for location
'4 . Allow auto filling entire DB for this month (loop thru each file)
'5.  Another Script to Generate Reports(weekly,monthly) TOP SENDERS
'6. Do not allow doubles into the DB (if script is ran for same day twice)
'7.  Make into an HTA, GUI and allow auto schedulle

Const ForReading=1,ForWriting=2,ForAppending=8,adLockOptimistic = 3,adOpenDynamic = 1
Const adOpenStatic = 3
Const adUseClient = 3
Dim DisabledUPNS,sFile 
Dim t1, runtime
t1 = Timer  'time the script
dim strScriptFile : strScriptFile = WScript.ScriptFullname
dim sPath : sPath = Left(strScriptFile, Len(strScriptFile) - Len(WScript.Scriptname)) 
dim giorno, anno, mese, nomelog, i,strQuery, timer, trovato, Body
Dim SpammersCnt : SpammersCnt = 0
Dim cntAddBl : cntAddBl = 0
Dim objFSO 


'@@@@@@@@@@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 blacklist : blacklist =  "senderfilter.ldf"	  'UPNs that will go to Ex BL
Dim strFileTop : strFileTop = "TopSpammers.txt"
Dim outputfile : outputfile = spath & "Spammers_"& cstr(day(now())-intDaySpam) &"_" & cstr(Month(now()))&".txt"


'@@@@@@@@@@----------EDIT-------------@@@@@@@@@@@@@
Dim Verbose : Verbose = 1			'=1 Display Msgs, =0 QUIET MODE
Dim DisableAct : DisableAct = 0     'Disable Accounts = 2, Will first try to Disable OR add to Excahnge BL, =1 Will Set MaxRecipient to intRlimit, 0 DO NOTHING
Dim intRLimit : intRLimit = 10      'Max Recipient Limit To be set
Dim intSpamMin : intSpamMin = 100   'More then 500 a day(24hr) is considered SPAMMER
Dim intTopSpam : intTopSpam = 5     'How many of Top Spammers to report
Dim intDaySpam : intDaySpam = 1     'How many days ago to check (ONLY SAME MONTH)
Dim strMailServer : strMailServer = "EXCHANGE"
Dim strEmailFrom : strEmailFrom = "administrator@test.com" 
Dim strEmailTo : strEmailTo = "administrator@test.com"
Dim strLDAP ' NOW AUTOMATIC: strLDAP = "'" & "LDAP://GC.DOMAIN.local/DC=local" & "'"
'@@@@@@@@@@----------EDIT-------------@@@@@@@@@@@@@

'_____________SMTP OUT
	Dim serverOUT(0)
	serverOUT(0) = "SRVVLEXCHANGE"
	
'______________LOGPARSER

call GetLDAP()
call CheckDir()      'Verifit if running in C:\SCRIPTS if not Create and copy itself there
call CheckFiles()    'Verify if logparser.dll and SpamDB.mdb are present!


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()
body = body & vbcrlf & vbcrlf &" Top " & intTopSpam & " Spammers of " & date - intDaySpam & vbcrlf
call TotalSpams(outputfile)
if SpammersCnt <> 0 then
 call uDB(strFileTop)
 call queryDB(date - intDaySpam ,intTopSpam)
 call DisplayMSG(DisabledUPNS)   'Print on Screen
end if

if cntAddBl <> 0 then 'To add into Exchange BL
	Call CloseBlackList()	
end if

'_________________________MAIN CALLS___________
RunTime = Timer  - t1
RunTime = Left(RunTime, 4)
body = body & vbCrlf & DisabledUPNS
body = body & vbCrlf & "Found " & SpammersCnt & " spammers"
'body = body & vbCrlf & "Done in : " & Runtime & " seconds."
if SpammersCnt <> 0 then
	call SendMail(strEmailFrom,strEmailTo,"","Top Spammers",Body,outputfile)	
	
End if
wscript.quit



'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FUNCTIONS AND SUBS@@@@@@@@@@@@@@@@@@@@@
Sub Main
'Does the Querying In Remote Servers
	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" )
		'Call DisplayMsg(strQuery)
		body = body & vbCrlf & "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)	
					if instr(strUPN, ".nll") then
						strUPN = replace(strUPN, ".nll",".nl")
					elseif instr(strUPN, ".de") then
						strUPN = replace(strUPN, ".de",".net")
					end if
					'DisplayMsg strUpn
'CHECK IF NOT IN WHITE LIST				
					blnAnswer = CheckIfWhite(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 Sendmail
'------------------------------------------------------------------------
Sub SendMail(sFrom,sTo,sCC,sSub,sBody,sAttch)
	on error resume next
	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.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
			Call DisplayMsg( "Error sending email : " & err.descprition)
			wscript.quit
		end if
end sub



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        
     ' display the record count
     Call Displaymsg( "Record count:  " & objRS.RecordCount)
     ' loop through all records returned
    body = body & vbCrlf & String( 70, "-" )
	body = body & vbCrlf & "Data        ; Emails Sent ; Email Address"
	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 & vbCrlf  & date - intDaySpam  & "  ;  " & FormatNumber(objRS.Fields.Item("COUNT"),0) & "  ;  " &  objRS.Fields.Item("UPN")
		if DisableAct = 2 then        
			call Disable(objRS.Fields.Item("UPN"))		 
		elseif DisableAct = 1 then        
		     call SetMaxRecipient(objRS.Fields.Item("UPN"))
		end if
		 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 Disable(strUPND)
'Check in AD if UPN is already Disabled
'Otherwise go ahead and disable it
	err.clear
	'on error resume next
	'Check if UPN is empty or If it is in WHITELIST
	if strUPND = "" or CheckIfWhite(strUPND)=true then		
		call DisplayMsg("IN WHITELIST")
		exit sub
	end if    		
	call displaymsg("Checking: " & strUPND )
	Const ADS_UF_ACCOUNTDISABLE = 2	
	Dim WshNetwork : Set WshNetwork = WScript.CreateObject("WScript.Network")
	Dim con : Set con = CreateObject("ADODB.Connection")
	con.Provider = "ADsDSOObject"
	con.open
	Dim command : Set command = CreateObject("ADODB.Command")
	Set command.ActiveConnection = con
	command.CommandText = "SELECT * FROM " & strLDAP & " WHERE mail = '" & strUPND & "'"
	command.Properties("searchscope") = 2
	Dim rs : Set rs = command.Execute
	'check for errors
	if err <> 0 then
		Call DisplayMSG( "ERROR : " & err.description)
	end if
	If rs.EOF then 
		DisabledUPNS = DisabledUPNS & " Account: '" & strUPND & "' Not found in AD." & vbCrLf	    
		'ADD TO EXCHANGE BLACK LIST EXPORT .LDF
		call FBlackList(strUPND)
	Else
	Set UserObject = GetObject((rs("ADsPath")))
	If UserObject.AccountDisabled=True Then
		DisabledUPNS = DisabledUPNS & strUPND & " account is already DISABLED." & vbCrLf		
	Else
'DISABLE ACCOUNT
		userobject.userAccountControl = 66050
		userobject.SetInfo
		DisabledUPNS = DisabledUPNS & strUPND & " DISABLED" & vbCrLf		
	end If
	end If
	set con = nothing
	Set WshNetwork = nothing
end sub

Sub CheckFiles()
    Set objFSO = CreateObject("Scripting.FileSystemObject") 
	if instr(strScriptFile,"c:\scripts\") <> 0 then 
		DisplayMsg "Script must Run from c:\scripts\"
		wscript.quit
	end if
	If (objFSO.FileExists(spath & "logparser.dll")) Then 
	 call DisplayMsg ("File logparser.dll OK...")
	else
	 DisplayMsg "Downloading LogParser for you..."
	 call GetFile("logparser.dll")	 
	 wscript.sleep 2200   'wait for file to arraive
	 Set objShell = WScript.CreateObject( "WScript.Shell" ) 
	 objShell.Run "regsvr32 /s " & spath & "logparser.dll", , True 	 	 
	 call DisplayMsg ("File logparser.dll Downloaded OK")
	End If 
	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
	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
	
	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)
	Dim objMyFile, objShell, strFTPScriptFileName
	Dim strFileGet1, strFileGet2 
	Dim strFTPServerName, strLoginID 
	Dim strPassword, strFTPServerFolder 
	
	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 
	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 " & spath) 
	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


sub CheckDir()
	'Copy itself to C:\scripts\   ( for many reasons the script dont run well on large paths so this should fix it)
	Set fso = CreateObject("Scripting.FileSystemObject")	
	
	if spath <> "c:\scripts\" and instr(strScriptFile,"c:\scripts\") = 0 and fso.FolderExists("c:\Scripts") = False then
		DisplayMsg strScriptFile 
		fso.CreateFolder "c:\scripts"
		fso.CreateFolder "c:\scripts\logs"
		Set fso = CreateObject("Scripting.FileSystemObject")
		Set c = fso.GetFile(strScriptFile)
		c.Copy("c:\scripts\ExGetTop5.vbs")
		DisplayMsg "Run Script from C:\scripts\ExGetTop5.vbs"		
		wscript.quit
		
	end if
	set c = nothing
	Set fso = 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

Sub FBlackList(Stringa)
On Error Resume Next    
	dim filesys, filetxt
	Set filesys = CreateObject("Scripting.FileSystemObject")	
	call displaymsg("Checking if in Whitelist " & Stringa )
	if filesys.FileExists(blacklist)= False then
	'If senderfilter.ldf  dont exists then Create one!
		call displaymsg("Creating Blacklist and adding " & Stringa & " to Exchange B.L.")
		Set filetxt = filesys.CreateTextFile(blacklist, True) 
		filetxt.writeline ("dn: CN=Default Message Filter,CN=Message Delivery,CN=Global Settings,CN=DC,CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=DC,DC=local")
		filetxt.writeline ("changetype: modify")
		filetxt.writeline ("add: msExchTurfListNames")
		filetxt.writeline ("msExchTurfListNames: " & Stringa)
		cntAddBl = cntAddBl + 1
	elseif filesys.FileExists(blacklist)= True then
	'If senderfilter.ldf  exists just append
		Set filetxt = filesys.OpenTextFile(blacklist, ForAppending, True)
		filetxt.writeline ("msExchTurfListNames: " & Stringa)
		call displaymsg("Adding " & Stringa & " to Exchange B.L.")
		cntAddBl = cntAddBl + 1
		filetxt.Close 
	end if
    Set filesys = Nothing
    Set filetxt = Nothing	
End Sub

Sub CloseBlackList()
'On Error Resume Next
    Dim FSO,FSO2, fs ,ds, s
	dim filesys, filetxt	
	Set filesys = CreateObject("Scripting.FileSystemObject")
		Set filetxt = filesys.OpenTextFile(blacklist, ForAppending, True)
		filetxt.writeline ("-")
		filetxt.Close 	
    Set filesys = Nothing
    Set filetxt = Nothing
'execute import.bat		
	call exec("import.bat")
	wscript.sleep 300
	call exec("cmd /c del /q senderfilter.ldf")
end sub

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 SetMaxRecipient(userName)
on error resume next
	Set WshNetwork = WScript.CreateObject("WScript.Network")
	UserName = ifile.ReadLine
	Set con = CreateObject("ADODB.Connection")
	con.Provider = "ADsDSOObject"
	con.open
	Set command = CreateObject("ADODB.Command")
	Set command.ActiveConnection = con
	command.CommandText = "SELECT * FROM " & strLDAP & " WHERE userPrincipalName = '" & UserName & "'"
	command.Properties("searchscope") = 2
	Set rs = command.Execute
	if rs.EOF then 	      
		  DisabledUPNS = DisabledUPNS & "Account: '" & UserName & "' Not found in OU, Max Recipient NOT SET" & vbcrlf
		  exit function
	end if
	Set UserObject = GetObject((rs("ADsPath")))	
	Call DisplayMsg( UserName & "  Max Recipiten Limit Set To: " & intRLimit )
	DisabledUPNS = DisabledUPNS &  UserName & "  Max Recipiten Limit Set To: " & intRLimit 
	'SET MAX RECIPIENT AD
	userobject.msExchRecipLimit = intRLimit
	userobject.SetInfo
	
	'CleanUP
	set con = nothing
	set command = nothing
	set WshNetwork = nothing
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