📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "路由追踪器"
ClientHeight = 6645
ClientLeft = 45
ClientTop = 330
ClientWidth = 4485
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6645
ScaleWidth = 4485
StartUpPosition = 2 '屏幕中心
Begin VB.ListBox List1
Height = 3480
Left = 240
TabIndex = 10
Top = 2880
Width = 735
End
Begin VB.TextBox Text4
Height = 3495
Left = 960
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 9
Text = "Form1.frx":030A
Top = 2880
Width = 3255
End
Begin VB.TextBox Text1
Height = 270
Left = 1080
TabIndex = 4
Text = "Text1"
Top = 600
Width = 3135
End
Begin VB.ComboBox Combo1
Height = 300
Left = 1080
TabIndex = 3
Text = "Combo1"
Top = 240
Width = 3135
End
Begin VB.Frame Frame1
Height = 1695
Left = 240
TabIndex = 1
Top = 1080
Width = 2175
Begin VB.TextBox Text3
Height = 270
Left = 1080
TabIndex = 6
Text = "Text3"
Top = 720
Width = 855
End
Begin VB.TextBox Text2
Height = 270
Left = 1080
TabIndex = 5
Text = "Text2"
Top = 360
Width = 855
End
Begin VB.CheckBox Check1
Caption = "使用主机IP地址"
Enabled = 0 'False
Height = 255
Left = 240
TabIndex = 2
Top = 1200
Width = 1695
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "每包字符数"
Height = 180
Left = 120
TabIndex = 8
Top = 720
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "数据包数量"
Height = 180
Left = 120
TabIndex = 7
Top = 360
Width = 900
End
End
Begin VB.CommandButton Command1
Caption = "追踪(&T)"
Height = 495
Left = 2760
TabIndex = 0
Top = 1320
Width = 1215
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "IP地址"
Height = 180
Left = 240
TabIndex = 12
Top = 645
Width = 540
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "追踪目标"
Height = 180
Left = 240
TabIndex = 11
Top = 300
Width = 720
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click()
Command1.Enabled = False
Call TraceRT
Command1.Enabled = True
End Sub
Private Sub Form_Load()
With Combo1
.AddItem "www.mvps.org"
.AddItem "www.gov.on.ca"
.AddItem "www.microsoft.com"
.AddItem "www.yahoo.com"
.ListIndex = 1
End With
Text1.Text = ""
Text4.Text = ""
ReDim TabArray(0 To 3) As Long
TabArray(0) = 30
TabArray(1) = 54
TabArray(2) = 105
TabArray(3) = 182
'设置制表符位置
Call SendMessage(Text4.hwnd, EM_SETTABSTOPS, 0&, ByVal 0&)
Call SendMessage(Text4.hwnd, EM_SETTABSTOPS, 4&, TabArray(0))
Text4.Refresh
End Sub
Private Function TraceRT()
Dim ipo As ICMP_OPTIONS
Dim echo As ICMP_ECHO_REPLY
Dim ttl As Integer
Dim ttlAdjust As Integer
Dim hPort As Long
Dim nChrsPerPacket As Long
Dim dwAddress As Long
Dim sAddress As String
Dim sHostIP As String
Text1.Text = "" '目的地的IP地址
Text2.Text = "1" '强制设置数据包数为1
Text4.Text = "" '清除输出窗口
List1.Clear '只显示结果信息或调试信息
'每包中的字符数可以是32到128之间
If IsNumeric(Text3.Text) Then
If Val(Text3.Text) < 32 Then Text3.Text = "32"
If Val(Text3.Text) > 128 Then Text3.Text = "128"
Else
Text3.Text = "32"
End If
nChrsPerPacket = Val(Text3.Text)
If SocketsInitialize() Then
'返回Combo1中所选的主机的IP地址
sAddress = GetIPFromHostName(Combo1.Text)
'将该地址转换为一个因特网地址，如，209.68.48.118转换后的结果为1982874833
dwAddress = inet_addr(sAddress)
'打开一个因特网文件句柄
hPort = IcmpCreateFile()
If hPort <> 0 Then
'更新文本框中的内容
Text1.Text = sAddress
Text4.Text = "追踪路由器至" + Combo1.Text + ":" & vbCrLf & vbCrLf
For ttl = 1 To 255
'列表框将显示每个TTL信息，
List1.AddItem ttl
ipo.ttl = ttl
'调用API函数，这里有两点要强调一下。
'首先，本调用的返回值是一个“可调整”的变量，如果调用成功，
'则该变量值为0，并增加TTL的值以进行下一次操作。如果返回值是1，
'表示TTL已减去了1，所以当下一次增加TTL计数时，它的值就和传递过来
'时的值相同，这样就会不断地返回超时的路由器，直至完成整个操作。
'例如，TTL = 3且超时，则
' adjust = 1，所以ttl - 1 = 2。这样在下一次计数时
'TTL又被设置为3并尝试下一次操作。
'其次，当函数调用成功，则sHostIP会返回包含被追踪的主机的IP地址信息，
'如果该主机IP地址与目标的IP地址匹配，则结束追踪过程。
ttlAdjust = TraceRTSendEcho(hPort, _
dwAddress, _
nChrsPerPacket, _
sHostIP, _
echo, _
ipo)
ttl = ttl - ttlAdjust
DoEvents
If sHostIP = Text1.Text Then
Text4.Text = Text4.Text & vbCrLf + "路由追踪结束"
Exit For
End If
Next ttl
'关闭ICMP句柄
Call IcmpCloseHandle(hPort)
Else: MsgBox "不能打开Icmp文件句柄", vbOKOnly, "路由追踪程序"
End If 'If hPort
'终止套接字
Call SocketsCleanup
Else: MsgBox "不能初始化Windows套接字", vbOKOnly, "路由追踪程序"
End If 'if SocketsInitialize()
End Function
Private Sub ShowResults(timeToLive As Byte, _
tripTime As Long, _
sHostIP As String)
Dim sTripTime As String
Dim buff As String
Dim tmp As String
Select Case tripTime
Case Is < 10: sTripTime = "<10 ms"
Case Is > 1200: sTripTime = "*"
Case Else: sTripTime = CStr(tripTime) & " ms"
End Select
buff = Text4.Text
'创建一个新接口
tmp = "Hop #" & vbTab & _
CStr(timeToLive) & vbTab & _
sTripTime & vbTab & _
sHostIP & vbCrLf
'更新文本框内容
Text4.Text = buff & tmp
End Sub
Private Function TraceRTSendEcho(hPort As Long, _
dwAddress As Long, _
nChrsPerPacket As Long, _
sHostIP As String, _
echo As ICMP_ECHO_REPLY, _
ipo As ICMP_OPTIONS) As Integer
Dim sData As String
Dim sError As String
Dim sHostName As String
Dim ttl As Integer
'发送数据的缓存
sData = String$(nChrsPerPacket, "a")
If IcmpSendEcho(hPort, _
dwAddress, _
sData, _
Len(sData), _
ipo, _
echo, _
Len(echo) + 8, _
2400) = 1 Then
'返回了应答信息，更新显示内容
sHostIP = GetIPFromAddress(echo.Address)
ShowResults ipo.ttl, echo.RoundTripTime, sHostIP
'设置为0来继续操作
TraceRTSendEcho = 0
Else
'返回了一个超时信息，所以设置返回值为1。TTL值会增加1，以进行对下一个路由器的操作
TraceRTSendEcho = 1
End If
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -