Question

I need to find a partial text (not full text match) inside the data of all the values of a subkey, or in other words: I need to find a firewall exception on the registry.

The problem that I have is that in my script the For says that the arrSubKeys object is not a collection, but it is! (the method itselfs instances a new array not?)

So I can't loop over the values and I don't know why I'm getting this error 'cause I've taken it directly from here in Technet.

I need help to solve this problem and to do the 'find partial text in datas' orders.

Const HKLM      = &H80000002
Const Key       = "SYSTEM\CurrentControlSet\Services\SharedAccess\Parameters\FirewallPolicy\FirewallRules"
Const MatchData = "Action=Block|Active=TRUE|Dir=Out|App=C:\FTP Manager.exe"

Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

objReg.EnumKey HKLM, Key, arrSubKeys

For Each Subkey in arrSubKeys
 Wscript.Echo Subkey
Next

Wscript.Quit()

UPDATE:

I've find my error I was trying to enumerate the keys instead of the Values, so now how I can proceed to match partial text in the data of each value?:

objReg.EnumValues HKLM, Key, arrValues

For Each Value in arrValues

...
Was it helpful?

Solution

Finally I did it, a generic usage script to launch it from the windows context menu (for example) to check the status of an Inbound or Outbound connection block of the specified file:

' By Elektro

' Determines whether a program has the Inbound or Outbound connections blocked by the Windows Firewall rules.
'
' NOTE: Possibly this Snippet will not work under WindowsXP.


' Syntax:
' -------
' ThisScript.vbs "[Existing filepath]" "[IN|OUT]"
'
' Usage example:
' --------------
' Wscript.exe ThisScript.vbs "C:\Program.exe" IN
' Wscript.exe ThisScript.vbs "C:\Program.exe" OUT


' Error codes:
'
' 1: Missing arguments or too many arguments.
' 2: File not found.
' 3: Wrong value specified for parameter '[IN|OUT]'
' 4: Specific Error.


Option Explicit


Dim objFile        ' Indicates the File Object.
Dim objReg         ' Indicates the Registry Object.
Dim Root           ' Indicates the root of the 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 if it's an Inbound or Outbound check.

' 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 count error handling.
If Wscript.Arguments.Count < 2 Then

    ' Notify the error to the user.
    MsgBox "Missing arguments."  & _
           VBNewLine & VBNewLine & _
           "Syntax:" & VBNewLine & _ 
           "Script.vbs  ""[FILE]""  ""[IN|OUT]""", _
           16, "Firewall rules"

    ' Exit with reason: 'Missing arguments' error-code.
    Wscript.Quit(1)

ElseIf Wscript.Arguments.Count > 2 Then

    ' Notify the error to the user.
    MsgBox "Too many arguments." & _
           VBNewLine & VBNewLine & _
           "Syntax:" & VBNewLine & _ 
           "Script.vbs  ""[FILE]""  ""[IN|OUT]""", _
           16, "Firewall rules"

    ' Exit with reason: 'Too many arguments' error-code.
    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), _
           16, "Firewall rules"

    ' Exit with reason: 'File not found' error-code.
    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"

    ' Match Inbound connection rule.
    MatchData = "Action=Block|Active=TRUE|Dir=In|App=" & objFile.Path

Elseif LCase(Wscript.Arguments(1)) = LCase("OUT") Then

    ' Set the ConnectionType to 'Outbound'
    ConnectionType = "Outbound"

    ' Match Outbound connection rule.
    MatchData = "Action=Block|Active=TRUE|Dir=Out|App=" & objFile.Path

Else ' Wrong argument.

    ' Notify the error to the user.
    MsgBox "Wrong value specified for parameter '[IN|OUT]'", _
           16, "Firewall rules"

    ' Exit with reason: 'Wrong value specified for parameter '[IN|OUT]'' error-code.
    Wscript.Quit(3)

End If

' Get the values.
objReg.EnumValues Root, Key, Values

' Loop through the values.
For Each Value In Values

    ' Get the data.
    objReg.GetStringValue Root, Key, Value, Data

    ' Match the partial data.
    If Not IsNull(Data) Then

        ' If partial data matched in data then...
        If InStr(1, Data, MatchData, 1) Then

            ' Set the DataMAtched 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, _
           16, "Firewall rules"

    ' Exit with reason: 'Specific error' error-code.
    Wscript.Quit(4)

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 & _
       "Type: " & ConnectionType & " connection" & vbnewline & _
       "Blocked: " & DataIsMatched, _
        64, "Firewall rules"

' Exit successfully.
Wscript.Quit(0)
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top