' *********************
' FirewallRuleCheck.vbs
' *********************
' By Elektro
' ------------
' Description:
' ------------
'
' This script determines whether a program has the Inbound or Outbound connections blocked by the Windows Firewall rules.
'
' NOTE: Possibly this script will not work under Windows XP where;
' the Netsh syntax is different and maybe the Firewall registry values could be diferent too, I've don't tested it.
' Tested on Windows 8.
' -------
' Syntax:
' -------
'
' FirewallRuleCheck.vbs "[File]" "[ConnectionType]" "[ReturnResult]"
' -----------
' Parameters:
' -----------
'
' [File]
' This parameter indicates the file to check their connection status.
' The value should be the relative or absolute filepath of an existing file.
'
' [ConnectionType]
' This parameter indicates whether to check inbound or outbound connection status.
' The value should be "In" or "Out".
'
' [ReturnResult]
' This parameter indicates whether the result should be returned without displaying any info;
' for example, when calling this script from other script to expect a Boolean result.
' The value is Optional, and should be "True" or "False". Default value is "False".
' ---------------
' Usage examples:
' ---------------
'
' FirewallRuleCheck.vbs "C:\Program.exe" IN
' FirewallRuleCheck.vbs "C:\Program.exe" OUT
' BooleanExitCode = FirewallRuleCheck.vbs "C:\Program.exe" IN True
' BooleanExitCode = FirewallRuleCheck.vbs "C:\Program.exe" OUT True
' -----------
' Exit codes:
' -----------
'
' When 'ReturnResult' parameter is set to 'False':
' 0: Successful exit.
' 1: Missing arguments or too many arguments.
' 2: File not found.
' 3: Wrong value specified for parameter '[ConnectionType]'
' 4: Wrong value specified for parameter '[ReturnResult]'
' 5: Specific Error.
'
' When 'ReturnResult' parameter is set to 'True':
' -1: 'True' (Rule is not added).
' 0: 'False' (Rule is already added).
' (All the other ExitCodes: '1', '2', '3', '4' and '5' can happen in this mode, except '0')
' *************
Option Explicit
Const MsgBoxSyntax = "FirewallRuleCheck.vbs ""[File]"" ""[ConnectionType]"" ""[ReturnResult]"""
Const MsgBoxCaption = "Firewall Rule Check"
Const MsgBoxErrorIco = 16
Const MsgBoxInfoIco = 64
Const MsgBoxDebugIco = 48
Dim objFile ' Indicates the file object.
Dim objReg ' Indicates the registry object.
Dim Root ' Indicates the root registry key.
Dim Key ' Indicates the registry key.
Dim MatchData ' Indicates the data to match.
Dim Values ' Indicates the registry value collection.
Dim Value ' Indicates the registry value.
Dim Data ' Indicates the registry data.
Dim DataIsMatched ' Indicates whether the data is matched.
Dim ConnectionType ' Indicates whether to check inbound or outbound connection status.
Dim ReturnResult ' Indicates whether the result should be returned without displaying any info;
' for example, when calling this script from other script to expect a Boolean result.
Dim DebugMode ' Indicates whether the debug mode is activated.
' Set the debug mode to 'True' if need to test the values.
DebugMode = False
' Set the 'HKEY_LOCAL_MACHINE' as Root registry key.
Root = &H80000002
' Set the Firewall rules registry location as key.
Key = "SYSTEM\CurrentControlSet\Services\SharedAccess\Parameters\FirewallPolicy\FirewallRules"
' Sets the Registry object.
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
' Argument error handling.
If Wscript.Arguments.Count = 0 Then
' Notify the error to the user.
MsgBox "Syntax:" & VBNewLine & _
MsgBoxSyntax , _
MsgBoxErrorIco, MsgBoxCaption
' Exit with reason: 'Missing arguments'.
Wscript.Quit(1)
ElseIf Wscript.Arguments.Count < 2 Then
' Notify the error to the user.
MsgBox "Missing arguments." & _
VBNewLine & VBNewLine & _
"Syntax:" & VBNewLine & _
MsgBoxSyntax , _
MsgBoxErrorIco, MsgBoxCaption
' Exit with reason: 'Missing arguments'.
Wscript.Quit(1)
ElseIf Wscript.Arguments.Count = 3 Then
If LCase(Wscript.Arguments(2)) = LCase("True") Then
ReturnResult = True
Elseif LCase(Wscript.Arguments(2)) = LCase("False") Then
ReturnResult = False
Else
' Notify the error to the user.
MsgBox "Wrong value specified for parameter 'Return Result'", _
MsgBoxErrorIco, MsgBoxCaption
' Exit with reason: 'Wrong value specified for parameter '[Return Result]''.
Wscript.Quit(4)
End If
ElseIf Wscript.Arguments.Count > 3 Then
' Notify the error to the user.
MsgBox "Too many arguments." & _
VBNewLine & VBNewLine & _
"Syntax:" & VBNewLine & _
MsgBoxSyntax , _
MsgBoxErrorIco, MsgBoxCaption
' Exit with reason: 'Too many arguments'.
Wscript.Quit(1)
End If
On Error Resume Next
' Set the FileObject with the file passed through the first argument.
Set objFile = Createobject("Scripting.FileSystemObject"). _
GetFile(Wscript.Arguments(0))
' File-Error handling.
If Err.Number = 53 Then
' Notify the error to the user.
MsgBox "File not found:" & _
vbnewline & _
Wscript.Arguments(0), _
MsgBoxErrorIco, MsgBoxCaption
' Exit with reason: 'File not found'.
Wscript.Quit(2)
End If
' Set the partial data to match on each value-data.
If LCase(Wscript.Arguments(1)) = LCase("IN") Then
' Set the ConnectionType to 'Inbound'
ConnectionType = "Inbound"
Elseif LCase(Wscript.Arguments(1)) = LCase("OUT") Then
' Set the ConnectionType to 'Outbound'
ConnectionType = "Outbound"
Else ' Wrong argument.
' Notify the error to the user.
MsgBox "Wrong value specified for parameter '[ConnectionType]'", _
MsgBoxErrorIco, MsgBoxCaption
' Exit with reason: 'Wrong value specified for parameter '[ConnectionType]''.
Wscript.Quit(3)
End If
' Set the data to match (It's a portion of the firewall rule).
MatchData = "Action=Block|Active=TRUE|Dir=" & Wscript.Arguments(1) & "|App=" & objFile.Path
' Enumerate the registry values.
objReg.EnumValues Root, Key, Values
If DebugMode Then
' Notify the debug information.
MsgBox "File: " & objFile.Path & vbnewline & vbnewline & _
"ConnectionType: " & ConnectionType & vbnewline & vbnewline & _
"Key: " & Key & vbnewline & vbnewline & _
"Value count: " & UBound(Values) & vbnewline & vbnewline & _
"MatchData: " & MatchData & vbnewline , _
MsgBoxDebugIco, "Debug Info | " & MsgBoxCaption
End If
' Loop through the enumerated registry values.
For Each Value In Values
' Get the registry data.
objReg.GetStringValue Root, Key, Value, Data
' If registry data is not empty then...
If Not IsNull(Data) Then
' Match the partial data onto the registry data.
' If partial data matched in into the data then...
If InStr(1, Data, MatchData, 1) Then
' Set the DataIsMatched flag to 'True'.
DataIsMatched = True
' ...and stop the iteration.
Exit For
End If ' // InStr()
End If ' // IsNull()
Next ' // Value
' Error handling.
If Err.Number <> 0 Then
' Notify the error to the user.
MsgBox "Error Code: " & Err.Number & vbnewline & _
"Error Source: " & Err.Source & vbnewline & _
"Description: " & Err.Description , _
MsgBoxErrorIco, MsgBoxCaption
' Exit with reason: 'Specific error'.
Wscript.Quit(5)
End If
If ReturnResult Then
If DataIsMatched = True Then
' Exit with boolean result 'True' (Rule already exist).
Wscript.Quit(-1)
Else
' Exit with boolean result 'False' (Rule doesn't exist).
Wscript.Quit(0)
End If
End If
' This (ridiculous) conversion is needed;
' because the VBS engine prints the boolean value into a MsgBox;
' according to the OS language ( Spanish: Verdadero|Falso )
If DataIsMatched = True Then
DataIsMatched = "True"
Else
DataIsMatched = "False"
End If
' Notify the information to the user.
MsgBox "File: " & objFile.Name & vbnewline & _
"Connection: " & ConnectionType & vbnewline & _
"Blocked?: " & DataIsMatched , _
MsgBoxInfoIco, MsgBoxCaption
' Exit successfully.
Wscript.Quit(0)