Monthly Archives: February 2006


Simple VB-script for Windows that reads the current IIS log file for a ftp website that you specify and checks all failed logins.
If MAX_FAILED_LOGINS is reached the IP address will be banned in MS ISA server.


– ISA-Server (this script is tested for version 2004)

– A computer set in ISA Server to store the banned hosts. See the AbuseComputerset constant

– A policy rule that denies all protocols to all destinations when source is AbuseComputerset

'Created by: Goran Tornqvist. 
'This script is freeware, do what you like with it ;)
'Simple script the reads the current IIS log file for a ftp website that you specify
'and checks all failed logins. If MAX_FAILED_LOGINS is reached the IP address will
'be banned in MS ISA server.


'Max failed logins per IP and day (e.g file).

'Path to the IIS Ftp website log files folder
Const strPathFtpLogFiles = "c:\windows\system32\LogFiles\MSFTPSVC1"

'Constants used when sending the message when an IP has been banned.
'You can change more settings in the MailBannedMessage() function.
Const blnSendBannedEmail = True
Const SMTP_SERVER = ""
Const SMTP_FROM = ""
Const SMTP_TO = ""

'IP-adresses that NEVER can be banned.
Set ExcludeHosts = CreateObject("Scripting.Dictionary")
ExcludeHosts.Add "","Put a nice little comment here if you like, this field is not used."

'ISA Server Constants
AbuseComputerset = "Abuse hosts"
Const fpcInclude = 0
Const fpcSpecifiedProtocols = 1

Function GetIISLFDate()
	'This function gets current date in this format 061201, which is used by IIS log files.

	theYear = Right(Year(Now()),2)
	theMonth = Month(Now())
	If theMonth < 10 Then
		theMonth = "0" & theMonth
	End If
	theDay = Day(Now())
	If theDay < 10 Then
		theDay = "0" & theDay
	End If

	GetIISLFDate = theYear & theMonth & theDay

End Function

Sub MailBannedMessage(strIP, intNumFailedLogins)
	'This function sends a message when an IP is banned

	Set objMessage = CreateObject("CDO.Message")
	objMessage.Subject = "Banned IP " & strIP & " for " & intNumFailedLogins & " failed logins"
	objMessage.From = SMTP_FROM
	objMessage.To = SMTP_TO
	objMessage.TextBody = "This is a message from your firewall." & vbCrLf & "I just banned IP " & strIP & " for hammering on the door " & intNumFailedLogins & " times."

	objMessage.Configuration.Fields.Item _
	("") = 2

	objMessage.Configuration.Fields.Item _

	objMessage.Configuration.Fields.Item _



End Sub

strTextFile = strPathFtpLogFiles & "\ex" & GetIISLFDate() & ".log"

Set objFS = CreateObject("Scripting.FileSystemObject")

'Lets open the log file for reading
Set objFile = objFS.OpenTextFile(strTextFile, 1)

'This dictionary is used for storing IPs and how many times the IP has a failed login
Set objDictInvalidLogins = CreateObject("Scripting.Dictionary")

'Loop thru all the rows in the logfile
Do While objFile.AtEndOfStream = False
	strLine = objFile.ReadLine
	'If failed login, ftp code 530
	If InStr(strLine, "PASS - 530") > 0 Then
		intFirstSpace = InStr(strLine, " ")
		intSecondSpace = InStr(intFirstSpace+1, strLine, " ")

		'Get the IP from the line row
		IP = Mid(strLine, intFirstSpace+1, intSecondSpace-intFirstSpace-1)

		If NOT objDictInvalidLogins.Exists(IP) Then
			'IP Does not exist, add it
			objDictInvalidLogins.Add IP, 1
			'Increment invalid logins with 1 for the IP
			objDictInvalidLogins.Item(IP) = objDictInvalidLogins.Item(IP)+1
		End If
	End If

' Create the root object.
Dim root  ' The FPCLib.FPC root object
Set root = CreateObject("FPC.Root")

'Declare the other objects needed.
Dim isaArray    ' An FPCArray object
Dim policyrules ' An FPCPolicyRules collection
Dim urlsets     ' An FPCURLSets collection
Dim urlset      ' An FPCURLSet object
Dim newrule     ' An FPCPolicyRule object

' Get references to the array object, the policy
' rules collection, and the URL sets collection.
Set isaArray = root.GetContainingArray()

'All ComputerSets - Collection
Set ComputerSets = isaArray.RuleElements.ComputerSets

'Get our computer set containing the abuse hosts
Set ComputerSet = ComputerSets.Item(AbuseComputerset)

'Get the collection of current computers that are banned
Set ComputerSet_Computers = ComputerSet.computers

'Loop thru the collection of all IPs that have invalid logins
For Each IPAddress In objDictInvalidLogins
	'If this IP has to many failed logins
	If objDictInvalidLogins(IPAddress) > MAX_FAILED_LOGINS Then
		'And if the IP is not on the exclude list
		If NOT ExcludeHosts.Exists(IPAddress) Then
			'Check if the IP already is banned, can ban it twice can we?
			'Don't know any better way to do this than below
			On Error Resume Next
			Set Computer = ComputerSet_Computers.Item(IPAddress)
			If Err.Number <> 0 Then
				'No computer with that IP in the collection
				ComputerExists = False
				'We could find the computer in the collection, it exists!
				ComputerExists = True
			End If
			On Error Goto 0

			'Ban it!
			If NOT ComputerExists Then
				'Add the IP to computerset of banned computer
				ComputerSet_Computers.Add IPAddress, IPAddress

				If blnSendBannedEmail Then
					'Send you an email that someone has been naughty!
					MailBannedMessage IPAddress, objDictInvalidLogins(IPAddress)
				End If
			End If
		End If

	End If