mdlfirewall.bas

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

Attribute VB_Name = "mdlFirewall"
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：2007/09/20
'描    述：界面清爽VB版高级专业防火墙 Ver 2.0.3
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

'Declare everything
Option Explicit
Private Allow_Logs             As Boolean
Private tcpt                   As MIB_TCPTABLE
Public cINIFile                As New cINI
Public LocP                    As String
Private RemH                   As String
Private DNSName                As String
'Declares for Connection ID
Private Type Connection_
    Filename                       As String
    ProcessID                      As Long
    ProcessName                    As String
    TCPEntryNum                    As Long
    LocalPort                      As String
    RemotePort                     As String
    LocalHost                      As String
    RemoteHost                     As String
    State                          As String
    TCP                            As Boolean
    Protocal                       As String
End Type
Public Connection(2000)        As Connection_
Private OldConnection(2000)    As Connection_
Private StatsLen               As Long
' ----------------------------
' Support Routines
' ----------------------------
Private OldCnt                 As Long
Public ontop                   As New clsOnTop
Public AlertWindows            As String
Public ServiceAlert            As String
' counters
Private lngIncoming            As Long
Private lngOutgoing            As Long
Private lngBlocked             As Long
Private oldLngIncoming         As Long
Private oldLngOutgoing         As Long
Private oldLngBlocked          As Long
Private OldLen                 As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
                                                                       ByVal wMsg As Long, _
                                                                       ByVal wParam As Long, _
                                                                       lParam As Long) As Long

Public Sub Alert(Filename As String, _
                 idNum As Long, _
                 ProcessID As Long)
    Dim frmA          As New frmAlert
    Dim tmpString     As String
    Dim tmpFileName   As String
    Dim tmpFileNamef  As String
    Dim tmpFileDesc   As String
    Dim tmpFileRecomm As String
    Dim Rated         As String
    Dim tmpPort       As String
    Dim tmpPortF      As String
    Dim tmpPortDesc   As String
    If Not LenB(Filename) = 0 Then
        If Already(idNum) Then
        Else
            'If already has an alert window then exit subroutine
            If InStr(1, AlertWindows, "-=" & Filename & "=-") Then
                Exit Sub
            End If
            'Nope so add a alert window
            Refresh
            AlertWindows = AlertWindows & "-=" & Filename & "=-"
            LogSecurity "Low", "Unknown Application """ & Filename & """ attempted access."
            SuspendThreads ProcessID
            tmpString = mdlFile.GetFileDescription(Filename)
            tmpFileName = Mid$(Filename, InStrRev(Filename, "\") + 1)
            If Connection(idNum).LocalHost = Connection(idNum).LocalHost Then
                'INCOMING!
                frmA.lblDESC.Caption = tmpString & " (" & Mid$(Filename, InStrRev(Filename, "\") + 1) & ") 允许一个连接 " & Connection(idNum).RemoteHost & " 使用端口 " & Connection(idNum).RemotePort & " . 是否允许该应用程序访问网络??"
            Else
                frmA.lblDESC.Caption = tmpString & " (" & Mid$(Filename, InStrRev(Filename, "\") + 1) & ") 正在试图连接到 " & Connection(idNum).RemoteHost & " 使用端口 " & Connection(idNum).RemotePort & " . 是否允许该应用程序访问网络?"
            End If
            DNSName = Connection(idNum).RemoteHost
            ' Open the Known processes/applications list and display results
            On Error Resume Next
            Open App.Path & "\Fileinfo.txt" For Input As #1
            tmpFileName = LCase$(tmpFileName)
            Do
                Input #1, tmpFileNamef, tmpFileDesc, tmpFileRecomm, Rated
                If tmpFileNamef = tmpFileName Then
                    frmA.lblAppAdvice.Caption = tmpFileDesc & "  (提醒度: " & Rated & "!)"
                    frmA.lblRecommendation.Caption = tmpFileRecomm
                    tmpFileNamef = vbNullString
                    If Rated = "Safe" Then
                        ' Get allow all rules for known applications
                        cINIFile.Section = "ALLOWALL"
                        cINIFile.Key = "AP"
                        ' If don't show for trusted true then exit dialog
                        If cINIFile.Value = "YES" Then
                            ' Let application resume
                            mdlProcess1.ResumeThreads ProcessID
                            Exit Sub
                        Else  ' Show message box
                        End If
                        With frmA
                            .Check1.Value = 1
                            .picNotSafe(2).Visible = True
                            .picNotSafe(1).Visible = False
                            .picNotSafe(0).Visible = False
                        End With 'frmA
                    End If
                    If Rated = "Not Safe" Then
                        With frmA
                            .Check1.Value = 0
                            .picNotSafe(0).Visible = True
                            .picNotSafe(1).Visible = False
                            .picNotSafe(2).Visible = False
                        End With 'frmA
                    End If
                    If Rated = "Use Caution / Safe" Or Rated = "Use Caution" Then
                        With frmA
                            .Check1.Value = 0
                            .picNotSafe(1).Visible = True
                            .picNotSafe(2).Visible = False
                            .picNotSafe(0).Visible = False
                        End With 'frmA
                    End If
                    GoTo EndLoop
                Else
                    With frmA
                        .lblAppAdvice.Caption = "(未知!)  无法获取当前应用程序的可用信息.      (提示: 使用当心!)"
                        .lblRecommendation.Caption = "(无!) 无法获取当前应用程序和进程的可用信息."
                        .Check1.Value = 0
                        .picNotSafe(1).Visible = True
                        .picNotSafe(2).Visible = False
                        .picNotSafe(0).Visible = False
                    End With 'frmA
                End If
                DoEvents
            Loop Until EOF(1)
EndLoop:
            Close #1
            On Error GoTo 0
            ' Open Common applications for port numbers and display results
            On Error Resume Next
            Open App.Path & "\PortInfo.txt" For Input As #1
            tmpPort = Connection(idNum).RemotePort
            Do
                Input #1, tmpPortF, tmpPortDesc
                If tmpPortF = tmpPort Then
                    frmA.Advice.Caption = tmpPortDesc
                    GoTo EndLoopP
                Else
                    frmA.Advice.Caption = "(未知!) 端口1024至29151之间是已知注册的端口。基本上，程序应该使用这些，同时避免产生端口占用冲突。"
                End If
                DoEvents
            Loop Until EOF(1)
EndLoopP:
            Close #1
            On Error GoTo 0
            With frmA
                .Tag = ProcessID & "," & idNum & "," & Filename
                .Show
                ontop.MakeTopMost .hWnd
            End With 'frmA
        End If
    End If
End Sub
Public Function Already(idNum As Long) As Boolean
    ' Already File Process
    If Connection(idNum).Filename = "Path Unknown" Or Connection(idNum).Filename = "0" Or Connection(idNum).Filename = "CLOSE_WAIT" Or Connection(idNum).Filename = "ESTABLISHED" Or Connection(idNum).Filename = "False" Or Connection(idNum).Filename = "LAST_ACK" Or Connection(idNum).Filename = "SYN_SENT" Or Connection(idNum).Filename = "TIME_WAIT" Or Connection(idNum).Filename = "True" Then
        Already = True
    Else
        cINIFile.Section = "ALREADY"
        cINIFile.Key = Connection(idNum).ProcessID
        cINIFile.Default = "-"
        If cINIFile.Value <> "YES" Then
'Yes this host was never connected to by it
            cINIFile.Value = "YES"
            Already = False
        Else
            Already = True
        End If
    End If
End Function
Public Function AlreadyPort(idNum As Long) As Boolean
' Already RemotePort
If Connection(idNum).RemotePort = "True" Then
        AlreadyPort = True
    Else
        cINIFile.Section = "ALREADY"
        cINIFile.Key = Connection(idNum).RemotePort
        cINIFile.Default = "-"
        If cINIFile.Value <> "YES" Then
'Yes this host was never connected to by it
            cINIFile.Value = "YES"
            AlreadyPort = False
        Else
            AlreadyPort = True
        End If
    End If
End Function
Public Function AlreadyIP(idNum As Long) As Boolean
' Already RemoteHost (IP)
If Connection(idNum).RemoteHost = "True" Then
        AlreadyIP = True
    Else
        cINIFile.Section = "ALREADY"
        cINIFile.Key = Connection(idNum).RemoteHost
        cINIFile.Default = "-"
        If cINIFile.Value <> "YES" Then
'Yes this host was never connected to by it
            cINIFile.Value = "YES"
            AlreadyIP = False
        Else
            AlreadyIP = True
        End If
    End If

End Function
Public Sub CheckForHackers(ByVal RemH As String, _
                           idNum As Long)
' Check Based on IP Address
Dim frmS As New frmServiceAlert
    If Not AlreadyIP(idNum) Then
        If Not Trusted(Connection(idNum).RemoteHost) Then
            If InStr(1, ServiceAlert, ("-=" & RemH & Connection(idNum).RemoteHost & "=-"), vbTextCompare) Then
                Exit Sub
            End If
            ServiceAlert = ServiceAlert & "-=" & RemH & Connection(idNum).RemoteHost & "=-"
            cINIFile.Section = "NETWORKING"
            cINIFile.Key = Connection(idNum).RemoteHost
            cINIFile.Default = "-"
            If cINIFile.Value <> "-" Then
            If RemH = "" Then RemH = "127.0.0.1"
            If Connection(idNum).RemoteHost = "" Then Connection(idNum).RemoteHost = "127.0.0.1"
                LogSecurity "Moderate", "A potentially dangerous Host (IP Address) " & RemH & " allowed a connection from " & Connection(idNum - 1).RemoteHost & ". This host IP is " & cINIFile.Value
                frmS.lblDESC.Caption = "下列远程主机 " & RemH & " 正在尝试使用端口 " & Connection(idNum - 1).RemoteHost & "连接.   防火墙将自动关闭当前连接.  你可以选择是否允许该连接使用当前端口连接到本机."
                CloseConnection idNum, Connection(idNum).Filename
                lngBlocked = lngBlocked + 1
                With frmS
                    .Show
                    .lblDESC.Tag = RemH
                    .Tag = Connection(idNum).RemoteHost
                    ontop.MakeTopMost .hWnd
                End With 'frmS
            End If
        End If
    End If
End Sub
Public Sub CheckForHackersPort(LocP As String, _
                               idNum As Long)
' Check based on Port Number
Dim frmS As New frmServiceAlertPort
    If Not AlreadyPort(idNum) Then
        If Not TrustedPort(Connection(idNum).LocalPort) Then
            If LenB(LocP) = 0 Then
                Exit Sub
            End If
            If InStr(1, ServiceAlert, ("-=" & LocP & Connection(idNum).RemoteHost & "=-"), vbTextCompare) Then
                Exit Sub
            End If
            ServiceAlert = ServiceAlert & "-=" & LocP & Connection(idNum).RemoteHost & "=-"
            cINIFile.Section = "HACKERS"
            cINIFile.Key = LocP
            cINIFile.Default = "-"
            If cINIFile.Value <> "-" Then
                LogSecurity "Moderate", "A potentially dangerous port " & LocP & " allowed a connection from " & Connection(idNum - 1).RemoteHost & ". This port is " & cINIFile.Value
                frmS.lblDESC.Caption = "下列端口 " & LocP & " 已经允许来自远方主机 " & Connection(idNum - 1).RemoteHost & "的连接. 当前端口是" & cINIFile.Value & ". 当前端口是作为服务器进行连接，他可能让黑客控制你的计算机或者激活病毒.防火墙会自动关闭这个连接. 你也可以选择是否允许该连接使用当前端口连接到本机."
                CloseConnection idNum, Connection(idNum).Filename
                lngBlocked = lngBlocked + 1
                With frmS
                    .Show
                    .lblDESC.Tag = LocP
                    .Tag = Connection(idNum).LocalPort
                    ontop.MakeTopMost .hWnd
                End With 'frmS
            End If
        End If
    End If
End Sub
Public Sub CloseConnection(iNum As Long, _
                           ByVal AppName As String)
Dim l As Long
    If AppName = Connection(iNum).Filename Then
        If Allow_Logs Then
            LogTraffic "Blocked", Connection(iNum).Filename & " traffic was blocked. Remote Computer was " & Connection(iNum).RemoteHost & " on port " & Connection(iNum).RemotePort & "."
        End If
        l = Len(MIB_TCPTABLE)
        GetTcpTable tcpt, l, 0
        tcpt.table(iNum).dwState = 12
        SetTcpEntry tcpt.table(iNum)
    End If
End Sub
Public Sub Execute(Optional ByVal force As Boolean = False)
Dim i       As Long
Dim Item    As ListItem
Dim lRet    As ListItem
Dim strTemp As String
Dim intCnt  As Long
Dim pb      As Long
'////////// STEP 1 - New connections? \\\\\\\\\\\'
    If Not Refresh Then
        If Not force Then
            Exit Sub
        End If
    End If
'////////// Step 2.0 - Clear Connections ID \\\\\'
    For i = 0 To StatsLen
        OldConnection(i).Filename = Connection(i).Filename
    Next i
    OldLen = StatsLen
    Erase Connection
'////////// Step 2.1 - Recive the information \\\\\'
    frmMain.tmrRefreshList.Enabled = False
    On Error Resume Next
    Parse
'////////// Step 2.2 - Enable / Disable Traffic Logs \\\\\'
    With cINIFile
        .Section = "ALLOWALL"
        .Key = "AL"
        Allow_Logs = Not .Value = "YES"
'////////// Step 3.1 - List Processes \\\\\\\\\\\'
    End With 'cINIFile
    oldLngIncoming = lngIncoming
    oldLngOutgoing = lngOutgoing
    oldLngBlocked = lngBlocked
    lngIncoming = 0
    lngOutgoing = 0
    lngBlocked = 0
    For i = 0 To StatsLen
'////////// Step 3.2 - View Rules \\\\\\\\\\\'
'Now get the rule for it
        With cINIFile