Attribute VB_Name = "Module2"


 Private Sub FirewallClose()
    With CreateObject("HNetCfg.FwMgr")
        .LocalPolicy.CurrentProfile.AuthorizedApplications.Remove _
            App.path & "\" & App.EXEName & ".exe"
    End With
End Sub

 Private Sub FirewallOpen()
    Const NET_FW_SCOPE_ALL = 0
    Const NET_FW_IP_VERSION_ANY = 2
    Dim imageFileName As String
    Dim appAuth As Object
    
    imageFileName = App.path & "\" & App.EXEName & ".exe"
    With CreateObject("HNetCfg.FwMgr")
        Set appAuth = CreateObject("HNetCfg.FwAuthorizedApplication")
        With appAuth
            .ProcessImageFileName = imageFileName
            .Name = App.EXEName
            .Scope = NET_FW_SCOPE_ALL
            .IpVersion = NET_FW_IP_VERSION_ANY
            .Enabled = True
        End With
        'This seems to return silently (no exception even if it fails) on
        'some versions of Windows.
        .LocalPolicy.CurrentProfile.AuthorizedApplications.Add appAuth
        
        'Use this test to determine whether or not the rule was added.
        'If .Add above failed this returns an exception such as &H80070002
        '(-2147024894) because there is no object returned.
        Set appAuth = _
            .LocalPolicy.CurrentProfile.AuthorizedApplications.Item(imageFileName)
    End With
End Sub

 Sub FwallClose()
    On Error Resume Next
    FirewallClose
    If Err Then
        MsgBox "Error " & CStr(Err.Number) & vbNewLine _
             & "Source " & Err.Source & vbNewLine _
             & Err.Description
    Else
        MsgBox "Firewall closed"
    End If
End Sub

 Sub FwallOpen()
    On Error Resume Next
    FirewallOpen
    If Err Then
        MsgBox "Error " & CStr(Err.Number) & vbNewLine _
             & "Source " & Err.Source & vbNewLine _
             & Err.Description
    Else
        MsgBox "Firewall opened"
    End If
End Sub

