[green]'==========================================================================
'
' NAME: SMTPTarpit.vbs
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' URL: [URL unfurl="true"]http://www.thespidersparlor.com[/URL]
' 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