VBScript: Stop Dictionary FTP Attacks in IIS using VBScript

  1Set objFTPSVC = GetObject("IIS://localhost/MSFTPSVC")
  2Set objFSO = CreateObject("Scripting.FileSystemObject")
  3Set objLog = CreateObject("MSWC.IISLog")
  4Set objDictionary = CreateObject("Scripting.Dictionary")
  5
  6Dim Attempts(), IP(), LastAttempt(), IPs
  7Dim AlreadyBanned, InProcess, Session
  8Dim CutOff, x, i
  9IPs = 0
 10
 11'Iterate through each FTP site.
 12For Each objSITE In objFTPSVC
 13    If LCase(objSITE.class) = "iisftpserver" Then
 14        ftpLogFilePath = objSITE.LogFileDirectory & "\msftpsvc" & objSITE.Name
 15        Set objFolder = objFSO.GetFolder(ftpLogFilePath)
 16        Set objFiles = objFolder.Files
 17        For Each fileName In objFiles
 18            lastFile = fileName
 19        Next
 20        strLogFile = lastFile
 21        Set file = Nothing
 22        Set objFolder = Nothing
 23
 24        'Use the IIS log file parser provided by MSFT
 25        objLog.OpenLogFile strLogFile, 1, "MSFTPSVC", 1, 0
 26        '(FileName,IOMode,ServiceName,ServiceInstance,OutputLogFileFormat)
 27        ' 0 = NotApplicable, 1 = ForReading
 28        Do While NOT objLog.AtEndOfLog
 29            objLog.ReadLogRecord
 30            If InStr(UCase(objLog.Method), "USER") Then
 31                'Someone is attempting to authenticate with the FTP server
 32                InProcess = False
 33                AlreadyBanned = False
 34                For x = 0 To IPs - 1
 35                    'Check to see if this IP address has already attempted to log in.
 36                    If objLog.ClientIP = IP(x) Then
 37                        'To be nice this code will give the user
 38                        'another attempt every minute.
 39                        'This is to avoid banning a person who
 40                        'attempts to log in multiple times
 41                        'in a day but keeps forgetting their password.
 42                        Attempts(x) = Attempts(x) + DateDiff("n", objLog.DateTime, LastAttempt(x))
 43                        LastAttempt(x) = objLog.DateTime
 44                        InProcess = True
 45                    End If
 46                Next
 47                If Not InProcess Then
 48                    'If we aren't keeping track of this IP
 49                    'it's possible the IP has already been
 50                    'added to the ban list.
 51                    AlreadyBanned = objDictionary.Exists(objLog.ClientIP)
 52                End If
 53                If Not InProcess And Not AlreadyBanned Then
 54                    'First authentication attempt by this IP
 55                    IPs = IPs + 1
 56                    ReDim Preserve IP(IPs)
 57                    ReDim Preserve Attempts(IPs)
 58                    ReDim Preserve LastAttempt(IPs)
 59                    IP(IPs - 1) = objLog.ClientIP
 60                    Attempts(IPs - 1) = 1
 61                    LastAttempt(IPs - 1) = objLog.DateTime
 62                End If
 63            ElseIf InStr(UCase(objLog.Method), "PASS") Then
 64                'The server is responding to an authentication
 65                'attempt.
 66                For x = 0 To IPs - 1
 67                    'See if we're keeping track of this IP
 68                    If IP(x) = objLog.ClientIP Then
 69                        'Increment the authentication attempts
 70                        Attempts(x) = Attempts(x) + 1
 71                        If Attempts(x) = 10 Then
 72                            'Ban if necessary
 73                            WScript.Echo "Banning " & objLog.ClientIP & "..."
 74                            objDictionary.Add objLog.ClientIP, "255.255.255.255"
 75                            AddDeadRoute objLog.ClientIP
 76                            For i = x To (IPs - 2)
 77                                IP(i) = IP(i + 1)
 78                                Attempts(i) = Attempts(i + 1)
 79                            Next
 80                            IPs = IPs - 1
 81                            ReDim Preserve IP(IPs)
 82                            ReDim Preserve Attempts(IPs)
 83                        End If
 84                    End If
 85                Next
 86            End If
 87        Loop
 88        objLog.CloseLogFiles 1
 89    End If
 90Next
 91
 92Set objDictionary = Nothing
 93Set objLog = Nothing
 94Set objFSO = Nothing
 95Set objFTPSVC = Nothing
 96
 97Function AddDeadRoute(IP)
 98    Dim adoDBConn, sConnStr, objFSO, objBanBatch, cmdShell, WshShell
 99    Dim fakeGateway
100    'I've been told that IPSec could be used to block certain IPs
101    'but 1) I'm not sure WMI can interface with it and 2) I don't
102    'know how to begin with. Someone gave me a much easier solution
103    'Simply add a route to the routing table pointing to a gateway
104    'that doesn't exist.
105
106    'Ensure that this IP is on the same subnet as the server
107    fakeGateway = "192.168.1.101"
108
109    Set WshShell = WScript.CreateObject("WScript.Shell")
110    Set objFSO = CreateObject("Scripting.FileSystemObject")
111    Set objBanBatch = objFSO.CreateTextFile("W:\config files\blocks\addRoute.bat", True)
112    objBanBatch.WriteLine "ROUTE ADD " & IP & " MASK 255.255.255.255 " & fakeGateway
113    objBanBatch.Close
114    WshShell.Run """W:\config files\blocks\addRoute.bat""", 1, True
115    Set objFSO = Nothing
116End Function