📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "VB4032-ICMPEcho (Created by Jim Huff)"
ClientHeight = 3765
ClientLeft = 3840
ClientTop = 4035
ClientWidth = 8130
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 3765
ScaleWidth = 8130
Begin VB.TextBox Text6
Height = 315
Left = 2625
TabIndex = 15
Text = "5"
Top = 825
Width = 390
End
Begin VB.CommandButton Command2
Caption = "&Clear View"
Height = 390
Left = 6450
TabIndex = 13
Top = 675
Width = 1590
End
Begin VB.CommandButton Command3
Caption = "&Trace"
Height = 390
Left = 6450
TabIndex = 12
Top = 150
Width = 765
End
Begin VB.TextBox Text5
Height = 315
Left = 4425
TabIndex = 10
Text = "32"
Top = 450
Width = 390
End
Begin VB.TextBox Text4
Alignment = 2 'Center
Height = 315
Left = 4425
MaxLength = 1
TabIndex = 9
Text = "5"
Top = 75
Width = 390
End
Begin VB.TextBox Text3
BeginProperty Font
Name = "Terminal"
Size = 9
Charset = 255
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2490
Left = 75
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 7
Top = 1200
Width = 7965
End
Begin VB.TextBox Text2
Alignment = 2 'Center
Height = 315
Left = 4425
MaxLength = 3
TabIndex = 1
Text = "255"
Top = 825
Width = 390
End
Begin VB.TextBox Text1
Alignment = 2 'Center
Height = 315
Left = 1050
TabIndex = 0
Text = "www.microsoft.com"
Top = 75
Width = 1965
End
Begin VB.CommandButton Command1
Caption = "&Ping"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Left = 7275
TabIndex = 2
Top = 150
Width = 765
End
Begin VB.Label Label7
Alignment = 1 'Right Justify
Caption = "Request T/O (seconds):"
Height = 240
Left = 825
TabIndex = 14
Top = 900
Width = 1740
End
Begin VB.Label Label6
Alignment = 1 'Right Justify
Caption = "# of Chars/Pkt:"
Height = 240
Left = 3150
TabIndex = 11
Top = 525
Width = 1140
End
Begin VB.Label Label5
Alignment = 1 'Right Justify
Caption = "# of Packets:"
Height = 240
Left = 3150
TabIndex = 8
Top = 150
Width = 1140
End
Begin VB.Label Label4
Alignment = 1 'Right Justify
Caption = "TTL:"
Height = 240
Left = 3975
TabIndex = 6
Top = 900
Width = 390
End
Begin VB.Label Label3
Alignment = 2 'Center
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
Height = 315
Left = 1050
TabIndex = 5
Top = 450
Width = 1965
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "IPAddress:"
Height = 255
Left = 150
TabIndex = 4
Top = 525
Width = 870
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Host Name:"
Height = 255
Left = 75
TabIndex = 3
Top = 150
Width = 975
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' WSock32 Variables
Dim iReturn As Long, sLowByte As String, sHighByte As String
Dim sMsg As String, HostLen As Long, Host As String
Dim Hostent As Hostent, PointerToPointer As Long, ListAddress As Long
Dim WSAdata As WSAdata, DotA As Long, DotAddr As String, ListAddr As Long
Dim MaxUDP As Long, MaxSockets As Long, i As Integer
Dim Description As String, Status As String
' ICMP Variables
Dim bReturn As Boolean, hIP As Long
Dim szBuffer As String
Dim Addr As Long
Dim RCode As String
Dim RespondingHost As String
' TRACERT Variables
Dim TraceRT As Boolean
Dim TTL As Integer
' WSock32 Constants
Const WS_VERSION_MAJOR = &H101 \ &H100 And &HFF&
Const WS_VERSION_MINOR = &H101 And &HFF&
Const MIN_SOCKETS_REQD = 0
Sub GetRCode()
If pIPe.Status = 0 Then RCode = "Success"
If pIPe.Status = 11001 Then RCode = "Buffer too Small"
If pIPe.Status = 11002 Then RCode = "Dest Network Not Reachable"
If pIPe.Status = 11003 Then RCode = "Dest Host Not Reachable"
If pIPe.Status = 11004 Then RCode = "Dest Protocol Not Reachable"
If pIPe.Status = 11005 Then RCode = "Dest Port Not Reachable"
If pIPe.Status = 11006 Then RCode = "No Resources Available"
If pIPe.Status = 11007 Then RCode = "Bad Option"
If pIPe.Status = 11008 Then RCode = "Hardware Error"
If pIPe.Status = 11009 Then RCode = "Packet too Big"
If pIPe.Status = 11010 Then RCode = "Rqst Timed Out"
If pIPe.Status = 11011 Then RCode = "Bad Request"
If pIPe.Status = 11012 Then RCode = "Bad Route"
If pIPe.Status = 11013 Then RCode = "TTL Exprd in Transit"
If pIPe.Status = 11014 Then RCode = "TTL Exprd Reassemb"
If pIPe.Status = 11015 Then RCode = "Parameter Problem"
If pIPe.Status = 11016 Then RCode = "Source Quench"
If pIPe.Status = 11017 Then RCode = "Option too Big"
If pIPe.Status = 11018 Then RCode = " Bad Destination"
If pIPe.Status = 11019 Then RCode = "Address Deleted"
If pIPe.Status = 11020 Then RCode = "Spec MTU Change"
If pIPe.Status = 11021 Then RCode = "MTU Change"
If pIPe.Status = 11022 Then RCode = "Unload"
If pIPe.Status = 11050 Then RCode = "General Failure"
RCode = RCode + " (" + CStr(pIPe.Status) + ")"
DoEvents
If TraceRT = False Then
If pIPe.Status = 0 Then
Text3.Text = Text3.Text + " Reply from " + RespondingHost + ": Bytes = " + Trim$(CStr(pIPe.DataSize)) + " RTT = " + Trim$(CStr(pIPe.RoundTripTime)) + "ms TTL = " + Trim$(CStr(pIPe.Options.TTL)) + Chr$(13) + Chr$(10)
Else
Text3.Text = Text3.Text + " Reply from " + RespondingHost + ": " + RCode + Chr$(13) + Chr$(10)
End If
Else
If TTL - 1 < 10 Then Text3.Text = Text3.Text + " Hop # 0" + CStr(TTL - 1) Else Text3.Text = Text3.Text + " Hop # " + CStr(TTL - 1)
Text3.Text = Text3.Text + " " + RespondingHost + Chr$(13) + Chr$(10)
End If
End Sub
Sub vbGetHostByName()
Dim szString As String
Host = Trim$(Text1.Text) ' Set Variable Host to Value in Text1.text
szString = String(64, &H0)
Host = Host + Right$(szString, 64 - Len(Host))
If gethostbyname(Host) = SOCKET_ERROR Then ' If WSock32 error, then tell me about it
sMsg = "Winsock Error" & Str$(WSAGetLastError())
MsgBox sMsg, vbOKOnly, "VB4032-ICMPEcho"
Else
PointerToPointer = gethostbyname(Host) ' Get the pointer to the address of the winsock hostent structure
CopyMemory Hostent.h_name, ByVal _
PointerToPointer, Len(Hostent) ' Copy Winsock structure to the VisualBasic structure
ListAddress = Hostent.h_addr_list ' Get the ListAddress of the Address List
CopyMemory ListAddr, ByVal ListAddress, 4 ' Copy Winsock structure to the VisualBasic structure
CopyMemory IPLong, ByVal ListAddr, 4 ' Get the first list entry from the Address List
CopyMemory Addr, ByVal ListAddr, 4
Label3.Caption = Trim$(CStr(Asc(IPLong.Byte4)) + "." + CStr(Asc(IPLong.Byte3)) _
+ "." + CStr(Asc(IPLong.Byte2)) + "." + CStr(Asc(IPLong.Byte1)))
End If
End Sub
Sub CenterForm()
Form1.Left = (Screen.Width - Form1.ScaleWidth) \ 2
Form1.Top = (Screen.Height - Form1.ScaleHeight) \ 2
End Sub
Sub vbGetHostName()
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -