mdlfirewall.bas

支持监控包括传输控制协议和 UDP 的所有的互联网传输协议。同时程序具有实时文件防修改监控功能

            .Section = "RULES"
            .Key = Connection(i).Filename
            .Default = 0
        End With 'cINIFile
        If Connection(i).LocalPort <= Connection(i).RemotePort Then
            lngIncoming = lngIncoming + 1
            If Allow_Logs Then
                LogTraffic "Incoming", Connection(i).Filename & " allowed traffic from " & Connection(i).RemoteHost & " on port " & Connection(i).LocalPort & "."
            End If
        Else
            If Allow_Logs Then
                LogTraffic "Outbound", Connection(i).Filename & " sent traffic to " & Connection(i).RemoteHost & " on port " & Connection(i).RemotePort & "."
            End If
            lngOutgoing = lngOutgoing + 1
        End If
        If frmMain.mnuSecurityAllow.Checked Then
            GoTo Skip
        End If
        If frmMain.mnuSecurityBlock.Checked Then
            GoTo block
        End If
        Select Case cINIFile.Value
        Case "0", "" 'Ask
            If frmBlockAll.Visible Then
                CloseConnection i, Connection(i).Filename
            Else
                Alert Connection(i).Filename, i, Connection(i).ProcessID
            End If
        Case "1" 'Block
block:
            lngBlocked = lngBlocked + 1
            CloseConnection i, Connection(i).Filename
        Case "2" 'Trust
' Nothing
        Case "3" 'Terminate
            KillProcessById Connection(i).ProcessID
        End Select
        DoEvents
' Check rules for RemoteHost
        With cINIFile
            .Section = "NETWORKING"
            .Default = "-"
            .Key = Connection(i).RemoteHost
        End With
        Select Case cINIFile.Value
        Case "0" ' Allow
'Do Nothing
        Case "1" ' Ask
            If frmBlockAll.Visible Then
                CloseConnection i, Connection(i).Filename
            Else
                CheckForHackers RemH, i ' By Ip Address
            End If
        Case "2" ' Block
            CloseConnection i, Connection(i).Filename
        End Select
' Check rules for LocalPort
        With cINIFile
            .Section = "NETWORKING"
            .Default = "-"
            .Key = Connection(i).LocalPort
        End With
        Select Case cINIFile.Value
        Case "0" ' Allow
'Do Nothing
        Case "1" ' Ask
            If frmBlockAll.Visible Then
                CloseConnection i, Connection(i).Filename
            Else
                CheckForHackersPort LocP, i 'By Port Number
            End If
        Case "2" ' Block
            CloseConnection i, Connection(i).Filename
        End Select
        DoEvents
    Next i
Skip:
    DoEvents
    If oldLngIncoming = lngIncoming Then
        If oldLngOutgoing = lngOutgoing Then
            If oldLngBlocked = lngBlocked Then
'NO TRAFFIC
                Set frmMain.SysTray.TrayIcon = frmMain.ilTray.ListImages(1).ExtractIcon
            End If
        End If
    End If
    If oldLngIncoming = lngIncoming Then
        If oldLngOutgoing = lngOutgoing Then
            If oldLngBlocked <> lngBlocked Then
'BLOCK ALL
                Set frmMain.SysTray.TrayIcon = frmMain.ilTray.ListImages(2).ExtractIcon
            End If
        End If
    End If
    If oldLngIncoming <> lngIncoming Then
        If oldLngOutgoing <> lngOutgoing Then
            If oldLngBlocked = lngBlocked Then
'ALLOW ALL
                Set frmMain.SysTray.TrayIcon = frmMain.ilTray.ListImages(5).ExtractIcon
            End If
        End If
    End If
    If oldLngIncoming = lngIncoming Then
        If oldLngOutgoing <> lngOutgoing Then
            If oldLngBlocked <> lngBlocked Then
'BLOCK OUT
                Set frmMain.SysTray.TrayIcon = frmMain.ilTray.ListImages(3).ExtractIcon
            End If
        End If
    End If
    If oldLngIncoming <> lngIncoming Then
        If oldLngOutgoing = lngOutgoing Then
            If oldLngBlocked <> lngBlocked Then
'BLOCK IN
                Set frmMain.SysTray.TrayIcon = frmMain.ilTray.ListImages(4).ExtractIcon
            End If
        End If
    End If
    If oldLngIncoming = lngIncoming Then
        If oldLngOutgoing <> lngOutgoing Then
            If oldLngBlocked = lngBlocked Then
'ALLOW OUT
                Set frmMain.SysTray.TrayIcon = frmMain.ilTray.ListImages(6).ExtractIcon
            End If
        End If
    End If
    If oldLngIncoming <> lngIncoming Then
        If oldLngOutgoing = lngOutgoing Then
            If oldLngBlocked = lngBlocked Then
'ALLOW IN
                Set frmMain.SysTray.TrayIcon = frmMain.ilTray.ListImages(7).ExtractIcon
            End If
        End If
    End If
' update Count
    With frmMain
        .lblIncoming = lngIncoming
        .lblOutgoing = lngOutgoing
        .lblBlocked = lngBlocked
        If .lblIncoming < 0 Then
            .lblIncoming = 0
        End If
        If .lblOutgoing < 0 Then
            .lblOutgoing = 0
        End If
        If .lblBlocked < 0 Then
            .lblBlocked = 0
        End If
'///////// Step 4 - Fill up Listview \\\\\\\\\\'
'(Only if visible)
    End With 'frmMain
    If Not Refresh Then
        If Not force Then
            If frmMain.Check1.Value = 0 Then
                Exit Sub
            End If
        End If
    End If
    cINIFile.Path = (App.Path & "\Firewall.dat")
' Use this to keep CPU useage low as possible to allow firewall to run properly
    If frmMain.Visible And frmMain.Check1.Value = 1 Then
        On Error Resume Next
        With frmMain
            .lvFirewall.ListItems.Clear
        End With 'frmMain
        pb = 0
        pb = StatsLen
        With frmMain
            .ProgressBar1.Max = pb  ' Get Max
            .ProgressBar1.Value = 0 ' Reset to 0
            .ProgressBar1.Visible = True ' Show Progess Bar
        End With 'frmMain
        On Error GoTo 0
        On Error Resume Next
        For i = 0 To StatsLen
            DoEvents
            If LenB(Connection(i).Filename) Then
                Set Item = frmMain.lvFirewall.ListItems.Add()
                Item.Text = mdlFile.GetFileDescription(Connection(i).Filename)
                If LenB(Item.Text) = 0 Then
                    Item.Text = "(No Application Name)"
                End If
                With Item
                    .SubItems(1) = mdlFile.GetFileVersion(Connection(i).Filename)
                    .SubItems(2) = Connection(i).Filename
                    .SubItems(3) = Connection(i).LocalPort
                    .SubItems(4) = Connection(i).LocalHost
                    .SubItems(5) = Connection(i).RemotePort
                    .SubItems(6) = Connection(i).RemoteHost
                    .Tag = i
                End With 'Item
                On Error GoTo 0
                On Error Resume Next
'Now get the rule for it
                With cINIFile
                    .Section = "RULES"
                    .Key = Connection(i).Filename
                    .Default = 0
                    Select Case .Value
                    Case "0", "" 'Ask
                        Item.SmallIcon = 1
                    Case "1" 'Block
                        Item.SmallIcon = 2
                        CloseConnection i, Connection(i).ProcessName
                    Case "2" 'Trust
                        Item.SmallIcon = 3
                    Case "3" 'Kill
                        KillProcessById Connection(i).ProcessID
                        frmMain.lvFirewall.ListItems.Remove Item.Index
                    End Select
                End With 'cINIFile
            End If
            frmMain.ProgressBar1.Value = frmMain.ProgressBar1.Value + 1
        Next i
    End If
' Remove Duplicates
    intCnt = 0
    On Error Resume Next
    Do While intCnt <= frmMain.lvFirewall.ListItems.Count - 1
        intCnt = intCnt + 1
        'Save the text that was in the listvew index
        strTemp = frmMain.lvFirewall.ListItems.Item(intCnt).Text
        On Error GoTo 0
        Do
            On Error Resume Next
            frmMain.lvFirewall.ListItems.Item(intCnt).Text = vbNullString
            'Remove the text inside the specific index
            'Use the FindItem() call to search for the specific item
            Set lRet = frmMain.lvFirewall.FindItem(strTemp, lvwText, lvwPartial)
            'If the item is found, then it is a duplicate and is removed
            If Not lRet Is Nothing Then
                frmMain.lvFirewall.ListItems.Remove (lRet.Index)
            End If
        Loop While Not lRet Is Nothing 'If no item is found the loop is exited
        frmMain.lvFirewall.ListItems.Item(intCnt).Text = strTemp
        'reset the listitem index text back To what it was, and Then continue
        DoEvents
        'Added To ensure that the application does Not lock up when
        'doing large amounts of data.
        On Error GoTo 0
    Loop
    With frmMain
        .Check1.Value = 0
    End With 'frmMain
End Sub
Public Sub Parse()
Dim i As Long

    frmMain.tmrRefreshList.Enabled = False
    With frmMain.lsvListView2
        For i = 1 To .ListItems.Count
            Connection(i).Protocal = .ListItems(i).Text 'tmp
            Connection(i).LocalHost = .ListItems(i).SubItems(1) 'tmp1
            Connection(i).LocalPort = .ListItems(i).SubItems(2)
            Connection(i).RemoteHost = .ListItems(i).SubItems(3)
            Connection(i).RemotePort = .ListItems(i).SubItems(5)
            Connection(i).State = .ListItems(i).SubItems(6)
            Connection(i).ProcessID = .ListItems(i).SubItems(7)
            Connection(i).ProcessName = .ListItems(i).SubItems(8)
            Connection(i).Filename = .ListItems(i).SubItems(9)
            With Connection(i)
                LocP = .LocalPort
                RemH = .RemoteHost
            End With 'Connection(i)
'Crc32Check (Connection(i).Filename)
            DoEvents
        Next i
    End With
    StatsLen = i
    frmMain.tmrRefreshList.Enabled = True
End Sub
Public Function Refresh(Optional ByVal force As Boolean = False) As Boolean
Dim NewCnt As Long
    GetTcpTable tcpt, Len(MIB_TCPTABLE), 0
    NewCnt = tcpt.dwNumEntries
    If NewCnt <> OldCnt Or force Then
        Refresh = True
        OldCnt = NewCnt
    End If
End Function
Public Function Trusted(RemoteHost As String) As Boolean
' Check allow all is checked or not
    cINIFile.Section = "ALLOWALL"
    cINIFile.Key = "AD"
    cINIFile.Default = "-"
    If cINIFile.Value = "YES" Then
        Trusted = True ' Trust all is true so exit
    Else ' Trust all is false so check rules for it
        If cINIFile.Value = "NO" Then
            Trusted = False
        End If
        cINIFile.Section = "NETWORKING"
        cINIFile.Default = "-"
        cINIFile.Key = RemoteHost
        If cINIFile.Value = "0" Then
            Trusted = True
        End If
    End If
End Function
Public Function TrustedPort(LocalPort As String) As Boolean
' Check allow all is checked or not
    cINIFile.Section = "ALLOWALL"
    cINIFile.Key = "ADP"
    cINIFile.Default = "-"
    If cINIFile.Value = "YES" Then
        TrustedPort = True ' Trust all is true so exit
    Else ' Trust all is false so check rules for it
        If cINIFile.Value = "NO" Then
            TrustedPort = False
        End If
        cINIFile.Section = "NETWORKING"
        cINIFile.Default = "-"
        cINIFile.Key = LocalPort
        If cINIFile.Value = "0" Then
            TrustedPort = True
        End If
    End If
End Function
''
''Public Sub Crc32Check(ByVal Filename As String)
''
''
''
''cINIFile.Section = "ALLOWALL"
''cINIFile.Key = "NC"
''If cINIFile.Value = "NO" Then
''Exit Sub ' Rule Set Not Prompt user if file has changed
''
''
''
''
''Else ' Lets check for any changes
''
''End If
''If LenB(Filename) Then
''
''' Still working on this part.....
''' Auto update file change & backup
'''frmMainFileCheck.lvAddItem Filename
''End If
''End Sub
''