frmthread.frm

入侵检测是近几年发展起来的新型网络安全策略

            If cGetInputState(QS_ALLEVENTS) <> 0 Then DoEvents
            If MatchSpec(aConnection.sRemoteAddr, FrmMain.lstIPs.ListItems(X).Text) = True Then
                'Using a windows API, we check Regular Expression matching.
                'So 127.0.0.* will work or, *.castlrea.eircom.net etc
                If aConnection.Direction = Incoming And (FrmMain.lstIPs.ListItems(X).ListSubItems(1).Tag = "0" Or FrmMain.lstIPs.ListItems(X).ListSubItems(1).Tag = "1") Then
                    'If Outgoing and we want to block In or Both
                    CloseConnection aConnection.Row 'Close connection using the Row table.
                    KillProcess aConnection.ProcInfo.lProcID  'Kill process using Process ID
                    CheckConnection.sName = sName 'Return exe name or description
                    CheckConnection.bBlocked = True 'Return blocked status.
                    Exit Function
                ElseIf aConnection.Direction = Outgoing And (FrmMain.lstIPs.ListItems(X).ListSubItems(1).Tag = "0" Or FrmMain.lstIPs.ListItems(X).ListSubItems(1).Tag = "2") Then
                    'If Outgoing and we want to block Out or Both
                    CloseConnection aConnection.Row 'Close connection using the Row table.
                    KillProcess aConnection.ProcInfo.lProcID  'Kill process using Process ID
                    CheckConnection.sName = sName 'Return exe name or description
                    CheckConnection.bBlocked = True 'Return blocked status.
                    Exit Function
                End If
            End If
        Next
        For X = 1 To FrmMain.lstPorts.ListItems.Count 'Loop through Ports
            If aConnection.Direction = Incoming Then 'If incoming.
                If FrmMain.lstPorts.ListItems(X).Text = aConnection.lLocalPort Then 'If the port is the local port, on incoming connections both ports are the same anyway.
                    If (FrmMain.lstPorts.ListItems(X).ListSubItems(1).Tag = "0" Or FrmMain.lstPorts.ListItems(X).ListSubItems(1).Tag = "1") Then 'If we want to block In or Both
                        CloseConnection aConnection.Row
                        KillProcess aConnection.ProcInfo.lProcID
                        CheckConnection.sName = sName
                        CheckConnection.bBlocked = True
                        Exit Function
                    End If
                    Exit For
                End If
            Else
                If FrmMain.lstPorts.ListItems(X).Text = aConnection.lLocalPort Or FrmMain.lstPorts.ListItems(X).Text = aConnection.lRemotePort Then 'If local or remote is the port we wanna block.
                    If (FrmMain.lstPorts.ListItems(X).ListSubItems(1).Tag = "0" Or FrmMain.lstPorts.ListItems(X).ListSubItems(1).Tag = "2") Then 'If we want to block Out or Both
                        CloseConnection aConnection.Row
                        KillProcess aConnection.ProcInfo.lProcID
                        CheckConnection.sName = sName
                        CheckConnection.bBlocked = True
                        Exit Function
                    End If
                    Exit For
                End If
            End If
        Next
    End If
    sTmp = aConnection.ProcInfo.sPath  'Get the Process Name
    sShortTmp = GetShortPath(sTmp)
    If Len(sTmp) > 0 Then
        For X = 0 To T_UBound(g_aPrograms) 'Loop through the program names.
            If cGetInputState(QS_ALLEVENTS) <> 0 Then DoEvents
            If StrComp(sTmp, g_aPrograms(X).sLocation, vbTextCompare) = 0 Or StrComp(sShortTmp, g_aPrograms(X).sShortLocation, vbTextCompare) = 0 Then   'If we find location..
                iFound = X
                If aConnection.Direction = Outgoing Then
                    If g_aPrograms(X).iAccess = 1 Then 'If it's not allowed access...
                        CloseConnection aConnection.Row
                        KillProcess aConnection.ProcInfo.lProcID
                        CheckConnection.sName = g_aProgramDescriptions(sTmp)
                        CheckConnection.bBlocked = True
                        Exit Function
                    Else
                        CheckConnection.sName = g_aProgramDescriptions(sTmp)
                        CheckConnection.bBlocked = False
                    End If
                    Exit For
                Else
                    If g_aPrograms(X).iServer = 1 Then  'If it's not allowed access...
                        CloseConnection aConnection.Row
                        KillProcess aConnection.ProcInfo.lProcID
                        CheckConnection.sName = g_aProgramDescriptions(sTmp)
                        CheckConnection.bBlocked = True
                        Exit Function
                    Else
                        CheckConnection.sName = g_aProgramDescriptions(sTmp)
                        CheckConnection.bBlocked = False
                    End If
                    Exit For
                End If
            End If
        Next
        If iFound = -1 Then
            CheckConnection = NewExectuable(aConnection, sName) 'Ask user what to do.
        ElseIf (aConnection.Direction = Outgoing And g_aPrograms(iFound).iAccess = 2) Or (aConnection.Direction = Incoming And g_aPrograms(iFound).iServer = 2) Then
            'If its allowed to move.
            FrmMain.lstPrograms.Icons = FrmMain.ilTray
            If aConnection.Direction = Incoming Then
                FrmMain.lstPrograms.ListItems(FindPrograms(LCase(aConnection.ProcInfo.sPath))).SmallIcon = 11
            Else
                FrmMain.lstPrograms.ListItems(FindPrograms(LCase(aConnection.ProcInfo.sPath))).SmallIcon = 12
            End If
            CheckConnection.bBlocked = False
            CheckConnection.sName = sName
        ElseIf aConnection.bTCP = False And g_aPrograms(iFound).iAccess = 2 Then
            FrmMain.lstPrograms.Icons = FrmMain.ilTray
            If aConnection.Direction = Incoming Then
                FrmMain.lstPrograms.ListItems(FindPrograms(LCase(aConnection.ProcInfo.sPath))).SmallIcon = 11
            Else
                FrmMain.lstPrograms.ListItems(FindPrograms(LCase(aConnection.ProcInfo.sPath))).SmallIcon = 12
            End If
            CheckConnection.bBlocked = False
            CheckConnection.sName = sName
        Else
            CheckConnection = NewExectuable(aConnection, sName, iFound)
        End If
    End If
End Function
Private Function NewExectuable(aConnection As tConnectionType, sName As String, Optional iExists As Integer = -1) As tChecking
    Dim lRet                        As VbMsgBoxResult
    Dim sTmp                        As String
    Dim sPath                       As String
    Dim sProgram                    As tProgram
    Dim iTmp                        As Integer
    Dim frmA                        As New frmAlert
    Dim tmpString                   As String
    Dim Item                        As ListItem
    If aConnection.ProcInfo.lProcID > 0 Then PauseProcess (aConnection.ProcInfo.lProcID)
    Load frmA 'Load Alert Form
    frmA.lblProgram(1).Caption = aConnection.ProcInfo.sPath  'Set Caption of Prog Description
    If aConnection.Direction = Incoming Then 'If incoming...
        If FrmMain.chkName.Value = vbUnchecked Then
            sTmp = NameByAddr(aConnection.sRemoteAddr)
            frmA.lblDESC.Caption = sName & " (" & aConnection.ProcInfo.sPath & ") 允许来自 " & IIf(Len(sTmp) > 0, sTmp, aConnection.sRemoteAddr) & " 在端口 " & CStr(aConnection.lRemotePort) & " .是否允许这个程序连接?"
        Else
            frmA.lblDESC.Caption = sName & " (" & aConnection.ProcInfo.sPath & ") 允许来自 " & aConnection.sRemoteAddr & " 在端口 " & CStr(aConnection.lRemotePort) & " . 是否允许这个程序连接?"
        End If
        frmA.lblDest(0).Caption = "源:"
        frmA.lblDest(1).Caption = IIf(Len(sTmp) > 0, sTmp, aConnection.sRemoteAddr)
        frmA.lblPort(0).Caption = "远程端口:"
        frmA.lblPort(1).Caption = CStr(aConnection.lRemotePort)
        sTmp = PortDetails(CStr(aConnection.lRemotePort), True, IIf(aConnection.bTCP = True, enPortType.TCP, enPortType.UDP))
        frmA.lblPortDesc(0).Caption = "特洛伊信息:"
        If Len(sTmp) > 0 Then
            frmA.lblPortDesc(1).Caption = sTmp
        Else
            frmA.lblPortDesc(1).Caption = "[无可用描述]"
        End If
    Else
        If FrmMain.chkName.Value = vbUnchecked Then
            sTmp = NameByAddr(aConnection.sRemoteAddr)
            frmA.lblDESC.Caption = sName & " (" & aConnection.ProcInfo.sPath & ") 正在重试连接到 " & IIf(Len(sTmp) > 0, sTmp, aConnection.sRemoteAddr) & " 使用端口 " & CStr(aConnection.lRemotePort) & " . 是否允许该程序访问您的网络?"
        Else
            frmA.lblDESC.Caption = sName & " (" & aConnection.ProcInfo.sPath & ") 正在重试连接到 " & aConnection.sRemoteAddr & " 使用端口 " & CStr(aConnection.lRemotePort) & " . 是否允许该程序访问您的网络?"
        End If
        frmA.lblDest(0).Caption = "目标:"
        frmA.lblDest(1).Caption = IIf(Len(sTmp) > 0, sTmp, aConnection.sRemoteAddr)
        frmA.lblPort(0).Caption = "远程端口:"
        frmA.lblPort(1).Caption = CStr(aConnection.lRemotePort)
        sTmp = PortDetails(CStr(aConnection.lRemotePort), False, IIf(aConnection.bTCP = True, enPortType.TCP, enPortType.UDP))
        frmA.lblPortDesc(0).Caption = "服务器信息:"
        If Len(sTmp) > 0 Then
            frmA.lblPortDesc(1).Caption = sTmp
        Else
            frmA.lblPortDesc(1).Caption = "[无可用描述]"
        End If
    End If
    Call FileIconToPicture(aConnection.ProcInfo.sPath, frmA.Pic32, frmA.imgPic) 'Set Icon on the Alert Form
    frmA.Show vbModal, Me 'Show it modaly.
    MakeOntop frmA.hwnd 'Make it ontop
    If frmA.bWhatToDo = True Then 'If we want to allow it.
        If aConnection.Direction = Incoming Then
            If frmA.bRemember = True Then sProgram.iServer = 2 'Set its access.
        Else
            If frmA.bRemember = True Then sProgram.iAccess = 2 'Set its access.
        End If
        UnPauseProcess aConnection.ProcInfo.lProcID  'Unpause the process.
        NewExectuable.bBlocked = False
    Else
        If aConnection.Direction = Incoming Then
            If frmA.bRemember = True Then sProgram.iServer = 1
        Else
            If frmA.bRemember = True Then sProgram.iAccess = 1
        End If
        CloseConnection aConnection.Row
        KillProcess aConnection.ProcInfo.lProcID  'Kill the process.
        NewExectuable.bBlocked = True
    End If
    sProgram.iServer = 0
    sProgram.sLocation = LCase(aConnection.ProcInfo.sPath)
    sProgram.sName = sName
ReFind:
    If iExists = -1 Then
        iTmp = T_UBound(g_aPrograms) + 1
        ReDim Preserve g_aPrograms(iTmp)
    Else
        iTmp = iExists
    End If
    sProgram.iID = iTmp
    g_aPrograms(iTmp) = sProgram
    With sProgram
        sPath = CStr(iTmp + 1)
        sPath = "Software\EliteProdigy\Fire Gate\Programs\" & sPath
        If frmA.bRemember = True Then
            Call REGSaveSetting(vHKEY_LOCAL_MACHINE, sPath, "Name", .sName)
            Call REGSaveSetting(vHKEY_LOCAL_MACHINE, sPath, "Path", .sLocation)
            Call REGSaveSetting(vHKEY_LOCAL_MACHINE, sPath, "Short Path", GetShortPath(.sLocation))
            Call REGSaveSetting(vHKEY_LOCAL_MACHINE, sPath, "ID", CStr(.iID))
            Call REGSaveSetting(vHKEY_LOCAL_MACHINE, sPath, "Access", CStr(.iAccess))
            Call REGSaveSetting(vHKEY_LOCAL_MACHINE, sPath, "Server", CStr(.iServer))
        End If
        If iExists = -1 Then
            g_aProgramDescriptions.Add .sLocation, .sName
            Set Item = FrmMain.lstPrograms.ListItems.Add(, , , , 13)
            Item.ListSubItems.Add , , .sName
            Select Case .iAccess
                Case Is = 0
                    With Item.ListSubItems.Add(, , "询问")
                        .ForeColor = vbMagenta
                        .Bold = True
                    End With
                Case Is = 1
                    With Item.ListSubItems.Add(, , "拒绝")
                        .ForeColor = vbRed
                        .Bold = True
                    End With
                Case Is = 2
                    With Item.ListSubItems.Add(, , "允许")
                        .ForeColor = vbGreen
                        .Bold = True
                    End With
            End Select
            Select Case .iServer
                Case Is = 0
                    With Item.ListSubItems.Add(, , "询问")
                        .ForeColor = vbMagenta
                        .Bold = True
                    End With
                Case Is = 1
                    With Item.ListSubItems.Add(, , "拒绝")
                        .ForeColor = vbRed
                        .Bold = True
                    End With
                Case Is = 2
                    With Item.ListSubItems.Add(, , "允许")
                        .ForeColor = vbGreen
                        .Bold = True
                    End With
            End Select
            Item.key = .sLocation
        Else
            If FindPrograms(LCase(.sLocation)) = -1 Then
                iExists = -1
                GoTo ReFind
            End If
            Set Item = FrmMain.lstPrograms.ListItems(FindPrograms(LCase(.sLocation)))
            Select Case .iAccess
                Case Is = 0
                    Item.ListSubItems(2).Text = "询问"
                    Item.ListSubItems(2).ForeColor = vbMagenta
                Case Is = 1
                    Item.ListSubItems(2).Text = "拒绝"
                    Item.ListSubItems(2).ForeColor = vbRed
                Case Is = 2
                    Item.ListSubItems(2).Text = "允许"
                    Item.ListSubItems(2).ForeColor = vbGreen
            End Select
            Select Case .iServer
                Case Is = 0
                    Item.ListSubItems(3).Text = "询问"
                    Item.ListSubItems(3).ForeColor = vbMagenta
                Case Is = 1
                    Item.ListSubItems(3).Text = "拒绝"
                    Item.ListSubItems(3).ForeColor = vbRed
                Case Is = 2
                    Item.ListSubItems(3).Text = "允许"
                    Item.ListSubItems(3).ForeColor = vbGreen
            End Select
        End If
    End With
    NewExectuable.sName = sName
    Unload frmA
    Set frmA = Nothing
End Function