Spencer Ruport of netortech.com modified my FTP ban script into one that stops dictionary attacks. And he chooses not to ban via the problematic IIS way but instead creating a bad route for the offending IP address. Pretty darn ingenius.
ftpdprotection.vbs
Set objFTPSVC = GetObject("IIS://localhost/MSFTPSVC")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objLog = CreateObject("MSWC.IISLog")
Set objDictionary = CreateObject("Scripting.Dictionary")
Dim Attempts(), IP(), LastAttempt(), IPs
Dim AlreadyBanned, InProcess, Session
Dim CutOff, x, i
IPs = 0
'Iterate through each FTP site.
For Each objSITE in objFTPSVC
If lcase(objSITE.class) = "iisftpserver" Then
ftpLogFilePath = objSITE.LogFileDirectory & "\msftpsvc" & objSITE.Name
Set objFolder = objFSO.GetFolder(ftpLogFilePath)
Set objFiles = objFolder.Files
For Each fileName In objFiles
lastFile = fileName
Next
strLogFile = lastFile
Set file = Nothing
Set objFolder = Nothing
'Use the IIS log file parser provided by MSFT
objLog.OpenLogFile strLogFile, 1, "MSFTPSVC", 1, 0
'(FileName,IOMode,ServiceName,ServiceInstance,OutputLogFileFormat)
' 0 = NotApplicable, 1 = ForReading
Do While NOT objLog.AtEndOfLog
objLog.ReadLogRecord
If instr(ucase(objLog.Method), "USER") Then
'Someone is attempting to authenticate with the FTP server
InProcess = False
AlreadyBanned = False
For x = 0 to IPs - 1
'Check to see if this IP address has already attempted to log in.
If objLog.ClientIP = IP(x) Then
'To be nice this code will give the user
'another attempt every minute.
'This is to avoid banning a person who
'attempts to log in multiple times
'in a day but keeps forgetting their password.
Attempts(x) = Attempts(x) + datediff("n", objLog.DateTime, lastattempt(x))
LastAttempt(x) = objLog.DateTime
InProcess = True
End If
Next
If Not InProcess Then
'If we aren't keeping track of this IP
'it's possible the IP has already been
'added to the ban list.
AlreadyBanned = objDictionary.Exists(objLog.ClientIP)
End If
If Not InProcess And Not AlreadyBanned Then
'First authentication attempt by this IP
IPs = IPs + 1
Redim Preserve IP(IPs)
Redim Preserve Attempts(IPs)
Redim Preserve LastAttempt(IPs)
IP(IPs - 1) = objLog.ClientIP
Attempts(IPs - 1) = 1
LastAttempt(IPs - 1) = objLog.DateTime
End If
ElseIf instr(ucase(objLog.Method), "PASS") Then
'The server is responding to an authentication
'attempt.
For x = 0 to IPs - 1
'See if we're keeping track of this IP
If IP(x) = objLog.ClientIP Then
'Increment the authentication attempts
Attempts(x) = Attempts(x) + 1
If Attempts(x) = 10 Then
'Ban if necessary
WScript.Echo "Banning " & objLog.ClientIP & "..."
objDictionary.Add objLog.ClientIP, "255.255.255.255"
AddDeadRoute objLog.ClientIP
For i = x to (IPs - 2)
IP(i) = IP(i + 1)
Attempts(i) = Attempts(i + 1)
Next
IPs = IPs - 1
Redim Preserve IP(IPs)
Redim Preserve Attempts(IPs)
End If
End If
Next
End If
Loop
objLog.CloseLogFiles 1
End If
Next
Set objDictionary = Nothing
Set objLog = Nothing
Set objFSO = Nothing
Set objFTPSVC = Nothing
Function addDeadRoute(IP)
dim adoDBConn, sConnStr, objFSO, objBanBatch, cmdShell, WshShell
Dim fakeGateway
'I've been told that IPSec could be used to block certain IPs
'but 1) I'm not sure WMI can interface with it and 2) I don't
'know how to begin with. Someone gave me a much easier solution
'Simply add a route to the routing table pointing to a gateway
'that doesn't exist.
'Ensure that this IP is on the same subnet as the server
fakeGateway = "192.168.1.101"
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objBanBatch = objFSO.CreateTextFile("W:\config files\blocks\addRoute.bat", True)
objBanBatch.WriteLine "ROUTE ADD " & IP & " MASK 255.255.255.255 " & fakeGateWay
objBanBatch.Close
WshShell.Run """W:\config files\blocks\addRoute.bat""", 1, True
Set objFSO = Nothing
End Function