[APORTE] [VBS] Snippets para manipular reglas de bloqueo del firewall de Windows

Bueno, he codeado este mini Script para determinar si un proceso (existente) tiene las conexiones entrantes o salientes bloqueadas por el firewall de Windows.

Mi intención es usar este script desde unas opciones que crearé en el menú contextual de Windows para bloquear conexiones, desbloquear, y comprobar si un proceso ya está bloqueado.

EDITO: Mejorado.

Código

' *********************
' 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)

Ejemplos de uso:

Código:

Wscript.exe ThisScript.vbs "C:\Program.exe" IN

Código:

Wscript.exe ThisScript.vbs "C:\Program.exe" OUT

PD: No sé si funcionará en WindowsXP, por que Netsh usa una sintaxis distinta a las versiones posteriores de Windows y supongo que en los valores de las claves de las reglas del Firewall también se verán reflejados estos cambios de sintaxis, no lo sé, no lo he comprobado.

Saludos!

Otro script, para añadir reglas de bloqueo de conexiones entrantes o salientes del firewall de Windows:

( Estos scripts dependen del primer script, 'FirewallRuleCheck.vbs', puesto que llaman a dicho script para verificar si una regla existe o si no existe )

EDITO: Mejorado

Código

' *******************
' FirewallRuleAdd.vbs
' *******************
' By Elektro
 
 
' ------------
' Description:
' ------------
'
' This Script adds a Firewall rule to block the Inbound or Outbound connections of a file.
'
' 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:
' -------
'
' FirewallRuleAdd.vbs "[File]" "[ConnectionType]"
 
 
' -----------
' Parameters:
' -----------
'
' [File]
' This parameter indicates the file to block.
' The value should be the relative or absolute filepath of an existing file.
'
' [ConnectionType]
' This parameter indicates whether to add a rule to block inbound or outbound connections.
' The value should be "In" or "Out".
 
 
' ---------------
' Usage examples:
' ---------------
'
' FirewallRuleAdd.vbs "C:\Program.exe" IN
' FirewallRuleAdd.vbs "C:\Program.exe" OUT
 
 
' -----------
' Exit codes:
' -----------
'
' -1: Rule already exist.
'  0: Successful exit.
'  1: Missing arguments or too many arguments.
'  2: File not found.
'  3: Wrong value specified for parameter '[ConnectionType]'
'  4: Specific Error.
 
 
' *************
Option Explicit
 
Const MsgBoxSyntax   = "FirewallRuleAdd.vbs ""[File]"" ""[ConnectionType]"""
Const MsgBoxCaption  = "Firewall Rule Add"
Const MsgBoxErrorIco = 16
Const MsgBoxInfoIco  = 64
Const MsgBoxDebugIco = 48
 
Dim objFile        ' Indicates the File Object.
Dim Process        ' Indicates the process to run.
Dim Arguments      ' Indicates the process arguments.
Dim Result         ' Indicates the result (Exit Code) of the process.
Dim ConnectionType ' Indicates whether to block inbound or outbound connections.
Dim DebugMode      ' Indicates whether the debug mode is activated.
 
 
' Set the debug mode to 'True' if need to test the values.
DebugMode = False
 
' 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' error-code.
	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 > 2 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)
 
ElseIf Wscript.Arguments.Count = 2 Then
 
	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
 
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 firewall process.
Process   = "netsh.exe"
 
' Set the firewall rule parameters to add Inbound or Outbound blocking rule.
Arguments = "AdvFirewall Firewall Add Rule"       & _
            " Name=" & """" & objFile.Name & """" & _
            " Dir="  & Wscript.Arguments(1)       & _
            " Action=Block"                       & _
            " Program=" & """" & objFile.Path & """"
 
' Call the 'FirewallRuleCheck' script to retrieve their exit code;
' This way I determine whether the bloking rule already exist or not.
Result = WScript.CreateObject("WScript.Shell"). _
         Run("FirewallRuleCheck.vbs"    & " " & _
             """" & objFile.Path & """" & " " & _
             Wscript.Arguments(1)       & " " & _
             "True", 0, True)
 
If DebugMode Then
 
	' Notify the debug information.
	MsgBox "File: "            & objFile.Path   & vbnewline & vbnewline & _
	       "ConnectionType: "  & ConnectionType & vbnewline & vbnewline & _
	       "Process: "         & Process        & vbnewline & vbnewline & _
	       "Arguments: "       & Arguments      & vbnewline & vbnewline & _
	       "Reult: "           & Result         & vbnewline             , _
	       MsgBoxDebugIco,     "Debug Info | "  & MsgBoxCaption
 
End If
 
' 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 Result = -1 Then ' Rule already exist.
 
	' Notify the error to the user.
	MsgBox ConnectionType & " connection blocking rule already exist for file:" & _
	       vbnewline                                                            & _
	       objFile.Name                                                         , _
	       MsgBoxErrorIco, MsgBoxCaption
 
	' Exit with reason: 'Rule already exist'.
	Wscript.Quit(-1)
 
Else ' Rule added successfully.
 
	WScript.CreateObject("WScript.Shell").Run Process & " " & Arguments, 0, True
 
	' Notify the information to the user.
	MsgBox ConnectionType & " connection blocking rule successfully added for file:" & _
	       vbnewline                                                                 & _
	       objFile.Name                                                              , _
	       MsgBoxInfoIco, MsgBoxCaption
 
End If
 
' Exit successfully.
Wscript.Quit(0)

Y otro para eliminar reglas:

EDITO: Mejorado

Código

' *******************
' FirewallRuleDel.vbs
' *******************
' By Elektro
 
 
' ------------
' Description:
' ------------
'
' This Script deletes an existing firewall rule that is blocking the Inbound or Outbound connections of a file.
'
' 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 doesn't tested it.
'       Tested on Windows 8.
 
 
' -------
' Syntax:
' -------
'
' FirewallRuleDel.vbs "[File]" "[ConnectionType]"
 
 
' -----------
' Parameters:
' -----------
'
' [File]
' This parameter indicates the file to block.
' The value should be the relative or absolute filepath of an existing file.
'
' [ConnectionType]
' This parameter indicates whether to delete the rule that is blocking inbound or outbound connections.
' The value should be "In" or "Out".
 
 
' ---------------
' Usage examples:
' ---------------
'
' FirewallRuleDel.vbs "C:\Program.exe" IN
' FirewallRuleDel.vbs "C:\Program.exe" OUT
 
 
' -----------
' Exit codes:
' -----------
'
' -1: Rule doesn't exist.
'  0: Successful exit.
'  1: Missing arguments or too many arguments.
'  2: File not found.
'  3: Wrong value specified for parameter '[ConnectionType]'
'  4: Specific Error.
 
 
' *************
Option Explicit
 
Const MsgBoxSyntax   = "FirewallRuleDel.vbs ""[File]"" ""[ConnectionType]"""
Const MsgBoxCaption  = "Firewall Rule Del"
Const MsgBoxErrorIco = 16
Const MsgBoxInfoIco  = 64
Const MsgBoxDebugIco = 48
 
Dim objFile        ' Indicates the File Object.
Dim Process        ' Indicates the process to run.
Dim Arguments      ' Indicates the process arguments.
Dim Result         ' Indicates the result (Exit Code) of the process.
Dim ConnectionType ' Indicates whether to unblock inbound or outbound connections.
Dim DebugMode      ' Indicates whether the debug mode is activated.
 
 
' Set the debug mode to 'True' if need to test the values.
DebugMode = False
 
' 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' error-code.
	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 > 2 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)
 
ElseIf Wscript.Arguments.Count = 2 Then
 
	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
 
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 firewall process.
Process   = "netsh.exe"
 
' Set the firewall rule parameters to delete Inbound or Outbound blocking rule.
Arguments = "AdvFirewall Firewall Delete Rule"    & _
            " Name=" & """" & objFile.Name & """" & _
            " Dir="  & Wscript.Arguments(1)
 
' Call the 'FirewallRuleCheck' script to retrieve their exit code;
' This way I determine whether the bloking rule is exist or not.
Result = WScript.CreateObject("WScript.Shell"). _
         Run("FirewallRuleCheck.vbs"    & " " & _
             """" & objFile.Path & """" & " " & _
             Wscript.Arguments(1)       & " " & _
             "True", 0, True)
 
If DebugMode Then
 
	' Notify the debug information.
	MsgBox "File: "            & objFile.Path   & vbnewline & vbnewline & _
	       "ConnectionType: "  & ConnectionType & vbnewline & vbnewline & _
	       "Process: "         & Process        & vbnewline & vbnewline & _
	       "Arguments: "       & Arguments      & vbnewline & vbnewline & _
	       "Reult: "           & Result         & vbnewline             , _
	       MsgBoxDebugIco,     "Debug Info | "  & MsgBoxCaption
 
End If
 
' 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 Result = 0 Then ' Rule doesn't exist.
 
	' Notify the error to the user.
	MsgBox ConnectionType & " connection blocking rule doesn't exist for file:" & _
	       vbnewline                                                            & _
	       objFile.Name                                                         , _
	       MsgBoxErrorIco, MsgBoxCaption
 
	' Exit with reason: 'Rule doesn't exist'.
	Wscript.Quit(-1)
 
Else ' Rule deleted successfully.
 
	WScript.CreateObject("WScript.Shell").Run Process & " " & Arguments, 0, True
 
	' Notify the information to the user.
	MsgBox ConnectionType & " connection block rule successfully deleted for file:" & _
	       vbnewline                                                                & _
	       objFile.Name                                                             , _
	       MsgBoxInfoIco, MsgBoxCaption
 
End If
 
' Exit successfully.
Wscript.Quit(0)