home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Programmin18171611112004.psc / clsFirewall.cls < prev    next >
Encoding:
Visual Basic class definition  |  2004-11-11  |  3.4 KB  |  172 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsFirewall"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. Const ICSSC_DEFAULT = 0
  17. Const CONNECTION_PUBLIC = 0
  18. Const CONNECTION_PRIVATE = 1
  19. Const CONNECTION_ALL = 2
  20.  
  21. Const NET_FW_IP_PROTOCOL_UDP = 17
  22. Const NET_FW_IP_PROTOCOL_TCP = 6
  23.  
  24. Const NET_FW_SCOPE_ALL = 0
  25. Const NET_FW_SCOPE_LOCAL_SUBNET = 1
  26.  
  27. Private oNetShareMgr As Object
  28.  
  29. '--> Return the Firewall Status
  30. Public Function FirewallStatus() As Boolean
  31.  
  32. Dim bolStatus As Boolean
  33. Dim oProfile As Object
  34.  
  35. On Error GoTo errHandler
  36.     
  37.     Set oNetShareMgr = CreateObject("HNetCfg.FwMgr")
  38.     Set oProfile = oNetShareMgr.LocalPolicy.CurrentProfile
  39.  
  40.     If oProfile.FirewallEnabled = False Then
  41.       bolStatus = False
  42.     Else
  43.       bolStatus = True
  44.     End If
  45.               
  46.   FirewallStatus = bolStatus
  47.   
  48.   Exit Function
  49.   
  50. errHandler:
  51.   FirewallStatus = False
  52.   MsgBox "Error: " & Err.Description
  53.   Err.Clear
  54.  
  55. End Function
  56.  
  57. '--> Enable Firewall
  58. Public Sub EnableFirewall()
  59.  
  60. Dim oProfile As Object
  61.  
  62.   On Error GoTo ErrorHandler
  63.         
  64.   Set oNetShareMgr = CreateObject("HNetCfg.FwMgr")
  65.   Set oProfile = oNetShareMgr.LocalPolicy.CurrentProfile
  66.  
  67.   If oProfile.FirewallEnabled = False Then
  68.     oProfile.FirewallEnabled = True
  69.   End If
  70.   
  71.   Set oProfile = Nothing
  72.   Set oNetShareMgr = Nothing
  73.     
  74.   Exit Sub
  75.     
  76. ErrorHandler:
  77.   MsgBox Err.Description
  78.   Err.Clear
  79.  
  80. End Sub
  81.  
  82. '--> Disable Firewall
  83. Public Sub DisableFirewall()
  84.  
  85. Dim oProfile As Object
  86.  
  87.   On Error GoTo ErrorHandler
  88.         
  89.   Set oNetShareMgr = CreateObject("HNetCfg.FwMgr")
  90.   Set oProfile = oNetShareMgr.LocalPolicy.CurrentProfile
  91.  
  92.   If oProfile.FirewallEnabled = True Then
  93.     oProfile.FirewallEnabled = False
  94.   End If
  95.   
  96.   Set oProfile = Nothing
  97.   Set oNetShareMgr = Nothing
  98.     
  99.   Exit Sub
  100.     
  101. ErrorHandler:
  102.   MsgBox Err.Description
  103.   Err.Clear
  104.  
  105. End Sub
  106.  
  107. '--> Add a new port to the Firewall Configuration
  108. Public Sub AddPortToFirewall(ByVal strPortName As String, ByVal strPortProtocol As String, ByVal intPortNumber As Integer)
  109.  
  110. Dim oProfile As Object
  111. Dim port As Object
  112.  
  113. On Error GoTo errHandler
  114.  
  115.  
  116.   Set oNetShareMgr = CreateObject("HNetCfg.FwMgr")
  117.   Set oProfile = oNetShareMgr.LocalPolicy.CurrentProfile
  118.   Set port = CreateObject("HNetCfg.FWOpenPort")
  119.   
  120.   port.Name = strPortName
  121.   If LCase(strPortProtocol) = "UDP" Then
  122.     port.Protocol = NET_FW_IP_PROTOCOL_UDP
  123.   Else
  124.     port.Protocol = NET_FW_IP_PROTOCOL_TCP
  125.   End If
  126.   
  127.   port.port = intPortNumber
  128.  
  129.   port.Scope = NET_FW_SCOPE_ALL
  130.  
  131.   port.Enabled = True
  132.  
  133.   oProfile.GloballyOpenPorts.Add port
  134.   
  135.   Set oProfile = Nothing
  136.   Set port = Nothing
  137.   Set oNetShareMgr = Nothing
  138.  
  139.   Exit Sub
  140.   
  141. errHandler:
  142.   MsgBox Err.Description
  143.   Err.Clear
  144.  
  145. End Sub
  146.  
  147. Public Sub AllowIncomingICMP(ByVal bolAllow As Boolean)
  148.  
  149. Dim oProfile As Object
  150.  
  151. On Error GoTo errHandler
  152.  
  153.   Set oNetShareMgr = CreateObject("HNetCfg.FwMgr")
  154.   Set oProfile = oNetShareMgr.LocalPolicy.CurrentProfile
  155.   oProfile.IcmpSettings.AllowInboundEchoRequest = bolAllow
  156.   
  157.   Set oProfile = Nothing
  158.   Set oNetShareMgr = Nothing
  159.  
  160. Exit Sub
  161.  
  162. errHandler:
  163.   MsgBox Err.Description
  164.   Err.Clear
  165.  
  166. End Sub
  167.  
  168.  
  169.  
  170.  
  171.  
  172.