Nightly IMF Spam Report Email            Download Files

This is a script that you can schedule to run once a day (or more) that returns a HTML email with a table that lists all the email that has been achieved by the IMF over the past day. It does a query of the Message Tracking logs via WMI for all messages over the past day that are of entry type 1039.

How it Works

The first section of code starts to setup a string for the Body of the email by building a string that will become the Htmlbody of the report email

SpamReport = "<table border=""1"" cellpadding=""0"" cellspacing=""0"" width=""100%"">" & vbcrlf
SpamReport = SpamReport & "<table border=""1"" cellpadding=""0"" cellspacing=""0"" width=""100%"">" & vbcrlf
SpamReport = SpamReport & " <tr>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">Time</td>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">Ip</td>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">From</td>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">Sent-TO</td>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">Subject</td>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">Size</td>" & vbcrlf
SpamReport = SpamReport & "</tr>" & vbcrlf

The next part of the code does a WMI WQL query of the message tracking logs with a parameter to limit the query to only 1039 events and only those events that have a date greater then 24 hours ago.

strComputer = "."
set shell = createobject("wscript.shell")
strValueName = "HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias"
minTimeOffset = shell.regread(strValueName)
toffset = datediff("h",DateAdd("n", minTimeOffset, now()),now())
dtListFrom = DateAdd("n", minTimeOffset, now())
dtListFrom = DateAdd("d",-1,dtListFrom)
strStartDateTime = year(dtListFrom)
if (Month(dtListFrom) < 10) then strStartDateTime = strStartDateTime & "0"
strStartDateTime = strStartDateTime & Month(dtListFrom)
if (Day(dtListFrom) < 10) then strStartDateTime = strStartDateTime & "0"
strStartDateTime = strStartDateTime & Day(dtListFrom)
if (Hour(dtListFrom) < 10) then strStartDateTime = strStartDateTime & "0"
strStartDateTime = strStartDateTime & Hour(dtListFrom)
if (Minute(dtListFrom) < 10) then strStartDateTime = strStartDateTime & "0"
strStartDateTime = strStartDateTime & Minute(dtListFrom)
if (Second(dtListFrom) < 10) then strStartDateTime = strStartDateTime & "0"
strStartDateTime = strStartDateTime & Second(dtListFrom) & ".000000+000"
Set objWMIService =  Getobject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\MicrosoftExchangeV2")
Set colLoggedEvents = objWMIService.ExecQuery("Select * FROM Exchange_MessageTrackingEntry where entrytype = '1039' and OriginationTime > '" & strStartDateTime & "'",,48)

The next part setups up some parameters and creates a loop to go though all the entries in the tracking log that matched the WQL query scope and then write these fields into the htmlbody string in a html table format.

spamcount = 0
spambytes = 0
For Each objEvent in colLoggedEvents
  for i = 1 to objEvent.RecipientCount
	OriginationTime = objEvent.OriginationTime
	odate = dateadd("h",toffset,cdate(DateSerial(Left(OriginationTime, 4), Mid(OriginationTime, 5, 2), Mid(OriginationTime, 7, 2)) & " " & timeserial(Mid(OriginationTime, 9, 2),Mid(OriginationTime, 11, 2),Mid(OriginationTime,13, 2))))
	SpamReport = SpamReport & "  <tr>" & vbcrlf
  	SpamReport = SpamReport & "<td align=""center"">" & formatdatetime(odate,4) & "</td>" & vbcrlf
	SpamReport = SpamReport & "<td align=""center"">" & objEvent.clientip & "</td>" & vbcrlf
	SpamReport = SpamReport & "<td align=""center"">" & objEvent.SenderAddress & "</td>" & vbcrlf
	SpamReport = SpamReport & "<td align=""center"">" & objEvent.RecipientAddress((i-1)) & "</td>" & vbcrlf
	SpamReport = SpamReport & "<td align=""center"">" & objEvent.Subject & "</td>" & vbcrlf
	SpamReport = SpamReport & "<td align=""center"">" & objEvent.size & "</td>" & vbcrlf
  	SpamReport = SpamReport & "</tr>" & vbcrlf
	spamcount = spamcount + 1
	spambytes = spambytes + objEvent.size
  next
next
SpamReport = SpamReport & "</table>" & vbcrlf

The last part of the email uses CDO to send an the email as a report to the nominated user

REm Email Bit
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "spamreport@yourdomain.com.au"
objEmail.To = "youremail@yourdomain.com.au"
objEmail.Subject = "Spam Report for " & formatdatetime(now(),2) & " " & spamcount & " Mails Blocked " & (spambytes\1024) & " KB"
objEmail.htmlbody = SpamReport
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "yourserver"
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
 

Installing and Running the Script

Before running the script you need to change the following 3 hard-coded references, the first two references refer to the email address that the report will be sent from and the email address the report will be sent to.

objEmail.From = "spamreport@yourdomain.com.au"
objEmail.To = "youremail@yourdomain.com.au"

The other hard-coded reference refers to the name of the mail server the email will be sent through

objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "yourserver"

To run the script you can run it from the command line eg cscript imfspamem.vbs or create a schedule task that runs this script once per day or whatever period you would like to get reports if you want to change the time scope the report focus's on all you need to do is change the following line

dtListFrom = DateAdd("d",-1,dtListFrom)

For instance to change the scope to only the last 12 hours see the vbscript doco for more information on using Dateadd

dtListFrom = DateAdd("h",-12,dtListFrom)
 

Download Files