main.frm

很好的教程原代码！

VERSION 5.00
Begin VB.Form Main 
   Caption         =   "Form1"
   ClientHeight    =   4980
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5325
   LinkTopic       =   "Form1"
   ScaleHeight     =   4980
   ScaleWidth      =   5325
   StartUpPosition =   3  '窗口缺省
   Begin VB.ListBox List1 
      Height          =   2940
      Left            =   120
      TabIndex        =   5
      Top             =   1920
      Width           =   4815
   End
   Begin VB.TextBox Text2 
      Height          =   270
      Left            =   120
      TabIndex        =   3
      Text            =   "4"
      Top             =   1320
      Width           =   1935
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   120
      TabIndex        =   1
      Text            =   "169.254.234.151"
      Top             =   600
      Width           =   1995
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Ping"
      Height          =   465
      Left            =   3000
      TabIndex        =   0
      Top             =   480
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "次数"
      Height          =   255
      Left            =   240
      TabIndex        =   4
      Top             =   1080
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   "IP"
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   240
      Width           =   735
   End
End
Attribute VB_Name = "Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Function Ping(szAddress As String, ECHO As ICMP_ECHO_REPLY) As Long
    Dim hPort As Long
    Dim dwAddress As Long
    Dim sDataToSend As String
    Dim iOpt As Long, i As Long
    Dim TryTime As Long
    sDataToSend = "Echo This"
    dwAddress = AddressStringToLong(szAddress)
    Call SocketsInitialize
    hPort = IcmpCreateFile()
    TryTime = Main.Text2.Text
    Main.List1.Clear
    For i = 1 To TryTime
        If IcmpSendEcho(hPort, _
                        dwAddress, _
                        sDataToSend, _
                        Len(sDataToSend), _
                        0, _
                        ECHO, _
                        Len(ECHO), _
                        PING_TIMEOUT) Then
             'the ping succeeded,
             '.Status will be 0
             '.RoundTripTime is the time in ms for
             '               the ping to complete,
             '.Data is the data returned (NULL terminated)
             '.Address is the Ip address that actually replied
             '.DataSize is the size of the string in .Data
            Main.List1.AddItem "Reply From " & Main.Text1 & _
                "： bytes = " & ECHO.DataSize & " times = " & _
                ECHO.RoundTripTime
        Else
            Main.List1.AddItem "Request timed out"
        End If
    Next i
    Call IcmpCloseHandle(hPort)
    Call SocketsCleanup
    Ping = 0
End Function

Private Sub Command1_Click()
    Dim ECHO As ICMP_ECHO_REPLY
    Dim pos As Integer
    'ping an ip address, passing the
    'address and the ECHO structure
    Call Ping(Text1.Text, ECHO)
End Sub