frmmain.frm

专业版本的vb防火墙管理程序

ListView1.ListItems.Clear
ListView1.Sorted = False
ListView1.ColumnHeaders(1).Width = 2000
ListView1.ColumnHeaders(2).Width = ListView1.Width - 2000 - 600
SetTrayTip "个人防火墙: 监视中 " & GetEntryCount & " 已连接"
For i = 0 To GetEntryCount
        If Connection(i).State = "2" Then GoTo IsListening
            If Connection(i).FileName = "" Then
                Set Item = ListView1.ListItems.Add(, , "未知")
            Else
                Dim FileNameShort
                FileNameShort = Right(Connection(i).FileName, Len(Connection(i).FileName) - InStrRev(Connection(i).FileName, "\"))
                Set Item = ListView1.ListItems.Add(, , FileNameShort & " (" & GetPort(Connection(i).LocalPort) & ")")
            End If
            Item.Tag = i
IsListening:
Next i

ListView1.Sorted = True
GetAllIcons
DoEvents
ShowIcons
DoEvents
resolveIPs False
DoEvents
Finished:
Processing = False
If Unloaded = True Then Unload Me
End Sub

Private Sub resolveIPs(ShowHost As Boolean)
Dim Item As ListItem
    

For Each Item In ListView1.ListItems
If ShowHost = False Then
Item.SubItems(1) = GetIPAddress(Connection(Item.Tag).RemoteHost) & ":" & Connection(Item.Tag).RemotePort
Else
Item.SubItems(1) = iphDNS.CheckDictionary(GetIPAddress(Connection(Item.Tag).RemoteHost)) & ":" & Connection(Item.Tag).RemotePort
End If
DoEvents
Next

End Sub

Private Function GetIcon(FileName As String, Index As Long) As Long
'---------------------------------------------------------------------
'Extract an individual icon
'---------------------------------------------------------------------
On Error Resume Next
Dim hLIcon As Long, hSIcon As Long    'Large & Small Icons
Dim imgObj As ListImage               'Single bmp in imagelist.listimages collection
Dim r As Long


If Connection(ListView1.ListItems(Index).Tag).FileName = "" Then
Set imgObj = Iml16.ListImages.Add(Index, , PicQuestion.Image)
Exit Function
End If


'Get a handle to the small icon
hSIcon = SHGetFileInfo(FileName, 0&, ShInfo, Len(ShInfo), _
         BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
'Get a handle to the large icon
'hLIcon = SHGetFileInfo(FileName, 0&, ShInfo, Len(ShInfo), _
'         BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)

'If the handle(s) exists, load it into the picture box(es)
If hLIcon <> 0 Then

  'Large Icon
  'With Pic32
  '  Set .Picture = LoadPicture("")
  '  .AutoRedraw = True
  '  r = ImageList_Draw(hLIcon, ShInfo.iIcon, Pic32.hDC, 0, 0, ILD_TRANSPARENT)
  '  .Refresh
  'End With
  
    Else
  'Small Icon
  With Pic16
    Set .Picture = LoadPicture("")
    .AutoRedraw = True
    r = ImageList_Draw(hSIcon, ShInfo.iIcon, Pic16.hDC, 0, 0, ILD_TRANSPARENT)
    .Refresh
  End With
  
  Set imgObj = Iml16.ListImages.Add(Index, , Pic16.Image)
End If

End Function

Private Function GetLargeIcon(FileName As String) As Long
'---------------------------------------------------------------------
'Extract an individual icon
'---------------------------------------------------------------------
On Error Resume Next
Dim hLIcon As Long, hSIcon As Long    'Large & Small Icons
Dim imgObj As ListImage               'Single bmp in imagelist.listimages collection
Dim r As Long


If FileName = "" Then
'Set imgObj = Iml16.ListImages.Add(Index, , PicQuestion.Image)
Exit Function
End If


'Get a handle to the large icon
hLIcon = SHGetFileInfo(FileName, 0&, ShInfo, Len(ShInfo), _
         BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)

'If the handle(s) exists, load it into the picture box(es)
If hLIcon <> 0 Then

  'Large Icon
  With Pic32
    Set .Picture = LoadPicture("")
    .AutoRedraw = True
    r = ImageList_Draw(hLIcon, ShInfo.iIcon, Pic32.hDC, 0, 0, ILD_TRANSPARENT)
    .Refresh
  End With
  
    Else

End If

End Function

Private Sub ShowIcons()
'-----------------------------------------
'Show the icons in the lvw
'-----------------------------------------
On Error Resume Next

Dim Item As ListItem
With ListView1
  '.ListItems.Clear
  .SmallIcons = Iml16   'Small
  For Each Item In .ListItems
    Item.SmallIcon = Item.Index
  Next
End With

End Sub

Private Sub GetAllIcons()
'--------------------------------------------------
'Extract all icons
'--------------------------------------------------
Dim Item As ListItem
Dim FileName As String

    ListView1.SmallIcons = Nothing
    Iml16.ListImages.Clear
    
'On Local Error Resume Next
For Each Item In ListView1.ListItems
  FileName = Connection(Item.Tag).FileName

  GetIcon FileName, Item.Index
   
Next

End Sub

Private Sub Form_Load()
HideMe = 1
Load frmSystemTray
Firewall_Enabled = True
Pub_BlockAll = False
Set m_objIpHelper = New CIpHelper
Dim FP As FILE_PARAMS
Dim CurFile As Long
Dim AppPath As String
Dim fso As New FileSystemObject
    
If IsNetConnectOnline() = True Then
    Timer2.Enabled = True
    IsOnline = True
    Else
    ListView1.ListItems.Clear
    Timer2.Enabled = False
    IsOnline = False
End If

    
If Right(App.Path, 1) <> "\" Then AppPath = App.Path & "\" & App.EXEName & ".exe" Else AppPath = App.Path & App.EXEName & ".exe"

TVPath = AppPath

GetLargeIcon AppPath

   With FP
      .sFileNameExt = AppPath
   End With
   
CurFile = GetFileInformation(FP)

'Animation.Open App.Path & "\xpsearchinternet.avi"
'Animation.AutoPlay = True
Me.BackColor = 14078416
UserControl11.SubClassMe
UserControl41.AddButton "监视中  "
UserControl41.AddButton "状态和设置   　　　"
UserControl41.AddButton "程序   　　"
UserControl41.AddButton "端口设置   　　　　"
UserControl12.SubClassMe
UserControl42.AddButton "状态和设置   　　　"
UserControl42.AddButton "统计   　　"
UserControl42.AddButton "程序   　　"
UserControl12.Top = UserControl11.Top + UserControl11.Height + 5
UserControl61.SubClassMe
UserControl71.SubClassMe
UserControl72.SubClassMe
UserControl73.SubClassMe
UserControl74.SubClassMe
UserControl75.SubClassMe
UserControl12.Reset
UserControl42.Reset
UserControl42.Visible = False

UserControl41.Left = UserControl11.Left
UserControl41.Top = UserControl11.Top + UserControl11.Height
UserControl41.Width = UserControl11.Width
UserControl41.ShowMe
UserControl41.Visible = True
UserControl12.Top = UserControl41.Top + UserControl41.Height + 5

UserControl41.ShowMenu 1
UserControl11.ForceClick

UpdatePrograms

UserControl21(0).Visible = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    
If Processing = True Or HideMe = 1 Then
'Unloaded = True
Cancel = -1
Me.Visible = False
Exit Sub
End If

iphDNS.WriteCache

UserControl11.UnSubClassMe
UserControl41.UnSubClass
UserControl12.UnSubClassMe
UserControl42.UnSubClass
UserControl61.UnSubClassMe
UserControl71.UnSubClassMe
UserControl72.UnSubClassMe
UserControl73.UnSubClassMe
UserControl74.UnSubClassMe
UserControl75.UnSubClassMe
DoEvents
End Sub

Private Sub Form_Resize()
On Error Resume Next
ListView1.ColumnHeaders(1).Width = 1300
ListView1.ColumnHeaders(2).Width = 1100
ListView1.ColumnHeaders(4).Width = 1100
ListView1.ColumnHeaders(5).Width = 1100
ListView1.ColumnHeaders(6).Width = ListView1.Width \ 2 + 1000

End Sub

Private Sub ListView1_GotFocus()
UserControl71.Enabled = True
UserControl72.Enabled = True
End Sub

Private Sub ListView1_ItemClick(ByVal Item As ComctlLib.ListItem)
Picture2.Top = 0
Picture2.Left = 0
Picture2.BackColor = vbWhite
Picture2.Visible = True
DoEvents
Dim FP As FILE_PARAMS
Dim CurFile As Long

TVHost = Connection(ListView1.ListItems(Item.Index).Tag).RemoteHost
TVPath = Connection(ListView1.ListItems(Item.Index).Tag).FileName
TVTAG = ListView1.ListItems(Item.Index).Tag
TVPI = Connection(ListView1.ListItems(Item.Index).Tag).ProcessID
Label7(1).Caption = "路径:" & TVPath

Label7(3).Caption = "PID: " & TVPI
Label7(4).Caption = "远程主机: " & iphDNS.CheckDictionary(GetIPAddress(Connection(Item.Tag).RemoteHost)) & " (" & GetIPAddress(TVHost) & ")"
Label7(5).Caption = "本机端口: " & Connection(ListView1.ListItems(Item.Index).Tag).LocalPort
Label7(6).Caption = "远程端口: " & Connection(ListView1.ListItems(Item.Index).Tag).RemotePort

    Dim FileNameShort
    FileNameShort = Right(Connection(TVTAG).FileName, Len(Connection(TVTAG).FileName) - InStrRev(Connection(TVTAG).FileName, "\"))
Label7(0).Caption = "名称: " & FileNameShort

Dim xc
xc = CheckProgramID(TVPath)
If xc <> -1 Then
Picture3.Visible = True
Label7(7).Caption = "企图: " & Program(xc).Attempts
Label7(7).Visible = True
Else
Label7(7).Visible = False
Picture3.Visible = False
End If

GetLargeIcon (TVPath)

   With FP
      .sFileNameExt = TVPath
   End With
   
CurFile = GetFileInformation(FP)

DoEvents
'If ResolveHostchk.Value = 0 Then lblHost.Caption = "Remote Host : " & GetHostNameFromIP(GetIPAddress(TVHost)) Else lblHost.Caption = "Remote Host : " & GetIPAddress(TVHost)

'PopulateTreeview (Item.Index)
'item click

Picture2.Visible = False
End Sub

Private Sub ListView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
If ListView1.SelectedItem.Selected = False Then Exit Sub

End If
End Sub

Private Sub Timer1_Timer()
NotOnline (IsNetConnectOnline())
End Sub

Public Sub NotOnline(Online As Boolean)
If Online = False Then
    IsOnline = False
    Picture4.Visible = True
    Exit Sub
End If
If Online = True Then
    IsOnline = True
    Picture4.Visible = False
End If
CallRefresh:
If GetRefresh = True Then RefreshList
End Sub
Private Sub UpdateInterfaceInfo()
Dim objInterface        As CInterface
Static st_objInterface  As CInterface
Static lngBytesRecv     As Long
Static lngBytesSent     As Long
Dim blnIsRecv           As Boolean
Dim blnIsSent           As Boolean
If st_objInterface Is Nothing Then Set st_objInterface = New CInterface
Set objInterface = m_objIpHelper.Interfaces(1)
Select Case objInterface.InterfaceType
Case MIB_IF_TYPE_ETHERNET: Label16.Caption = "连接: 以太网卡"
Case MIB_IF_TYPE_FDDI: Label16.Caption = "连接: 光纤"
Case MIB_IF_TYPE_LOOPBACK: Label16.Caption = "连接: Loopback"
Case MIB_IF_TYPE_OTHER: Label16.Caption = "连接: 其他"
Case MIB_IF_TYPE_PPP: Label16.Caption = "连接: 端对端协议"
Case MIB_IF_TYPE_SLIP: Label16.Caption = "连接: 串行线路"
Case MIB_IF_TYPE_TOKENRING: Label16.Caption = "连接: 令牌网"
End Select

If ShowTrafficInBytes = False Then
    Label10.Caption = "接收: " & GiveByteValues(Trim(Format(m_objIpHelper.BytesReceived, "###,###,###,###")))