frmmain.frm

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

      Begin VB.Menu mnuFirewallSep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFirewallAdvRules 
         Caption         =   "监视更改"
      End
   End
   Begin VB.Menu mnuPopTray 
      Caption         =   "PopMenuTray"
      Visible         =   0   'False
      Begin VB.Menu mnuPopTrayAllow_All 
         Caption         =   "全部允许"
      End
      Begin VB.Menu mnuPopTrayNormal 
         Caption         =   "正常"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuPopTrayBlockAll 
         Caption         =   "全部阻止"
      End
      Begin VB.Menu mnuPopTraySep2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuPopTrayCloseThisMenu 
         Caption         =   "关闭当前菜单"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：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
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

Option Explicit
Private username        As String * 30    ' User Loged on windows
Private returns
Private m_objIpHelper   As CIpHelper
Private oOld            As Long
Private oNew            As Long
Private sOld            As Long
Private sNew            As Long
Private svalue          As Long
Private tvalue          As Long
Private Declare Sub InitCommonControls Lib "Comctl32" ()
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, _
                                                                              nSize As Long) As Long

Private Sub CandyButton1_Click(Index As Integer)
    Select Case Index
    Case 0
        mnuSecurityBlock_Click
    Case 1
        mnuSecurityAllow_Click
    Case 2
        mnuSecurityNormal_Click
    Case 3
        mnuToolsApp_Click
    Case 4
        PopupMenu mnuToolsLogs
    Case 5
        mnuToolsOptions_Click
    Case 6
        frmBlockAll.Show
        ontop.MakeTopMost frmBlockAll.hWnd
        SysTray.TrayTip = "OnIt Firewall - 停止保护"
        StatusBar1.Panels(2).Text = "断开网络"
    Case Else
    End Select
End Sub

Private Sub Check1_Click()
    If Check1.Value = 0 Then
        ProgressBar1.Visible = False
    End If
End Sub

Private Sub Form_Initialize()
    InitCommonControls
End Sub

Private Sub Form_Load()
    If App.PrevInstance Then ' If allready started then
        SysTray.InTray = False ' Remove System Tray icon
        End ' and End
    Else
        returns = GetUserName(username, 30)
        username = Left$(username, InStr(username, vbNullChar) - 1)
        With cINIFile
            .Path = App.Path & "\Firewall.dat"
            .Section = "ALREADY"
            .DeleteSection
        End With 'cINIFile
        On Error Resume Next
        With App
            MkDir .Path & "\Logs\"
            MkDir .Path & "\Logs\Traffic"
            MkDir .Path & "\Logs\Security"
        End With 'App
        StatusBar1.Panels(3).Text = Date$
    End If
    conspeed = "1024000"
    Set m_objIpHelper = New CIpHelper
    On Error GoTo 0
    mheap = GetProcessHeap()
    OnRefresh
    StatusBar1.Panels(3).Text = "用户: " & username
    StatusBar1.Panels(4).Text = Date$
    Me.Refresh
    Load frmMainFileCheck ' Start File Check Monitor
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Hide
    Cancel = True
End Sub

Private Sub GetTraffic()
    Dim objInterface2 As CInterfaces
    Dim obJHelper     As CInterfaces
    On Error Resume Next
    Set objInterface2 = New CInterfaces
    With m_objIpHelper
        Set obJHelper = .Interfaces(1)
        oNew = .BytesReceived
        sNew = .BytesSent
    End With 'm_objIpHelper
    svalue = sNew - sOld
    tvalue = oNew - oOld
    ' KilaBytes
    If tvalue Or svalue < 1024 Or tvalue Or svalue = 0 Then
        GoTo around
        tvalue = 0
        svalue = 0
    End If
    'MegaBytes
    If tvalue Or svalue > 1023 Or tvalue Or svalue < 1073741823 Then
        GoTo aroundmb
        tvalue = 0
        svalue = 0
    End If
    'GigaByte
    If tvalue Or svalue > 1073741823 Then
        GoTo aroundgb
        tvalue = 0
        svalue = 0
    End If

    ULtot = ULtot + svalue
    DLtot = DLtot + tvalue
    ULtot = ULtot + svalue
    DLtot = DLtot + tvalue
around:
    Label8.Caption = "下行: " & Round((tvalue / 1024), 1) & " kb/s - 上行: " & Round((svalue / 1024), 1) & " kb/s"
    oOld = oNew
    sOld = sNew
    Exit Sub
aroundmb:
    Label8.Caption = "下行: " & Round((tvalue / 1048576), 1) & " MB/s - 上行: " & Round((svalue / 1048576), 1) & " MB/s"
    oOld = oNew
    sOld = sNew
    Exit Sub
aroundgb:
    Label8.Caption = "下行: " & Round((tvalue / 1073741824), 1) & " TB/s - 上行: " & Round((svalue / 1073741824), 1) & " TB/s"
    oOld = oNew
    sOld = sNew
    On Error GoTo 0
End Sub

Private Sub lvFirewall_MouseDown(Button As Integer, _
                                 Shift As Integer, _
                                 X As Single, _
                                 Y As Single)
    Dim strTemp As String
    On Error Resume Next
    strTemp = lvFirewall.SelectedItem.Text
    mnuFirewall.Tag = lvFirewall.SelectedItem.Index
    If strTemp = "(No Application Name)" Then
        strTemp = Mid$(lvFirewall.SelectedItem.SubItems(2), InStrRev(lvFirewall.SelectedItem.SubItems(2), "\") + 1)
    End If
    If Button = 2 And LenB(strTemp) Then
        PopupMenu mnuFirewall
    End If
    On Error GoTo 0
End Sub

Private Sub mnuFileClose_Click()
    Hide
End Sub

Private Sub mnuFileExit_Click()
' Remove From SysTray
    SysTray.InTray = False
' Delete Temporary Settings for rule not set windows
    With cINIFile
        .Path = App.Path & "\Firewall.dat"
        .Section = "ALREADY"
        .DeleteSection
    End With 'cINIFile
    End
End Sub

Private Sub mnuFirewallAdvRules_Click()
    Dim Filename As String
    Dim idNum    As Long
    idNum = mnuFirewall.Tag
    Filename = lvFirewall.ListItems.Item(idNum).SubItems(2)
    frmMainFileCheck.lvAddItem Filename
End Sub

Private Sub mnuFirewallAsk_Click()
    Dim idNum As Long
    'Add rule to ask this
    idNum = mnuFirewall.Tag
    With cINIFile
        .Section = "RULES"
        .Key = lvFirewall.ListItems.Item(idNum).SubItems(2)
        .Value = "0"
    End With 'cINIFile
    lvFirewall.ListItems(idNum).SmallIcon = 1
End Sub

Private Sub mnuFirewallBlock_Click()
Dim idNum As Long
'Add rule to ask this
    idNum = mnuFirewall.Tag
    cINIFile.Section = "RULES"
    cINIFile.Key = lvFirewall.ListItems.Item(idNum).SubItems(2)
    cINIFile.Value = "1"
    lvFirewall.ListItems(idNum).SmallIcon = 2
End Sub

Private Sub mnuFirewallTerminate_Click()
    Dim idNum As Long
    Dim PID   As Long
    'Add rule to ask this
    idNum = mnuFirewall.Tag
    cINIFile.Section = "RULES"
    cINIFile.Key = lvFirewall.ListItems.Item(idNum).SubItems(2)
    cINIFile.Value = "3"
    PID = lvFirewall.ListItems(idNum).Tag
    KillProcessById Connection(PID).ProcessID
    lvFirewall.ListItems.Remove (idNum)
End Sub

Private Sub mnuFirewallTrust_Click()
    Dim idNum As Long
    'Add rule to ask this
    idNum = mnuFirewall.Tag
    cINIFile.Section = "RULES"
    cINIFile.Key = lvFirewall.ListItems.Item(idNum).SubItems(2)
    cINIFile.Value = "2"
    lvFirewall.ListItems(idNum).SmallIcon = 3
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show
End Sub

Private Sub mnuPopTrayAllow_All_Click()
    mnuSecurityAllow_Click
End Sub

Private Sub mnuPopTrayBlockAll_Click()
    mnuSecurityBlock_Click
End Sub

Private Sub mnuPopTrayNormal_Click()
    mnuSecurityNormal_Click
End Sub

Private Sub mnuSecurityAllow_Click()
    StatusBar1.Panels(2).Text = "全部允许"
    mnuSecurityNormal.Checked = False
    mnuSecurityAllow.Checked = True
    mnuSecurityBlock.Checked = False
    mnuPopTrayAllow_All.Checked = True
    mnuPopTrayBlockAll.Checked = False
    mnuPopTrayNormal.Checked = False
    SysTray.TrayTip = "OnIt Firewall - 全部允许"
End Sub

Private Sub mnuSecurityBlock_Click()
    StatusBar1.Panels(2).Text = "全部阻止"
    mnuSecurityNormal.Checked = False
    mnuSecurityAllow.Checked = False
    mnuSecurityBlock.Checked = True
    mnuPopTrayAllow_All.Checked = False
    mnuPopTrayBlockAll.Checked = True
    mnuPopTrayNormal.Checked = False
    SysTray.TrayTip = "OnIt Firewall - 阻止"
End Sub

Private Sub mnuSecurityNormal_Click()
    StatusBar1.Panels(2).Text = "Normal"
    mnuSecurityNormal.Checked = True
    mnuSecurityAllow.Checked = False
    mnuSecurityBlock.Checked = False
    mnuPopTrayAllow_All.Checked = False
    mnuPopTrayBlockAll.Checked = False
    mnuPopTrayNormal.Checked = True
    SysTray.TrayTip = "OnIt Firewall - 正常"
End Sub

Private Sub mnuToolsApp_Click()
    frmApplications.Show , Me
End Sub

Private Sub mnuToolsDNSLookup_Click()
    ' Removed no point to it.
    'frmDNSLookup.Show , Me
End Sub

Private Sub mnuToolsFileCheck_Click()
    frmMainFileCheck.Show
End Sub

Private Sub mnuToolsLogsSecurity_Click()
    frmLogSecurity.Show , Me
End Sub

Private Sub mnuToolsLogsTraffic_Click()
    frmLogTraffic.Show , Me
End Sub

Private Sub mnuToolsOptions_Click()
    frmOptions.Show , Me
End Sub

Private Sub mnuToolsStart_Click()
    frmAutoStartup.Show
End Sub

Private Sub mnuToolsUpdate_Click()
    OpenWebsite "http://www.strippokerlive.net/onitfirewall/UpdatePro.php?version=" & App.Major & "." & App.Minor & "." & App.Revision & "&proyn=Professional"
End Sub

Private Sub StatusBar1_PanelClick(ByVal Panel As MSComctlLib.Panel)
    Refresh
    If Panel.Index = 3 Then
    End If
End Sub

Private Sub SysTray_MouseDblClick(Button As Integer, _
                                  Id As Long)
    frmMain.Show
End Sub

Private Sub SysTray_MouseDown(Button As Integer, _
                              Id As Long)
    If Button = 2 Then                ' if the mousebutton 2 is pressed (right)
        PopupMenu mnuPopTray         ' then it calls the menu which is hidden to be shown
    End If                          ' at the cordinates of the mousepointer (x,y)
End Sub

Private Sub tmrGetTraffic_Timer()
    Set SysTray.TrayIcon = ilTray.ListImages(1).ExtractIcon
End Sub

Private Sub tmrRefreshList_Timer()
    Dim flags  As Long
    Dim result As Boolean
    On Error Resume Next
    ' Check to see if connected to the internet
    result = InternetGetConnectedState(flags, 0)
    ' If Connected to the Internet Then
    If result Then
        ' Get all Connected processes
        OnRefresh
        ' Execute Firewall Rules
        mdlFirewall.Execute True
        ' Traffic Monitor
        GetTraffic
    End If
    On Error GoTo 0
End Sub