www.pudn.com > ownfirewall > Protect.frm
VERSION 5.00
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Protect
Caption = "System Protection"
ClientHeight = 5040
ClientLeft = 60
ClientTop = 420
ClientWidth = 9480
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 5040
ScaleWidth = 9480
StartUpPosition = 2 'CenterScreen
Begin VB.Timer Timer1
Interval = 500
Left = 9600
Top = 1080
End
Begin VB.ListBox LogWnd
BackColor = &H00000000&
ForeColor = &H0000FF00&
Height = 645
ItemData = "Protect.frx":0000
Left = 0
List = "Protect.frx":0002
TabIndex = 15
Top = 4120
Width = 9495
End
Begin VB.PictureBox PixSmall
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 240
Left = 9480
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 14
Top = 720
Visible = 0 'False
Width = 240
End
Begin VB.PictureBox PixDummy
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 240
Left = 9480
Picture = "Protect.frx":0004
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 13
Top = 360
Visible = 0 'False
Width = 240
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 360
Left = 0
TabIndex = 9
Top = 0
Width = 9480
_ExtentX = 16722
_ExtentY = 635
ButtonWidth = 609
ButtonHeight = 582
AllowCustomize = 0 'False
Wrappable = 0 'False
Appearance = 1
Style = 1
ImageList = "Images"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 11
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "Quit"
Description = "Quit"
Object.ToolTipText = "Quit"
ImageIndex = 11
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "Refresh"
Description = "Refresh"
Object.ToolTipText = "Refresh"
ImageIndex = 14
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "Resolveoff"
Description = "Resolveoff"
Object.ToolTipText = "Resolve Address is Off"
ImageIndex = 3
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "Resolveon"
Description = "Resolveon"
Object.ToolTipText = "Resolve Address is On"
ImageIndex = 4
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "Connected0"
Description = "Connected0"
Object.ToolTipText = "Show All Connections"
ImageIndex = 6
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "Connected1"
Description = "Connected1"
Object.ToolTipText = "Show Connected Only"
ImageIndex = 7
EndProperty
BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "Help"
Description = "Help"
Object.ToolTipText = "Help"
ImageIndex = 9
EndProperty
BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.Visible = 0 'False
Style = 3
EndProperty
BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.Visible = 0 'False
Description = "Print"
Object.ToolTipText = "Print"
ImageIndex = 12
BeginProperty ButtonMenus {66833FEC-8583-11D1-B16A-00C0F0283628}
NumButtonMenus = 1
BeginProperty ButtonMenu1 {66833FEE-8583-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
EndProperty
EndProperty
Begin VB.PictureBox Picture1
Height = 0
Left = 0
ScaleHeight = 0
ScaleWidth = 0
TabIndex = 10
Top = 0
Width = 0
End
End
Begin MSComctlLib.ImageList Images
Left = 9480
Top = 2760
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 14
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Protect.frx":058E
Key = "Proc"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Protect.frx":0B2A
Key = "Audio"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Protect.frx":0F7E
Key = "Connect0"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Protect.frx":129A
Key = "Connect1"
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Protect.frx":15B6
Key = "Watch"
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Protect.frx":1A0A
Key = "Lightoff"
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Protect.frx":1E5E
Key = "Lighton"
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Protect.frx":22B2
Key = "Kill"
EndProperty
BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Protect.frx":2706
Key = "Help"
EndProperty
BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Protect.frx":2E5A
Key = "About"
EndProperty
BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Protect.frx":32AE
Key = "Exit"
EndProperty
BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Protect.frx":3702
Key = "Print"
EndProperty
BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Protect.frx":3816
Key = "Reg"
EndProperty
BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Protect.frx":3972
Key = "Refresh"
EndProperty
EndProperty
End
Begin MSComctlLib.StatusBar SBar
Align = 2 'Align Bottom
Height = 255
Left = 0
TabIndex = 4
Top = 4785
Width = 9480
_ExtentX = 16722
_ExtentY = 450
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 3
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Alignment = 1
Object.Width = 12700
MinWidth = 12700
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
Object.Width = 1587
MinWidth = 1587
TextSave = "8:47 PM"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
Alignment = 1
Object.Width = 1940
MinWidth = 1940
TextSave = "5/28/00"
EndProperty
EndProperty
End
Begin TabDlg.SSTab SSTab1
Height = 3740
Left = 0
TabIndex = 0
Top = 360
Width = 9495
_ExtentX = 16748
_ExtentY = 6588
_Version = 393216
Tabs = 4
Tab = 2
TabsPerRow = 4
TabHeight = 520
TabCaption(0) = "NetStat"
TabPicture(0) = "Protect.frx":4386
Tab(0).ControlEnabled= 0 'False
Tab(0).Control(0)= "NSview"
Tab(0).ControlCount= 1
TabCaption(1) = "Registry"
TabPicture(1) = "Protect.frx":43A2
Tab(1).ControlEnabled= 0 'False
Tab(1).Control(0)= "RegView"
Tab(1).ControlCount= 1
TabCaption(2) = "Processes"
TabPicture(2) = "Protect.frx":43BE
Tab(2).ControlEnabled= -1 'True
Tab(2).Control(0)= "ProcView"
Tab(2).Control(0).Enabled= 0 'False
Tab(2).ControlCount= 1
TabCaption(3) = "Port Scan/Watch"
TabPicture(3) = "Protect.frx":43DA
Tab(3).ControlEnabled= 0 'False
Tab(3).Control(0)= "Frame3"
Tab(3).Control(1)= "Frame1"
Tab(3).Control(2)= "Frame2"
Tab(3).Control(3)= "Frame4"
Tab(3).ControlCount= 4
Begin VB.Frame Frame4
Caption = "Port Close Alert"
Height = 640
Left = -69360
TabIndex = 20
Top = 1800
Width = 3255
Begin VB.CheckBox PortCloseChk
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 250
Left = 120
TabIndex = 23
Top = 240
Value = 1 'Checked
Width = 255
End
Begin VB.TextBox PortCloseTxt
Height = 285
Left = 360
TabIndex = 22
Top = 240
Width = 2295
End
Begin VB.CommandButton PortCloseTst
Height = 350
Left = 2760
MaskColor = &H00E0E0E0&
Picture = "Protect.frx":43F6
Style = 1 'Graphical
TabIndex = 21
Top = 220
Width = 375
End
End
Begin VB.Frame Frame2
Caption = "Port Open Alert"
Height = 640
Left = -69360
TabIndex = 16
Top = 1080
Width = 3255
Begin VB.CheckBox PortOpenChk
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 250
Left = 120
TabIndex = 19
Top = 240
Value = 1 'Checked
Width = 255
End
Begin VB.TextBox PortOpenTxt
Height = 285
Left = 360
TabIndex = 18
Top = 240
Width = 2295
End
Begin VB.CommandButton PortOpenTst
Height = 350
Left = 2760
MaskColor = &H00E0E0E0&
Picture = "Protect.frx":4AE0
Style = 1 'Graphical
TabIndex = 17
Top = 220
Width = 375
End
End
Begin VB.Frame Frame1
Caption = "Port Info"
Height = 3255
Left = -74880
TabIndex = 11
Top = 360
Width = 5415
Begin MSComctlLib.ListView PSWView
Height = 2925
Left = 120
TabIndex = 12
Top = 240
Width = 5175
_ExtentX = 9128
_ExtentY = 5159
View = 3
LabelEdit = 1
Sorted = -1 'True
LabelWrap = 0 'False
HideSelection = -1 'True
Checkboxes = -1 'True
_Version = 393217
SmallIcons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 3
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "Name"
Object.Width = 5292
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "Port"
Object.Width = 1411
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 2
Text = "Hits"
Object.Width = 1411
EndProperty
End
End
Begin VB.Frame Frame3
Caption = "Connection Alert"
Height = 640
Left = -69360
TabIndex = 5
Top = 360
Width = 3255
Begin VB.CommandButton ConnectionTst
Height = 350
Left = 2760
MaskColor = &H00E0E0E0&
Picture = "Protect.frx":51CA
Style = 1 'Graphical
TabIndex = 8
Top = 220
Width = 375
End
Begin VB.TextBox ConnectionTxt
Height = 285
Left = 360
TabIndex = 7
Top = 240
Width = 2295
End
Begin VB.CheckBox ConnectionChk
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 250
Left = 120
TabIndex = 6
Top = 240
Value = 1 'Checked
Width = 255
End
End
Begin MSComctlLib.ListView NSview
Height = 3355
Left = -74940
TabIndex = 1
Top = 340
Width = 9380
_ExtentX = 16536
_ExtentY = 5900
View = 3
LabelWrap = 0 'False
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 4
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "Protocol"
Object.Width = 1411
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "Local Address:port"
Object.Width = 6174
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "Remote Address:port"
Object.Width = 6174
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "State"
Object.Width = 2469
EndProperty
End
Begin MSComctlLib.ListView RegView
Height = 3355
Left = -74940
TabIndex = 2
Top = 340
Width = 9380
_ExtentX = 16536
_ExtentY = 5900
View = 3
LabelEdit = 1
LabelWrap = 0 'False
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 3
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "Key"
Object.Width = 3739
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "Name"
Object.Width = 4410
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "Value"
Object.Width = 10583
EndProperty
End
Begin MSComctlLib.ListView ProcView
Height = 3355
Left = 60
TabIndex = 3
Top = 340
Width = 9380
_ExtentX = 16536
_ExtentY = 5900
View = 3
LabelEdit = 1
LabelWrap = 0 'False
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
SmallIcons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 6
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "Process"
Object.Width = 2999
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "Version"
Object.Width = 1835
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "Company Name"
Object.Width = 3175
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "Internal Name"
Object.Width = 2117
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 4
Text = "Product Name"
Object.Width = 3175
EndProperty
BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 5
Text = "Copyright Info"
Object.Width = 3175
EndProperty
End
End
Begin MSComctlLib.ImageList ImageList1
Left = 9480
Top = 3360
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 1
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Protect.frx":58B4
Key = ""
EndProperty
EndProperty
End
Begin VB.Menu m_procoptions
Caption = "Options"
Visible = 0 'False
Begin VB.Menu m_KillProc
Caption = "Kill Process"
End
Begin VB.Menu sbar0
Caption = "-"
End
Begin VB.Menu mProcinfo
Caption = "Process Info"
End
End
Begin VB.Menu m_regoptions
Caption = "Options"
Visible = 0 'False
Begin VB.Menu m_RegRemove
Caption = "Remove Entry"
End
End
End
Attribute VB_Name = "Protect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Const WM_SETREDRAW = &HB
Private Const PORTNAMELEN = 256
Dim CurrTab As Integer
Dim ClickedItem As Integer
Dim Mouse_Btn As Integer
Dim DOSExeIconLoaded As Boolean
Dim ResolveAddr As Boolean
Dim ShowConnect As Boolean
Private Sub Form_Load()
Dim P As Integer
Resolve_On False
Connected_On True ' Show Connected is On
PortCloseWv = "cymbal.wav"
PortOpenWv = "boing2.wav"
ConnectionWv = "Augah.wav"
PortCloseTxt = PortCloseWv
PortOpenTxt = PortOpenWv
ConnectionTxt = ConnectionWv
Init_Psw
OldPwProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf PWatch_Proc)
vbWSAStartup
'begins watch mode on ports
For P = 1 To PSW.Cnt
PSW.No(P).WPort = ListenForConnect(PSW.No(P).Port, hwnd)
Next
'vbWSAStartup
InitStates
CurrTab = 1
SSTab1.Tab = 0
RefreshNS
End Sub
Private Sub Form_Terminate()
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
SetWindowLong hwnd, GWL_WNDPROC, OldPwProc
vbWSACleanup
End Sub
Private Sub PSWView_ItemCheck(ByVal Item As MSComctlLib.ListItem)
Dim B As Boolean, x As Integer
x = Item.Tag
B = Item.Checked
End Sub
Private Sub pswView_Mousedown(Button As Integer, Shift As Integer, x As Single, y As Single)
Mouse_Btn = Button
Debug.Print "Mouse_Btn = "; Button
End Sub
Private Sub PSWView_ItemClick(ByVal Item As MSComctlLib.ListItem)
ClickedItem = Val(Item.Tag)
Debug.Print "PSWItemClick:"; ClickedItem
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
Dim Item As ListItem, y As Integer
Debug.Print SSTab1.Caption
ClickedItem = 0
CurrTab = SSTab1.Tab + 1
Select Case CurrTab
Case 1:
Resolve_On False
Connected_On True ' Show Connected is On
Case 2:
Resolve_Disable
Connected_Disable
If MainKeys(1) = "" Then RefreshReg
Case 3:
Resolve_Disable
Connected_Disable
If (Procs(1).th32ProcessID = 0) Then RefreshProc
Case 4:
Resolve_Disable
Connected_Disable
'Init_Psw
PSWView.ListItems.Clear
For y = 1 To (PSW.Cnt)
Set Item = PSWView.ListItems.Add()
Item.Text = PSW.No(y).Name
Item.Tag = y
Item.SubItems(1) = PSW.No(y).Port
Item.SubItems(2) = PSW.No(y).Hits
Next
End Select
End Sub
Private Sub RefreshBtn()
Select Case CurrTab
Case 1
RefreshNS
Case 2
RefreshReg
Case 3
RefreshProc
End Select
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "Refresh"
RefreshBtn
Case "Resolveon"
Resolve_Off True
Case "Resolveoff"
Resolve_On True
Case "Connected0"
Connected_On True
Case "Connected1"
Connected_Off True
Case "Help"
'
Case "Quit"
Unload Me
End Select
End Sub
Sub Resolve_Disable()
ResolveAddr = False
Toolbar1.Buttons.Item(4).Visible = False
Toolbar1.Buttons.Item(5).Visible = False
End Sub
Sub Resolve_Off(ByVal Refresh As Boolean)
ResolveAddr = False
Toolbar1.Buttons.Item(4).Visible = True
Toolbar1.Buttons.Item(5).Visible = False
If (Refresh) Then RefreshNS
End Sub
Sub Resolve_On(ByVal Refresh As Boolean)
ResolveAddr = True
Toolbar1.Buttons.Item(5).Visible = True
Toolbar1.Buttons.Item(4).Visible = False
If (Refresh) Then RefreshNS
End Sub
Sub Connected_Disable()
Toolbar1.Buttons.Item(7).Visible = False
Toolbar1.Buttons.Item(6).Visible = False
End Sub
Sub Connected_On(ByVal Refresh As Boolean)
ShowConnect = True
Toolbar1.Buttons.Item(7).Visible = True
Toolbar1.Buttons.Item(6).Visible = False
If (Refresh) Then RefreshNS
End Sub
Sub Connected_Off(ByVal Refresh As Boolean)
ShowConnect = False
Toolbar1.Buttons.Item(6).Visible = True
Toolbar1.Buttons.Item(7).Visible = False
If (Refresh) Then RefreshNS
End Sub
Private Sub testme()
Dim x As Long, s As String
For x = 0 To 7777
s = vbGetServByPort(x, "tcp")
If (s <> "") Then Debug.Print htons(x), s
Next
End Sub
Private Sub Timer1_Timer()
Test_Tcp
End Sub
Private Sub RefreshNS()
Dim Item As ListItem
Dim ret As Long, x As Long, LTmp As Long
Dim LocA As String, LocP As String
Dim RemA As String, RemP As String
Dim tcpt As MIB_TCPTABLE
Dim udpt As MIB_UDPTABLE
NSview.ListItems.Clear
LTmp = Len(MIB_TCPTABLE)
ret = GetTcpTable(tcpt, LTmp, 1)
'x = SendMessage(NSview.hwnd, WM_SETREDRAW, 1, 1)
For x = 0 To tcpt.dwNumEntries - 1
DoEvents
ret = tcpt.table(x).dwState
If (ResolveAddr) Then
LocA = vbGetHostByAddress(GetAscIP(tcpt.table(x).dwLocalAddr))
RemA = vbGetHostByAddress(GetAscIP(tcpt.table(x).dwRemoteAddr))
Else
LocA = GetAscIP(tcpt.table(x).dwLocalAddr)
RemA = GetAscIP(tcpt.table(x).dwRemoteAddr)
End If
LocP = vbGetServByPort(tcpt.table(x).dwLocalPort, "tcp")
'LocP = Str(ntohs(tcpt.table(x).dwLocalPort))
RemP = Str(ntohs(tcpt.table(x).dwRemotePort))
If ((ret <> 2) And (ShowConnect)) Or (ShowConnect = False) Then
Set Item = NSview.ListItems.Add()
Item.Text = "TCP"
Item.SubItems(1) = LocA & " :" & LocP
If (tcpt.table(x).dwRemoteAddr <> 0) Then
Item.SubItems(2) = RemA & " :" & RemP
Else
Item.SubItems(2) = RemA & " :0"
End If
Item.SubItems(3) = IP_States(ret)
End If
Next x
LTmp = Len(MIB_UDPTABLE)
ret = GetUdpTable(udpt, LTmp, 1)
Debug.Print ret, udpt.dwNumEntries
For x = 0 To udpt.dwNumEntries - 1
DoEvents
If (ResolveAddr) Then
LocA = vbGetHostByAddress(GetAscIP(udpt.table(x).dwLocalAddr))
Else
LocA = GetAscIP(udpt.table(x).dwLocalAddr)
End If
LocP = vbGetServByPort(udpt.table(x).dwLocalPort, "udp")
'LocP = Str(ntohs(udpt.table(x).dwLocalPort))
' ret = udpt.table(x).dwState
If (ShowConnect = False) Then
Set Item = NSview.ListItems.Add()
Item.Text = "UDP"
Item.SubItems(1) = LocA & ":" & LocP
Item.SubItems(2) = "*.*.*.* : *"
Item.SubItems(3) = IP_States(2)
End If
Next x
'x = SendMessage(NSview.hwnd, WM_SETREDRAW, 0, 0)
End Sub
Private Sub RefreshReg()
Dim lrtn As Long, x As Integer, y As Integer
Dim Str1 As String
Dim Item As ListItem
'Str1 = "SOFTWARE\Microsoft\Windows\CurrentVersion\SharedDlls"
LoadKeys
RegView.ListItems.Clear
For x = 1 To 9
lrtn = GetKey(hKeys(x).Class, hKeys(x).Key, MainKeys())
If (lrtn > 0) Then
For y = 1 To Int(lrtn)
Set Item = RegView.ListItems.Add()
If (y = 1) Then
Item.Text = hKeys(x).Name
Else
Item.Text = ""
End If
If MainKeys(y) = "" Then
Item.SubItems(1) = "Empty..."
Else
Item.SubItems(1) = MainKeys(y)
Str1 = QueryValue(hKeys(x).Class, hKeys(x).Key, MainKeys(y))
Item.SubItems(2) = Str1
End If
Next
Set Item = RegView.ListItems.Add()
Else
Set Item = RegView.ListItems.Add()
Item.Text = hKeys(x).Name
Item.SubItems(1) = "Empty..."
Set Item = RegView.ListItems.Add()
End If
Next
End Sub
Private Sub RegView_ItemClick(ByVal Item As MSComctlLib.ListItem)
ClickedItem = Val(Item.Tag)
Debug.Print "RegItemClick:"; Item.Bold = True, ClickedItem
End Sub
Private Sub RegView_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Mouse_Btn = Button
End Sub
Private Sub m_RegRemove_Click()
Dim H As Boolean, lrtn As Long
Dim x As Integer, y As Integer
y = ClickedItem / 10
If (y * 10) > ClickedItem Then y = y - 1
x = ClickedItem - (y * 10)
lrtn = GetKey(hKeys(x).Class, hKeys(x).Key, MainKeys())
H = DeleteValue(hKeys(x).Class, hKeys(x).Key, MainKeys(y))
RefreshReg
End Sub
Private Sub RegView_Click()
If ClickedItem <> 0 Then
If Mouse_Btn = 1 Then
Me.PopupMenu m_regoptions
End If
ClickedItem = 0
End If
End Sub
Private Sub ProcView_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Mouse_Btn = Button
End Sub
Private Sub ProcView_Click()
If ClickedItem <> 0 Then
If Mouse_Btn = 1 Then
Me.PopupMenu m_procoptions
End If
ClickedItem = 0
End If
End Sub
Private Sub ProcView_ItemClick(ByVal Item As MSComctlLib.ListItem)
Debug.Print "ItemClick:"; Item.Bold = True
ClickedItem = Item.Tag
End Sub
Private Sub mProcinfo_Click()
Dim x As Integer
x = ProcView.ListItems.Item(ClickedItem).Tag
Procinfo.PinfoTxt(0) = CLng(Procs(x).th32ProcessID)
Procinfo.PinfoTxt(1) = CLng(Procs(x).th32ModuleID)
Procinfo.PinfoTxt(2) = Procs(x).cntThreads
Procinfo.PinfoTxt(3) = Procs(x).th32DefaultHeapID
Procinfo.PinfoTxt(4) = Procs(x).pcPriClassBase
Procinfo.PinfoTxt(5) = Procs(x).dwFlags
Procinfo.PinfoTxt(6) = Procs(x).szExeFile
Procinfo.Show 1
End Sub
Private Sub m_KillProc_Click()
Dim hProcess As Long, x As Integer
x = ProcView.ListItems.Item(ClickedItem).Tag
hProcess = OpenProcess(&H1F0FFF, 1, Procs(x).th32ProcessID)
TerminateProcess hProcess, 0
ProcView.ListItems.Remove (ClickedItem)
End Sub
Private Sub RefreshProc()
Dim ListImgKey As String
Dim fType As String
Dim hSnapShot As Long, nProcess As Long, lrtn As Long
Dim x As Integer, i As Integer
Dim uProcess As ProcEntry
Dim Item As ListItem
ProcView.ListItems.Clear
'ImageList1.ListImages.Remove
hSnapShot = CreateToolhelpSnapshot(2, 0)
uProcess.dwSize = LenB(uProcess)
nProcess = Process32First(hSnapShot, uProcess)
i = 0
Do While nProcess
Set Item = ProcView.ListItems.Add()
fType = TrimNull(uProcess.szExeFile)
Item.Text = TrimName(fType)
ListImgKey = GetFileIcon(fType)
On Error Resume Next
Item.SmallIcon = ImageList1.ListImages(ListImgKey).Key '"Proc"
x = ProcView.ListItems.Count
ProcView.ListItems.Item(x).Tag = x 'uProcess.th32ProcessID
lrtn = FindFileInfo(uProcess.szExeFile)
i = i + 1
Procs(i).cntThreads = uProcess.cntThreads
Procs(i).cntUsage = uProcess.cntUsage
Procs(i).dwFlags = uProcess.dwFlags
Procs(i).pcPriClassBase = uProcess.pcPriClassBase
Procs(i).szExeFile = uProcess.szExeFile
Procs(i).th32DefaultHeapID = uProcess.th32DefaultHeapID
Procs(i).th32ModuleID = uProcess.th32ModuleID
Procs(i).th32ParentProcessID = uProcess.th32ParentProcessID
Procs(i).th32ProcessID = uProcess.th32ProcessID
ProcView.ListItems.Item(x).ToolTipText = mvarFileDescription
Item.SubItems(1) = mvarProductVersion
'Item.ListSubItems(1).ReportIcon = "Proc"
'Item.ListSubItems(1).Text = "Test"
'Item.SubItems(2) = mvarFileDescription
Item.SubItems(2) = mvarCompanyName
Item.SubItems(3) = mvarInternalName
Item.SubItems(4) = mvarProductName
Item.SubItems(5) = mvarLegalCopyright
'Item.SubItems(7) = mvarFileVersion
'Item.SubItems(8) = mvarOriginalFileName
'Item.SubItems(9) = mvarFileName
nProcess = Process32Next(hSnapShot, uProcess)
Loop
CloseHandle hSnapShot
End Sub
Function TrimName(s As String) As String
Dim s1 As String
Dim x As Integer
x = Len(s)
s1 = ""
Do While (x > 0)
If Mid(s, x, 1) = "\" Then
s1 = Mid(s, x + 1)
Exit Do
End If
x = x - 1
Loop
TrimName = s1
End Function
Function GetNxtWord(ByRef s As String) As String
Dim i As Integer, x As Integer, s1 As String, s2 As String
Do
s1 = s
i = InStr(s1, " ")
If (i > 1) Then
s2 = Left(s1, i - 1)
s = Right(s1, (Len(s1) - i))
If Left(s2, 1) <> " " Then
GetNxtWord = s2
Exit Do
End If
ElseIf (i = 0) Then
GetNxtWord = s1
s = ""
Exit Do
Else
s = Right(s1, (Len(s1) - i))
End If
Loop
End Function
Private Sub showitem(x As Long, Str As String)
Dim lrtn As Long
Dim Str1 As String
LoadKeys
Str1 = QueryValue(hKeys(x).Class, hKeys(x).Key, Str)
End Sub
Private Sub ConnectionTst_Click()
Command1
End Sub
Private Sub PortOpenTst_Click()
Command2
End Sub
Private Sub PortCloseTst_Click()
Command3
End Sub
Function GetHiWord(dw As Long) As Integer
If dw And &H80000000 Then
GetHiWord = (dw \ 65535) - 1
Else
GetHiWord = dw \ 65535
End If
End Function
Private Function vbAddFileItemIcon(hImgSmall&) As Long
Dim r As Long
PixSmall.Picture = LoadPicture()
r& = ImageList_Draw(hImgSmall&, shinfo.iIcon, PixSmall.hDC, 0, 0, ILD_TRANSPARENT)
PixSmall.Picture = PixSmall.Image
vbAddFileItemIcon& = hImgSmall&
End Function
Function GetFileIcon(ByVal fName As String) As String
Dim r As Long
Dim fType As String
Dim hImgSmall As Long
Dim hExeType As Long
On Error Resume Next
hImgSmall = SHGetFileInfo(fName, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
fType = LCase(TrimNull(shinfo.szTypeName))
PixSmall.Picture = LoadPicture()
r = ImageList_Draw(hImgSmall, shinfo.iIcon, PixSmall.hDC, 0, 0, ILD_TRANSPARENT)
PixSmall.Picture = PixSmall.Image
If fType = "application" Or fType = "shortcut" Then
If fType = "application" Then
r = SHGetFileInfo(fName, 0&, shinfo, Len(shinfo), SHGFI_EXETYPE)
hExeType = GetHiWord(r)
End If
If hExeType > 0 Or fType = "shortcut" Then
r = vbAddFileItemIcon(hImgSmall)
fType = TrimName(fName)
Add_ListImags fType
Else: fType = "DOSExeIcon"
If DOSExeIconLoaded = False Then
r = vbAddFileItemIcon(hImgSmall)
Add_ListImags fType
DOSExeIconLoaded = True
End If
End If
Else
Add_ListImags fType
End If
'itmX.SmallIcon = ImageList1.ListImages(ListImgKey).Key
GetFileIcon = fType
End Function
Sub Add_ListImags(ByVal fType As String)
Dim x As Integer, i As Integer, fd As Boolean
x = ImageList1.ListImages.Count
For i = 1 To x
If ImageList1.ListImages.Item(i).Key = fType Then
fd = True
End If
Next i
If Not fd Then ImageList1.ListImages.Add , fType, PixSmall.Picture
End Sub