Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Enhancing the Intelligent Message Filter: IMF

Spam Protection

Enhancing the Intelligent Message Filter: IMF

by  markdmac  Posted    (Edited  )
markdmac's Enterprise Ready Scripts

By Mark D. MacLachlan, The Spiders Parlor
http://www.thespidersparlor.com


Combatting SPAM is a never ending ordeal. Fortunately for us there are some free resources built into or provided as add-ins for Exchange server that can greatly reduce the influx of the never ending flow of junk mail.

Several years back, Microsoft introduced IMF, the Intelligent Message Filter. IMF works well but has limited configuration options. Originally, IMF was an add in for Exchange 2003 and Exchange 2003 with SP1. IMF was found so useful, its functionality was moved into Exchange 2003 SP2. In order to install SP2, you must first uninstall IMF if it was installed as an add-in.

This FAQ is not intended to be an IMF installation or configuration information source. You can find a great tutorial on this at http://www.petri.co.il/configure_imf_in_exchange_2003_sp2.htm. Instead, the focus of this FAQ is to enhance your IMF installation by adding management tools and automation to help curb the amount of SPAM that hits your server or is stored on your server.

To begin, I recommend enhancing IMF with my free tool. http://www.thespidersparlor.com/downloads/imfspam.zip.

The tool allows you to see what was captured by IMF when in Archive mode and provides an option to redeliver the false positives. Also allows you to delete the filtered SPAM.

In addition, you will want to configure IMF to automatically get updates so it keeps up with the spammers. You can use my script for that.


Code: 
[green]
'==========================================================================
'
' NAME: IMFUpdateEnabler.vbs
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' URL: http://www.thespidersparlor.com
' (c) 2006 All Rights Reserved
' DATE  : 5/22/2006
'
' COMMENT: Configures IMF to receive updates via Windows Update
'
'    THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF
'    ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED To
'    THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
'    PARTICULAR PURPOSE.
'
'    IN NO EVENT SHALL THE SPIDER'S PARLOR AND/OR ITS RESPECTIVE SUPPLIERS 
'    BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
'    DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
'    WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
'    ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
'    OF THIS CODE OR INFORMATION.
'
'    This script and many more can be found in the Admin Script Pack
'    by The Spider's Parlor http://www.thespidersparlor.com/vbscript
'==========================================================================[/green]
keypath ="HKLM\SOFTWARE\Microsoft\Exchange\ContentFilterState"
Set WSHShell = CreateObject("Wscript.Shell")
WshShell.RegWrite keypath, 1, "REG_DWORD"
If Not Err Then
        If Msgbox("In order to complete setup, the SMTP service must be restarted.  OK to restart SMTP?", vbYesNo, "Restart SMTP?") = vbYes Then
            WSHShell.Run "CMD.EXE /C NET STOP SMTPSVC & NET START SMTPSVC"
        End if
Else
    MsgBox "Sorry A Problem Was Encountered" & vbCrLf & "Make sure you have permission to write to the registry.",,"Something went wrong"
End If    
WScript.Quit
If you have enabled recipient filtering, then you can further reduce SPAM by enabling the Exchange Tarpit feature. The following script I wrote will enable that for you.

Code: 
[green]
'==========================================================================
'
' NAME: SMTPTarpit.vbs
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' URL: http://www.thespidersparlor.com
' DATE  : 11/1/2006
'
' COMMENT: For details on the SMTP Tarpit feature refer to 
'          MSKB 842851.
'          Configures a 5 second delay in SMTP delivery.  Use this 
'          feature when recipient filtering is enabled in Exchange
'          to prevent directory harvesting.
'
'    THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF
'    ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED To
'    THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
'    PARTICULAR PURPOSE.
'
'    IN NO EVENT SHALL THE SPIDER'S PARLOR AND/OR ITS RESPECTIVE SUPPLIERS 
'    BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
'    DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
'    WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
'    ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
'    OF THIS CODE OR INFORMATION.
'==========================================================================[/green]

On Error Resume Next
Dim path
Set WSHShell = Wscript.CreateObject("WScript.Shell")
path = "HKLM\SYSTEM\CurrentControlSet\Services\SMTPSVC\Parameters\"
WSHShell.RegWrite path & "TarpitTime","5","REG_DWORD"
[green]'to undo what this script has done, comment out the above line and uncomment the following
'WSHShell.RegWrite path & "TarpitTime","0","REG_DWORD"
[/green]
If Not Err Then
        If Msgbox("In order to complete setup, the SMTP service must be restarted.  OK to restart SMTP?", vbYesNo, "Restart SMTP?") = vbYes Then
            WSHShell.Run "CMD.EXE /C NET STOP SMTPSVC & NET START SMTPSVC"
        End if
Else
    MsgBox "Sorry A Problem Was Encountered" & vbCrLf & "Make sure you have permission to write to the registry.",,"Error in SMTP Tarpit Configuration"
End If

One final suggestion is that you will want to periodically clean up the BadMail and UCEArchive folders. Anything in there that is over 30 days old will probably not be missed. The following script, when run on a schedule each day will clean up those folders by deleting anything older than 30 days.

Code: 
[green]
'==========================================================================
'
' NAME: CleanBadMail.vbs
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' URL   : http://www.thespidersparlor.com    
' COPYRIGHT (c) 2003 All rights reserved
' DATE  : 09/10/2003
'
' COMMENT: 
'
' This script will list all filtered and quarantined SPAM mail, check that 
' the files are more than 30 days old and then delete them.
' This file is to be scheduled to run each day.
'
'    THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF
'    ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED To
'    THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
'    PARTICULAR PURPOSE.
'
'    IN NO EVENT SHALL THE SPIDER'S PARLOR AND/OR ITS RESPECTIVE SUPPLIERS 
'    BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
'    DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
'    WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
'    ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
'    OF THIS CODE OR INFORMATION.
'=====================================
[/green]
[red]'Note that you must change the following paths to match your Exchange install location[/red]

Path1 = "E:\Program Files\Exchsrvr\Mailroot\vsi 1\BadMail"
Path2 = "E:\Program Files\Exchsrvr\Mailroot\vsi 1\UceArchive"[green]
'This third path is not used unless you modify the script below[/green]
Path3 = "E:\Program Files\Quarantine"

Dim fso 
Dim oFolder
Dim oFile
Dim oSubFolder

  Set fso = createobject("Scripting.FileSystemObject")
  
   Set oFolder = fso.GetFolder(Path1)
  
  For Each oFile In oFolder.files
       If DateDiff("d", oFile.DateCreated,Now) > 30 Then
        oFile.Delete True
    End If
  Next


Set oFolder = fso.GetFolder(Path2)
  For Each oFile In oFolder.files
       If DateDiff("d", oFile.DateCreated,Now) > 30 Then
        oFile.Delete True
    End If
  Next

Set oFolder = Nothing
[green]
'The script will stop running here.  
'Remove the next line if you need to delete subdirectories from a given path.[/green]
Wscript.Quit
[green]
'If you need to delete sub folders instead of files from a directory, the below code will do that for you.[/green]
Set oFolder = fso.GetFolder(Path3)
Set colSubfolders = oFolder.Subfolders

For Each oSubfolder in colSubfolders
       If DateDiff("d", oSubFolder.DateCreated,Now) > 30 Then
        fso.DeleteFolder(oSubFolder)
    End If
Next

Set oSubFolder = Nothing
Set oFolder = Nothing
Set fso = Nothing

I hope you have found this FAQ and the scripts it includes to be helpful. Please rate the FAQ. I wish to thank all who have voted on this FAQ. I strive for nothing less than 10s. Before you vote, if you don't think this FAQ rates a 10 please provide feedback to me first. Also please check out my other FAQs in this same forum. This FAQ covers a lot of ground but is not intended to be the answer to ALL SPAM fighting.

Some of my other FAQs will help to fill in specific areas that deserved more content than could be included in this FAQ. An example is Adding a Empty Junk E-Mail Button to Outlook faq955-6462.
Happy scripting.

Mark
Register to add this FAQ to your archive
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top