Option Compare Database
Option Explicit
 
Sub aa(portcode As Integer)    '编码实现用程序开端口
    On Error GoTo 0
    'Set Constants
    Const NET_FW_IP_PROTOCOL_UDP = 17
    Const NET_FW_IP_PROTOCOL_TCP = 6
    Const NET_FW_SCOPE_ALL = 0
    Const NET_FW_SCOPE_LOCAL_SUBNET = 1
    'Declare variables
    'Create the firewall manager object.
    Dim fwMgr
    Dim Profile
    Dim Port
    If portcode = 0 Then Exit Sub
    Set fwMgr = CreateObject("HNetCfg.FwMgr")
    ' Get the current profile for the local firewall policy.
    Set Profile = fwMgr.LocalPolicy.CurrentProfile
    Set Port = CreateObject("HNetCfg.FWOpenPort")
    Port.Name = "HTTP"
    Port.Protocol = NET_FW_IP_PROTOCOL_TCP    '6
    Port.Port = portcode
    'If using Scope, don't use RemoteAddresses
    Port.Scope = NET_FW_SCOPE_ALL    ' 0
    'Use this line to scope the port to Local Subnet only
    'port.Scope = NET_FW_SCOPE_LOCAL_SUBNET     ' 1
    Port.Enabled = True
    'Use this line instead if you want to add the port, but disabled
    'port.Enabled = FALSE
    On Error Resume Next
    Profile.GloballyOpenPorts.Add Port
    If Err.Number <> 0 Then
        MsgBox "Adding the port failed:" & Err.Description, , "Error Number: " & Err.Number
    End If
End Sub