Este c�digo nos ayudara a realizar Ping a una IP o un Host Name desde nuestra aplicaci�n realizada en VB .NET, usando los Namespaces: System.Net, System.Net.Sockets, System.Runtime.InteropServices y APing (que se realiza en la aplicaci�n).

Abra su Visual Studio .NET, elija nuevo proyecto, En Proyectos de Visual Basic seleccione la plantilla Aplicaci�n para Windows.

Agregue un TextBox y un Bot�n "Button" en el formulario, en el "Button1" coloque la propiedad "Text" de este a: "Aceptar"

Ahora en la parte de c�digo del formulario antes de la l�nea "Public Class Form1"
(Ctrl + C) y Pegue (Ctrl + V)  importamos los NameSpaces que vamos a utilizar:

Imports System.Net
Imports System.Net.Sockets
Imports System.Runtime.InteropServices

Ahora en el evento Clic del "Button1", Copie (Ctrl + C) y Pegue (Ctrl + V) este c�digo:

        Dim Packet As New APing.CPing
        Dim retValue
        Packet.HostName = Trim(TextBox1.Text)
        If Packet.HostName = "" Then
            MsgBox("Introduza una IP (Ejemplo: '127.0.0.1') o un Host Name (Ejemplo: 'www.unsitiox.com')")
        Else
            If Packet.Open Then
                retValue = Packet.Ping
                If retValue <> -1 Then
                    MsgBox("Tiempo de Respuesta Aproximado en milisegundos : " & retValue)
                Else
                    MsgBox("IP o Host Name Inaccesible")
                End If
                Packet.Close()
            End If
        End If

Quedar�a de la siguiente forma:

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim Packet As New APing.CPing
        Dim retValue
        Packet.HostName = Trim(TextBox1.Text)
        If Packet.HostName = "" Then
            MsgBox("Introduza una IP (Ejemplo: '127.0.0.1') o un Host Name (Ejemplo: 'www.unsitio___x.com')")
        Else
            If Packet.Open Then
                retValue = Packet.Ping
                If retValue <> -1 Then
                    MsgBox("Tiempo de Respuesta Aproximado en milisegundos : " & retValue)
                Else
                    MsgBox("IP o Host Name Inaccesible")
                End If
                Packet.Close()
            End If
        End If
    End Sub

Ahora despu�s de End Class Creamos el Namespace APing, Copie (Ctrl + C) y Pegue (Ctrl + V)  este c�digo:
 

Namespace APing
    Structure Angel_Ping
#Region "VARIABLES"
        Dim Data() As Byte
        Dim Type_Message As Byte
        Dim SubCode_type As Byte
        Dim Complement_CheckSum As UInt16
        Dim Identifier As UInt16
        Dim SequenceNumber As UInt16
#End Region
#Region "Metodos"
        Public Sub Initialize(ByVal type As Byte, ByVal subCode As Byte, ByVal payload() As Byte)
            Dim Buffer_IcmpPacket() As Byte
            Dim CksumBuffer() As UInt16
            Dim IcmpHeaderBufferIndex As Int32 = 0
            Dim Index As Integer
            Me.Type_Message = type
            Me.SubCode_type = subCode
            Complement_CheckSum = UInt16.Parse("0")
            Identifier = UInt16.Parse("45")
            SequenceNumber = UInt16.Parse("0")
            Data = payload
            Buffer_IcmpPacket = Serialize()
            ReDim cksumBuffer((Buffer_IcmpPacket.Length() \ 2) - 1)
            For index = 0 To (cksumBuffer.Length() - 1)
                cksumBuffer(Index) = BitConverter.ToUInt16(Buffer_IcmpPacket, icmpHeaderBufferIndex)
                icmpHeaderBufferIndex += 2
            Next index
            Complement_CheckSum = MCheckSum.Calculate(cksumBuffer, cksumBuffer.Length())
        End Sub
        Public Function Size() As Integer
            Return (8 + Data.Length())
        End Function
        Public Function Serialize() As Byte()
            Dim Buffer() As Byte
            Dim B_Seq() As Byte = BitConverter.GetBytes(SequenceNumber)
            Dim B_Cksum() As Byte = BitConverter.GetBytes(Complement_CheckSum)
            Dim B_Id() As Byte = BitConverter.GetBytes(Identifier)
            Dim Index As Int32 = 0
            ReDim Buffer(Size() - 1)
            Buffer(0) = Type_Message
            Buffer(1) = SubCode_type
            Index += 2
            Array.Copy(B_Cksum, 0, Buffer, Index, 2) : Index += 2
            Array.Copy(B_Id, 0, Buffer, Index, 2) : Index += 2
            Array.Copy(B_Seq, 0, Buffer, Index, 2) : Index += 2
            If (Data.Length() > 0) Then Array.Copy(Data, 0, Buffer, Index, Data.Length())
            Return Buffer
        End Function
#End Region
    End Structure
    Public Class CPing
#Region "Contactes"
        Private Const DATA_SIZE As Integer = 32
        Private Const DEFAULT_TIMEOUT As Integer = 1000
        Private Const ICMP_ECHO As Integer = 8
        Private Const SOCKET_ERROR As Integer = -1
        Private Const PING_ERROR As Integer = -1
        Private Const RECV_SIZE As Integer = 128
#End Region
#Region "VARIABLES"
        Private _Open As Boolean = False
        Private _Initialized As Boolean
        Private _RecvBuffer() As Byte
        Private _Packet As Angel_Ping
        Private _HostName As String
        Private _Server As EndPoint
        Private _Local As EndPoint
        Private _Socket As Socket
#End Region
#Region "CONSTRUCTORS & FINALIZER"
        Public Sub New(ByVal hostName As String)
            Me.HostName() = hostName
            ReDim _recvBuffer(RECV_SIZE - 1)
        End Sub
        Public Sub New()
            Me.HostName() = Dns.GetHostName()
            ReDim _recvBuffer(RECV_SIZE - 1)
        End Sub
        Private Overloads Sub finalize()
            Me.Close()
            Erase _recvBuffer
        End Sub
#End Region
#Region "Metodos"
        Public Property HostName() As String
            Get
                Return _hostName
            End Get
            Set(ByVal Value As String)
                _hostName = Value
                If (_open) Then
                    Me.Close()
                    Me.Open()
                End If
            End Set
        End Property
        Public ReadOnly Property IsOpen() As Boolean
            Get
                Return _open
            End Get
        End Property
        Public Function Open() As Boolean
            Dim Payload() As Byte
            If (Not _open) Then
                Try
                    ReDim payload(DATA_SIZE)
                    _packet.Initialize(ICMP_ECHO, 0, payload)
                    _socket = New Socket(AddressFamily.InterNetwork, SocketType.Raw, ProtocolType.Icmp)
                    _server = New IPEndPoint(Dns.GetHostByName(_hostName).AddressList(0), 0)
                    _local = New IPEndPoint(Dns.GetHostByName(Dns.GetHostName()).AddressList(0), 0)
                    _open = True
                Catch
                    Return False
                End Try
            End If
            Return True
        End Function
        Public Function Close() As Boolean
            If (_open) Then
                _socket.Close()
                _socket = Nothing
                _server = Nothing
                _local = Nothing
                _open = False
            End If
            Return True
        End Function
        Public Overloads Function Ping() As Integer
            Return Ping(DEFAULT_TIMEOUT)
        End Function
        Public Overloads Function Ping(ByVal timeOutMilliSeconds As Integer) As Integer
            Dim TimeOut As Integer = timeOutMilliSeconds + Environment.TickCount()
            Try
                If (SOCKET_ERROR = _socket.SendTo(_packet.Serialize(), _packet.Size(), 0, _server)) Then
                    Return PING_ERROR
                End If
            Catch
            End Try
            Do
                If (_socket.Poll(1000, SelectMode.SelectRead)) Then
                    _socket.ReceiveFrom(_recvBuffer, RECV_SIZE, 0, _local)
                    Return (timeOutMilliSeconds - (timeOut - Environment.TickCount()))
                ElseIf (Environment.TickCount() >= timeOut) Then
                    Return PING_ERROR
                End If
            Loop While (True)
        End Function
#End Region
    End Class
    Module MCheckSum
#Region "Metodos"
        <StructLayout(LayoutKind.Explicit)> Structure UNION_INT16
            <FieldOffset(0)> Dim lsb As Byte
            <FieldOffset(1)> Dim msb As Byte
            <FieldOffset(0)> Dim w16 As Short
        End Structure
        <StructLayout(LayoutKind.Explicit)> Structure UNION_INT32
            <FieldOffset(0)> Dim lsw As UNION_INT16
            <FieldOffset(2)> Dim msw As UNION_INT16     '
            <FieldOffset(0)> Dim w32 As Integer
        End Structure
        Public Function Calculate(ByRef buffer() As UInt16, ByVal size As Int32) As UInt16
            Dim Counter As Int32 = 0
            Dim Cksum32 As UNION_INT32
            Do While (size > 0)
                cksum32.w32 += Convert.ToInt32(buffer(counter))
                counter += 1
                size -= 1
            Loop
            cksum32.w32 = cksum32.msw.w16 + cksum32.lsw.w16 + cksum32.msw.w16
            Return Convert.ToUInt16(cksum32.lsw.w16 Xor &HFFFF)
        End Function
#End Region
    End Module
End Namespace
 

        Ahora ejecute su aplicaci�n presionando la Tecla F5, espero que lo disfrut�.

Fichero con el c�digo de ejemplo (ar_PingVBNET.zip - 14.9 KB)