www.pudn.com > firewalforVB.rar > Form1.frm
VERSION 5.00
Begin VB.Form frmAttempt
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 3 'Fixed Dialog
Caption = "警告!"
ClientHeight = 5280
ClientLeft = 45
ClientTop = 435
ClientWidth = 4635
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 352
ScaleMode = 3 'Pixel
ScaleWidth = 309
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Visible = 0 'False
Begin VB.Frame Frame1
BackColor = &H00FFFFFF&
Height = 1905
Left = 60
TabIndex = 8
Top = 1650
Width = 4515
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "本机端口: "
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Index = 2
Left = 45
TabIndex = 11
Top = 120
Width = 3900
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "远程端口: "
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Index = 3
Left = 45
TabIndex = 10
Top = 330
Width = 3900
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "远程主机: "
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Index = 4
Left = 45
TabIndex = 9
Top = 525
Width = 4425
End
End
Begin VB.ComboBox Combo1
Height = 315
Left = 45
TabIndex = 6
Text = "每次都有询问"
Top = 4410
Width = 4545
End
Begin Firewall.UserControl7 UserControl71
Height = 360
Left = 3330
TabIndex = 5
Top = 4785
Width = 1230
_ExtentX = 2170
_ExtentY = 635
Hold_Caption = "继续 "
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 510
Left = 90
ScaleHeight = 34
ScaleMode = 3 'Pixel
ScaleWidth = 36
TabIndex = 2
Top = 930
Width = 540
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "请选择规则:"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 240
Left = 60
TabIndex = 7
Top = 4185
Width = 2490
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "路径: "
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 450
Index = 1
Left = 690
TabIndex = 4
Top = 1155
Width = 3900
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "程序: "
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 0
Left = 690
TabIndex = 3
Top = 945
Width = 2760
End
Begin VB.Label Label2
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "警告!一个未被许可的程序正在尝试连接本机."
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 60
TabIndex = 1
Top = 585
Width = 4470
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "警告!"
BeginProperty Font
Name = "Tahoma"
Size = 14.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 270
TabIndex = 0
Top = 90
Width = 2595
End
End
Attribute VB_Name = "frmAttempt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'
'
'发布日期：05/06/11
'描 述：很专业的个人防火墙
'网 站：http://www.codesky.net
'
'
'****************************************************************************
Public xPath As String
Public xIndex As Integer
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40
Private Declare Sub SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Private Function LoadBmpMenuLines(Legnth As Integer, ColorPallet As String, x As Integer, y As Integer) As Integer
Dim Colors() As String, CurrentRow, CurrentColumn, Count, Rows
Colors = Split(ColorPallet, ",")
Rows = Int(Split(ColorPallet, ",")(0))
For Count = 1 To UBound(Colors)
If CurrentRow > (Rows) Then CurrentRow = 0: CurrentColumn = CurrentColumn + 1
If Colors(Count) <> -1 Then
Me.Line (x + CurrentColumn, y + CurrentRow)-(x + CurrentColumn + Legnth, y + CurrentRow), Colors(Count)
End If
CurrentRow = CurrentRow + 1
Next
LoadBmpMenuLines = CurrentColumn
End Function
Private Sub Form_Load()
Dim Color_Cent As String
Color_Cent = "36,9598839,10480895,10218495,9890559,9562623,9103615,8775679,8381951,7922943,7463679,6939135,6414335,5889791,5299455,4774655,4184319,3659775,3134975,2675710,2150909,1691388,1166331,969210,772088,509430,377588,246003,114417,113903,113389,112875,112361,111847,111333,110818,4342338,5592405"
LoadBmpMenuLines Me.ScaleWidth, Color_Cent, 0, 0
Combo1.AddItem "每次都要询问"
Combo1.AddItem "仅允许一次"
Combo1.AddItem "允许过滤这个程序"
Combo1.AddItem "始终允许这个程序"
UserControl71.SubClassMe
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
UserControl71.UnSubClassMe
FrmMain.CurrentProcessing = Replace(FrmMain.CurrentProcessing, Chr(1) & xPath & Chr(1), "")
ResumeThreads Connection(xIndex).ProcessID
End Sub
Private Sub UserControl71_Clicked()
Select Case Combo1.ListIndex
Case -1
TerminateThisConnection xIndex + 0
Case 0
TerminateThisConnection xIndex + 0
Case 1
''
Case 2
TerminateThisConnection xIndex + 0
FrmMain.AddProgram xPath, 0
Case 3
FrmMain.AddProgram xPath, 1
End Select
FrmMain.UpdatePrograms
UserControl71.UnSubClassMe
FrmMain.CurrentProcessing = Replace(FrmMain.CurrentProcessing, Chr(1) & xPath & Chr(1), "")
ResumeThreads Connection(xIndex).ProcessID
Unload Me
End Sub
Function ShowInfo(ProgramPath As String, intConnection As Integer)
xPath = ProgramPath
xIndex = intConnection
Dim FileNameShort
FileNameShort = Right(ProgramPath, Len(ProgramPath) - InStrRev(ProgramPath, "\"))
Label3(0).Caption = "程序: " & FileNameShort
Label3(1).Caption = "路径: " & ProgramPath
Label3(2).Caption = "本机端口: " & Connection(intConnection).LocalPort
Label3(3).Caption = "远程端口: " & Connection(intConnection).RemotePort
Label3(4).Caption = "远程主机: " & GetIPAddress(Connection(intConnection).RemoteHost) & " (" & FrmMain.iphDNS.CheckDictionary(GetIPAddress(Connection(intConnection).RemoteHost)) & ")"
GetLargeIcon ProgramPath
Me.Visible = True
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End Function
Private Function GetLargeIcon(FileName As String) As Long
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
'大图标
With Pic32
Set .Picture = LoadPicture("")
.AutoRedraw = True
r = ImageList_Draw(hLIcon, ShInfo.iIcon, Picture1.hDC, 0, 0, ILD_TRANSPARENT)
.Refresh
End With
Else
End If
End Function