www.pudn.com > TCP-IP数据库查询.zip > frmMain.frm
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomctl.ocx"
Begin VB.MDIForm frmMain
BackColor = &H80000001&
Caption = "TCP- IP Datalook"
ClientHeight = 3195
ClientLeft = 165
ClientTop = 735
ClientWidth = 6225
Icon = "frmMain.frx":0000
LinkTopic = "MDIForm1"
OLEDropMode = 1 'Manual
StartUpPosition = 3 'Windows Default
Begin VB.PictureBox Picture1
Align = 4 'Align Right
Height = 2265
Left = 3225
ScaleHeight = 2205
ScaleWidth = 2940
TabIndex = 3
Top = 660
Width = 3000
Begin VB.Timer tmrRefresh
Interval = 1000
Left = 1320
Top = 840
End
Begin MSComctlLib.ImageList imlMain
Left = 600
Top = 840
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
UseMaskColor = 0 'False
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 12
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":0CCA
Key = "Closed"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":0DDE
Key = "Listening"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":1232
Key = "SYN Sent"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":154E
Key = "SYN Recieved"
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":186A
Key = "Established"
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":1CBE
Key = "FIN Wait 1"
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":2112
Key = "FIN Wait 2"
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":2566
Key = "Close Wait"
EndProperty
BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":29BA
Key = "Closing"
EndProperty
BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":2E0E
Key = "Last ACK"
EndProperty
BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":3262
Key = "Time Wait"
EndProperty
BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":36B6
Key = "Other"
EndProperty
EndProperty
End
Begin MSComctlLib.ListView lvMain
Height = 7335
Left = 0
TabIndex = 4
Top = 0
Width = 4455
_ExtentX = 7858
_ExtentY = 12938
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = 0 'False
_Version = 393217
Icons = "imlMain"
SmallIcons = "imlMain"
ColHdrIcons = "imlMain"
ForeColor = -2147483640
BackColor = -2147483643
Appearance = 1
NumItems = 2
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Key = "Local"
Text = "Local Port"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Key = "Remote"
Text = "Remote Address"
Object.Width = 3422
EndProperty
End
End
Begin MSComDlg.CommonDialog dlgCommonDialog
Left = 1680
Top = 1200
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSComctlLib.StatusBar sbStatusBar
Align = 2 'Align Bottom
Height = 270
Left = 0
TabIndex = 0
Top = 2925
Width = 6225
_ExtentX = 10980
_ExtentY = 476
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 3
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 5345
Text = "Status"
TextSave = "Status"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
AutoSize = 2
TextSave = "21/07/2001"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
AutoSize = 2
TextSave = "20:36"
EndProperty
EndProperty
End
Begin MSComctlLib.ImageList imlToolbarIcons
Left = 2280
Top = 1080
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483645
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 9
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":3E12
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":412C
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":4446
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":5120
Key = "HostClient"
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":543A
Key = "NewConnection"
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":5754
Key = ""
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":642E
Key = "Save"
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":6748
Key = "Connect"
EndProperty
BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":7422
Key = "Disconnect"
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar tbToolBar
Align = 1 'Align Top
Height = 660
Left = 0
TabIndex = 1
Top = 0
Width = 6225
_ExtentX = 10980
_ExtentY = 1164
ButtonWidth = 1032
ButtonHeight = 1005
AllowCustomize = 0 'False
Wrappable = 0 'False
Appearance = 1
ImageList = "imlToolbarIcons"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 5
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "NewConnection"
Object.ToolTipText = "NewConnection"
ImageIndex = 5
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 4
Object.Width = 100
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "Save"
Object.ToolTipText = "Save Data "
ImageIndex = 7
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 4
Object.Width = 250
EndProperty
EndProperty
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 135
Left = 3240
TabIndex = 2
Top = 1200
Width = 1335
_ExtentX = 2355
_ExtentY = 238
_Version = 393216
Appearance = 1
End
End
Begin VB.Menu mnuFile
Caption = "&File"
Begin VB.Menu mnuFileNew
Caption = "&New"
Shortcut = ^N
End
Begin VB.Menu mnuFileOpen
Caption = "&Open..."
Shortcut = ^O
End
Begin VB.Menu mnuFileBar0
Caption = "-"
End
Begin VB.Menu mnuFileSaveAs
Caption = "Save &As..."
End
Begin VB.Menu mnuFileBar5
Caption = "-"
Visible = 0 'False
End
Begin VB.Menu mnuFileExit
Caption = "E&xit"
End
End
Begin VB.Menu mnuView
Caption = "&View"
Begin VB.Menu mnuViewToolbar
Caption = "&Toolbar"
Checked = -1 'True
End
Begin VB.Menu mnuViewStatusBar
Caption = "Status &Bar"
Checked = -1 'True
End
End
Begin VB.Menu mnuWindow
Caption = "&Window"
WindowList = -1 'True
Begin VB.Menu mnuWindowCascade
Caption = "&Cascade"
End
Begin VB.Menu mnuWindowTileHorizontal
Caption = "Tile &Horizontal"
End
Begin VB.Menu mnuWindowTileVertical
Caption = "Tile &Vertical"
End
Begin VB.Menu mnuWindowArrangeIcons
Caption = "&Arrange Icons"
End
End
Begin VB.Menu mnuHelp
Caption = "&Help"
Begin VB.Menu mnuHelpBar0
Caption = "-"
End
Begin VB.Menu mnuHelpAbout
Caption = "&About "
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=========================================================
'IP-DATALOOK V1.3 Viewing data between Client-Server.
'Created by Peter Verburgh @2001 - July.
'---------------------------------------------------------
'With this program you can see the data between a Client appl
'and the server. (ex Outlook & POP3 server - SMTP server)
'Or you can see other unknown Client - Server Applications
'Like Direct Connect , Java - applets that connect to a server..
'HOWTO:
'You have to let the Client connect to the local ip of your computer
'on the wanted port ex 1201 (??) & there you let this application listen on,
'& let this application connect to Server..
'Example with pop..
'------------------
'Client appl = Outlook. , remote pop account = pop.test.com
'& local host, ip = 129.5.5.5 ,
'So now you have to change in outlook where pop.test.com stands
'the ip of local host 129.5.5.5,
'now in this program you have to listen on that port (local ip) ..port 110,
'because outlook always connect to port 110 (pop)
'and you have to fill in the ip & port where you want to connect.
':=> pop.test.com port 110..
'
'=========================================================
'THE CODE THAT DETECTS the Local port & remote IP-ports i've
'borrowed here on the PSC site called & imported to my program.
'NETSTAT ..............................................
'This code is copyright 2000 Nick Johnson (NETSTAT).
'This code may be reused and modified for non-commercial
'purposes only as long as credit is given to the author
'in the programmes about box and it's documentation.
'If you use this code, please email me at:
'arachnid@mad.scientist.com and let me know what you think
'and what you are doing with it.
'Tnx To Nick Johnson for that part of very nice code !!
'---------------------------------------------------------
'UPDATED: (21-July 2001)
' * Extra button => Clear screen
' * Possibility to capture string from Client or Server Appl
' And replace it in a other string..
' Example if you application (client) sends
' #this is okay#Peter#test & you want to change Peter
' to Dirk .. then it will capture the data & replace it
' to #this is okay#Dirk#test
' * Helpbox
'
'----------------------------------------------------------
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Const EM_UNDO = &HC7
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Private Sub MDIForm_Load()
Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
'setting for the Colors..
IP.RTColorLocaal = vbRed
IP.RTColorRemote = vbBlue
'Disable TextView ..
Settings.EnableTXT = True
Settings.DC_Total = True
End Sub
Private Sub LoadNewDoc()
Static lDocumentCount As Long
Dim frmD As frmDocument
lDocumentCount = lDocumentCount + 1
Set frmD = New frmDocument
'frmD.Caption = "Waiting from input dialogbox."
' frmD.blnDialogShow = True
frmD.Show
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
If Me.WindowState <> vbMinimized Then
SaveSetting App.Title, "Settings", "MainLeft", Me.Left
SaveSetting App.Title, "Settings", "MainTop", Me.Top
SaveSetting App.Title, "Settings", "MainWidth", Me.Width
SaveSetting App.Title, "Settings", "MainHeight", Me.Height
End If
End Sub
Private Sub tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button)
On Error Resume Next
Select Case Button.Key
Case "NewConnection"
IP.DialogInfo = 0
Dialog.Show (vbModal)
While (IP.DialogInfo = 0)
DoEvents
Wend
If IP.DialogInfo = 1 Then
LoadNewDoc
End If
'---------------- SAVE AS ---------------
Case "Save"
mnuFileSaveAs_Click
End Select
End Sub
Private Sub mnuHelpAbout_Click()
MsgBox "Version " & App.Major & "." & App.Minor & "." & App.Revision & vbCrLf & _
"Created by Verburgh Peter"
End Sub
Private Sub mnuHelpSearchForHelpOn_Click()
Dim nRet As Integer
'if there is no helpfile for this project display a message to the user
'you can set the HelpFile for your application in the
'Project Properties dialog
If Len(App.HelpFile) = 0 Then
MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
Else
On Error Resume Next
nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)
If Err Then
MsgBox Err.Description
End If
End If
End Sub
Private Sub mnuHelpContents_Click()
Dim nRet As Integer
'if there is no helpfile for this project display a message to the user
'you can set the HelpFile for your application in the
'Project Properties dialog
If Len(App.HelpFile) = 0 Then
MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
Else
On Error Resume Next
nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)
If Err Then
MsgBox Err.Description
End If
End If
End Sub
Private Sub mnuWindowArrangeIcons_Click()
Me.Arrange vbArrangeIcons
End Sub
Private Sub mnuWindowTileVertical_Click()
Me.Arrange vbTileVertical
End Sub
Private Sub mnuWindowTileHorizontal_Click()
Me.Arrange vbTileHorizontal
End Sub
Private Sub mnuWindowCascade_Click()
Me.Arrange vbCascade
End Sub
Private Sub mnuWindowNewWindow_Click()
LoadNewDoc
End Sub
Private Sub mnuViewWebBrowser_Click()
'ToDo: Add 'mnuViewWebBrowser_Click' code.
MsgBox "Add 'mnuViewWebBrowser_Click' code."
End Sub
Private Sub mnuViewStatusBar_Click()
mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
sbStatusBar.Visible = mnuViewStatusBar.Checked
End Sub
Private Sub mnuViewToolbar_Click()
mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
tbToolBar.Visible = mnuViewToolbar.Checked
End Sub
Private Sub mnuEditPaste_Click()
On Error Resume Next
ActiveForm.rtfText.SelRTF = Clipboard.GetText
End Sub
Private Sub mnuEditCopy_Click()
On Error Resume Next
Clipboard.SetText ActiveForm.rtfText.SelRTF
End Sub
Private Sub mnuEditCut_Click()
On Error Resume Next
Clipboard.SetText ActiveForm.rtfText.SelRTF
ActiveForm.rtfText.SelText = vbNullString
End Sub
Private Sub mnuEditUndo_Click()
'ToDo: Add 'mnuEditUndo_Click' code.
MsgBox "Add 'mnuEditUndo_Click' code."
End Sub
Private Sub mnuFileExit_Click()
'unload the form
Unload Me
End Sub
Private Sub mnuFilePrint_Click()
On Error Resume Next
If ActiveForm Is Nothing Then Exit Sub
With dlgCommonDialog
.DialogTitle = "Print"
.CancelError = True
.Flags = cdlPDReturnDC + cdlPDNoPageNums
If ActiveForm.rtfText.SelLength = 0 Then
.Flags = .Flags + cdlPDAllPages
Else
.Flags = .Flags + cdlPDSelection
End If
.ShowPrinter
If Err <> MSComDlg.cdlCancel Then
ActiveForm.rtfText.SelPrint .hDC
End If
End With
End Sub
Private Sub mnuFilePrintPreview_Click()
'ToDo: Add 'mnuFilePrintPreview_Click' code.
MsgBox "Add 'mnuFilePrintPreview_Click' code."
End Sub
Private Sub mnuFilePageSetup_Click()
On Error Resume Next
With dlgCommonDialog
.DialogTitle = "Page Setup"
.CancelError = True
.ShowPrinter
End With
End Sub
Private Sub mnuFileProperties_Click()
'ToDo: Add 'mnuFileProperties_Click' code.
MsgBox "Add 'mnuFileProperties_Click' code."
End Sub
Private Sub mnuFileSaveAll_Click()
'ToDo: Add 'mnuFileSaveAll_Click' code.
MsgBox "Add 'mnuFileSaveAll_Click' code."
End Sub
Private Sub mnuFileSaveAs_Click()
Dim sFile As String
If ActiveForm Is Nothing Then Exit Sub
With dlgCommonDialog
.DialogTitle = "Save As"
.CancelError = False
'ToDo: set the flags and attributes of the common dialog control
.Filter = "Doc Files- Datalook (*.IPD)|*.IPD"
.ShowSave
If Len(.FileName) = 0 Then
Exit Sub
End If
sFile = .FileName
End With
ActiveForm.Caption = sFile
ActiveForm.RTBox.SaveFile sFile
End Sub
Private Sub mnuFileOpen_Click()
Dim sFile As String
Settings.Fileopen = True
' If ActiveForm Is Nothing Then LoadNewDoc
LoadNewDoc
With dlgCommonDialog
.DialogTitle = "Open"
.CancelError = False
'ToDo: set the flags and attributes of the common dialog control
.Filter = "Doc Files- Datalook (*.IPD)|*.IPD"
.ShowOpen
If Len(.FileName) = 0 Then
Exit Sub
End If
sFile = .FileName
End With
ActiveForm.RTBox.LoadFile sFile
ActiveForm.Caption = sFile
End Sub
Private Sub mnuFileNew_Click()
IP.DialogInfo = 0
Dialog.Show (vbModal)
While (IP.DialogInfo = 0)
DoEvents
Wend
If IP.DialogInfo = 1 Then
LoadNewDoc
End If
End Sub
Private Sub Form_Resize()
Dim a As Integer
lvMain.Width = lvMain.Parent.Width - 100
lvMain.Height = lvMain.Parent.Height - 850
For a = 2 To lvMain.ColumnHeaders.Count
lvMain.ColumnHeaders(a).Width = (frmMain.Width - 100) / (lvMain.ColumnHeaders.Count - 1) - 600
Next a
End Sub
Private Sub mnuContextKill_Click()
ipsMain.RowData(lvMain.SelectedItem.Tag).Kill
End Sub
Private Sub tmrRefresh_Timer()
Dim a As Integer
Dim intLVPtr As Integer
ipsMain.getTCPConnections
'Update routine - if the existing entry is the same as this one, leave it, otherwise overwrite it.
intlvpointer = 0
For a = 0 To ipsMain.RowCount - 1
If ipsMain.RowData(a).State <> TCP_STATE_LISTEN Then
intLVPtr = intLVPtr + 1
'If we are past the bounds of the current array, add a new line
If intLVPtr > lvMain.ListItems.Count Then
lvMain.ListItems.Add , , ipsMain.RowData(a).LocalPort, , ipsMain.RowData(a).StateText
lvMain.ListItems(intLVPtr).ToolTipText = ipsMain.RowData(a).StateText
lvMain.ListItems(lvMain.ListItems.Count).ListSubItems.Add , , ipsMain.RowData(a).RemoteIPString & ":" & ipsMain.RowData(a).RemotePort
'lvMain.ListItems(lvMain.ListItems.Count).ListSubItems.Add , , "Retrieving..."
lvMain.Refresh
'lvMain.ListItems(lvMain.ListItems.Count).ListSubItems(2).Text = iphDNS.AddressToName(ipsMain.RowData(a).RemoteIPString)
lvMain.ListItems(lvMain.ListItems.Count).Tag = a
Else
'We are still in the bounds. If the current
'entry equals the one to insert, just change
'the icon. Otherwise, overwrite it.
If lvMain.ListItems(intLVPtr).Text = ipsMain.RowData(a).LocalPort And lvMain.ListItems(intLVPtr).ListSubItems(1).Text = ipsMain.RowData(a).RemoteIPString & ":" & ipsMain.RowData(a).RemotePort And lvMain.ListItems(intLVPtr).Tag = a Then
'lvMain.ListItems(intLVPtr).SmallIcon = ipsMain.RowData(a).StateText
If lvMain.ListItems(intLVPtr).SmallIcon <> ipsMain.RowData(a).StateText Then
lvMain.ListItems(intLVPtr).SmallIcon = ipsMain.RowData(a).StateText
lvMain.ListItems(intLVPtr).ToolTipText = ipsMain.RowData(a).StateText
End If
Else
'Different, overwrite it.
lvMain.ListItems(intLVPtr).Text = ipsMain.RowData(a).LocalPort
lvMain.ListItems(intLVPtr).ListSubItems(1).Text = ipsMain.RowData(a).RemoteIPString & ":" & ipsMain.RowData(a).RemotePort
' lvMain.ListItems(lvMain.ListItems.Count).ListSubItems(2).Text = "Retrieving..."
lvMain.Refresh
' lvMain.ListItems(lvMain.ListItems.Count).ListSubItems(2).Text = iphDNS.AddressToName(ipsMain.RowData(a).RemoteIPString)
lvMain.ListItems(intLVPtr).Tag = a
lvMain.ListItems(intLVPtr).SmallIcon = ipsMain.RowData(a).StateText
lvMain.ListItems(intLVPtr).ToolTipText = ipsMain.RowData(a).StateText
End If
End If
End If
Next a
'If there are more listitem entries than connections, kill the extra ones.
For a = lvMain.ListItems.Count To intLVPtr + 1 Step -1
lvMain.ListItems.Remove a
Next a
End Sub
Private Sub txtUpdate_Change()
tmrRefresh.Interval = Val(txtUpdate.Text)
End Sub