Ping!

[LeeSalter]

Has anybody figured out Ping in vb.Net yet??

Ive looked at some code from another site, but it only seems to work the first time it is run, then comes back as failed every other time, so it cant be trusted.

The code Im on about is posted below:-

Option Strict On 
Option Explicit On 

Imports System.Net 
Imports System.Net.Sockets 

Public Enum ICMPType 
    EchoReply = 0 
    Unreachable = 3 
    Echo = 8 
End Enum 

 --- ICMP Echo Header Format --- 
 (first 8 bytes of the data buffer) 

 Buffer (0) ICMP Type Field 
 Buffer (1) ICMP Code Field 
 (must be 0 for Echo and Echo Reply) 
 Buffer (2) checksum hi 
 (must be 0 before checksum calc) 
 Buffer (3) checksum lo 
 (must be 0 before checksum calc) 
 Buffer (4) ID hi 
 Buffer (5) ID lo 
 Buffer (6) sequence hi 
 Buffer (7) sequence lo 
 Buffer (8)..(n) Ping Data 

Module net 
    Private Const portICMP As Integer = 7 
    Private Const bufferHeaderSize As Integer = 8 
    Private Const packageHeaderSize As Integer = 28 

    Public Sub Echo(ByVal RemoteName As String, ByVal DataSize As Byte, ByVal pStatus As Label) 
        for timing 
        Dim intStart As Integer 
        for timing 
        Dim intEnd As Integer 
        address/port of remote host 
        Dim RemoteHost As IPEndPoint 
        Dim rhEP As EndPoint 
        id of this packet 
        Dim Identifier As Short = 0 
        sequence number of this packet 
        Dim Sequence As Short = 0 
        the socket we use to connect and 
        send data through 
        Dim ICMPSocket As Socket 
        the request buffer 
        Dim RequestBuffer() As Byte 
        the reply buffer 
        Dim ReplyBuffer(255) As Byte 
        the number of bytes received 
        Dim RecvSize As Integer = 0 

        RemoteHost = GetRemoteEndpoint(RemoteName) 
        rhEP = CType(RemoteHost, System.Net.EndPoint) 

        DataSize = Convert.ToByte(DataSize + bufferHeaderSize) 
         If odd data size, we need to add 
         one empty byte 
        If (DataSize Mod 2 = 1) Then 
            DataSize += Convert.ToByte(1) 
        End If 
        ReDim RequestBuffer(DataSize - 1) 

         Set Type Field 
        RequestBuffer(0) = Convert.ToByte(ICMPType.Echo) 
         Set ID Field 
        BitConverter.GetBytes(Identifier).CopyTo(RequestBuffer, 4) 
         Set Sequence Field 
        BitConverter.GetBytes(Sequence).CopyTo(RequestBuffer, 6) 

         load some data into buffer 
        Dim i As Integer 
        For i = 8 To DataSize - 1 
            RequestBuffer(i) = Convert.ToByte(i Mod 8) 
        Next i 

         Set Checksum 
        Call CreateChecksum(RequestBuffer, DataSize, RequestBuffer(2), RequestBuffer(3)) 

        Try 
            ICMPSocket = New Socket(AddressFamily.InterNetwork, SocketType.Raw, ProtocolType.Icmp) 
            ICMPSocket.Blocking = False 

            Start Countof RTT 
            intStart = System.Environment.TickCount 
            Send Data 
            ICMPSocket.SendTo(RequestBuffer, 0, DataSize, SocketFlags.None, RemoteHost) 
            Receive Data 
            RecvSize = ICMPSocket.ReceiveFrom(ReplyBuffer, SocketFlags.None, rhEP) 
            End Count of RTT 
            intEnd = System.Environment.TickCount 

            If RecvSize > 0 Then 
                Dim ReS As String 
                Select Case ReplyBuffer(20) 
                    Case Convert.ToByte(ICMPType.EchoReply) 
                        ReS = (intEnd - intStart).ToString get the RTT 
                        pStatus.Text = "Host: " + RemoteHost.Address.ToString + " - RTT: " + ReS 
                    Case Convert.ToByte(ICMPType.Unreachable) 
                        ReS = "Unreachable" 
                        pStatus.Text = ReS 
                    Case Else 
                        ReS = "Something Happened" 
                        pStatus.Text = ReS 
                End Select 
            End If 

        Catch e As Exception 
            MessageBox.Show(e.Message + vbNewLine + e.TargetSite.Name) 
        Finally 
            If Not ICMPSocket Is Nothing Then 
                ICMPSocket.Close() 
            End If 
        End Try 
    End Sub 

    Public Function GetRemoteEndpoint(ByVal RemoteAddress As String) As IPEndPoint 
        Return New IPEndPoint(Dns.Resolve(RemoteAddress).AddressList(0), portICMP) 
    End Function 

     ICMP requires a checksum that is the ones 
     complement of the ones complement sum of 
     all the 16-bit values in the data in the 
     buffer. 
     Use this procedure to load the Checksum 
     field of the buffer. 
     The Checksum Field (hi and lo bytes) must be 
     zero before calling this procedure. 
    Private Sub CreateChecksum(ByRef data() As Byte, ByVal Size As Integer, ByRef HiByte As Byte, ByRef LoByte As Byte) 
        Dim i As Integer 
        Dim chk As Integer = 0 

        For i = 0 To Size - 1 Step 2 
            chk += Convert.ToInt32(data(i) * &H100 + data(i + 1)) 
        Next 

        chk = Convert.ToInt32((chk And &HFFFF&) + Fix(chk / &H10000&)) 
        chk += Convert.ToInt32(Fix(chk / &H10000&)) 
        chk = Not (chk) 

        HiByte = Convert.ToByte((chk And &HFF00) / &H100) 
        LoByte = Convert.ToByte(chk And &HFF) 
    End Sub 
End Module

 

[quwiltw]

divil gave this link in another post. have you checked it out?
http://www.csharphelp.com/archives/archive6.html

 

[LeeSalter]

Thanks for that....I had seen that before, but my c# conversion skills are not too hot at present. I was wondering if there was a simple but reliable vb .net version knocking around. If not, Ill try to convert the c# code.

 

[michaelangelo]

can you help......this code works one shot....but im tryna repeat this every 30 sec in my program.....

it pings all right once.... (i still need to figure out a static ip to test my connection with anyway, but machines on my network work ok)

i get an echo on th efirst ping, but anytime after that, it times out or something....

anyone?>


e

 

[zed1313]

Hello,


to resolve this problem, you must wait until some data has been received from the network and is available to be read.

Here my changes in the code:

...ICMPSocket.SendTo(RequestBuffer, 0, _
DataSize, SocketFlags.None, _
RemoteHost)

***************Add this : !!!!!!!!!!!!!!!!!*******>
Do While ICMPSocket.Available = 0
Loop
<*****************************************


RecvSize = ICMPSocket.ReceiveFrom( _
ReplyBuffer, SocketFlags.None, _
CType(RemoteHost, EndPoint)) ...


Regards.

 

[splice]

 (Ping.vb)
 Credits:        [url]http://www.csharphelp.com/archives/archive6.html[/url]
                 Original source is freely available from the above URL
 Original By:    Saurabh Nandu (saurabhn@webveda.com)
 Converted By:   Michael DeLuisi (mike@waygate.net)
 Converted From: C#
 Converted To:   VB.NET
 On Date:        July 2, 2003
 Actions Taken:  conversion, cleanup, optimizations, restructuring, testing
 Notes:          Code is far from perfect, but its easier to manage ( I think :P)
 Usage:           With New ICMP.CPing("<hostname>")
                      If (.Open()) Then
                          Console.WriteLine("Ping Time 1: " & .Ping())
                          Console.WriteLine("Ping Time 2: " & .Ping())
                          Console.WriteLine("Ping Time 3: " & .Ping())
                          .Close()
                      End If
                  End With
 Anomalies:      The first call to .Ping() will generate a higher than usual reading
                 because of JIT compiling.  So, you may want to throw out the first
                 ping result if measuring latency
Imports System.Net.Sockets
Imports System.Net
Imports System

Namespace ICMP
    
     ICMP Packet Structure
    
    Structure IcmpPacket
#Region "PUBLIC MEMBER VARIABLES"
        Dim type As Byte                 type of message
        Dim subCode As Byte              type of sub code
        Dim checkSum As UInt16           ones complement checksum of struct
        Dim identifier As UInt16         identifier
        Dim sequenceNumber As UInt16     sequence number  
        Dim data() As Byte               send data
#End Region

#Region "PUBLIC MEMBER METHODS"
        Public Sub Initialize(ByVal type As Byte, ByVal subCode As Byte, ByVal payload() As Byte)
            Dim index As Integer
            Dim icmpPacketBuffer() As Byte
            Dim cksumBuffer() As UInt16
            Dim icmpHeaderBufferIndex As Int32 = 0
            Me.type = type
            Me.subCode = subCode
            checkSum = UInt16.Parse("0")
            identifier = UInt16.Parse("45")
            sequenceNumber = UInt16.Parse("0")
            data = payload
            ReDim data(payload.Length() - 1)
            Array.Copy(payload, data, payload.Length())
             Variable to hold the total Packet size
             Call a Method Serialize which counts the total number of Bytes in the Packet
            icmpPacketBuffer = Serialize()
             now get this critter into a UInt16 array (Half size of the Packet)
            ReDim cksumBuffer(CInt(Math.Ceiling(CDbl(icmpPacketBuffer.Length()) / 2)) - 1)
            ReDim cksumBuffer((icmpPacketBuffer.Length() \ 2) - 1)

             initialize the Uint16 array
            For index = 0 To (cksumBuffer.Length() - 1)
                cksumBuffer(index) = BitConverter.ToUInt16(icmpPacketBuffer, _
                                                           icmpHeaderBufferIndex)
                icmpHeaderBufferIndex += 2
            Next index
             Call a method which will return a checksum and save the checksum
            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 b_seq() As Byte = BitConverter.GetBytes(sequenceNumber)
            Dim b_cksum() As Byte = BitConverter.GetBytes(checkSum)
            Dim b_id() As Byte = BitConverter.GetBytes(identifier)
            Dim index As Int32 = 0
            Dim buffer() As Byte
            ReDim buffer(Size() - 1)

             serialize the struct into the array
            buffer(0) = type
            buffer(1) = subCode
            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
             copy the data
            If (data.Length() > 0) Then
                Array.Copy(data, 0, buffer, index, data.Length())
            End If
            Return buffer
        End Function
#End Region
    End Structure

    
     ICMP Ping Class
     
    Public Class CPing
#Region "MEMBER CONSTANTS"
        Private Const DEFAULT_TIMEOUT As Integer = 1000
        Private Const SOCKET_ERROR As Integer = -1
        Private Const PING_ERROR As Integer = -1
        Private Const ICMP_ECHO As Integer = 8
        Private Const DATA_SIZE As Integer = 32
        Private Const RECV_SIZE As Integer = 128
#End Region

#Region "MEMBER VARIABLES"
        Private _open As Boolean = False
        Private _initialized As Boolean
        Private _recvBuffer() As Byte
        Private _packet As IcmpPacket
        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()      default to localhost loopback
            ReDim _recvBuffer(RECV_SIZE - 1)
        End Sub

        Private Overloads Sub finalize()
            Me.Close()                       ensures that the socket is closed
            Erase _recvBuffer
        End Sub
#End Region

#Region "MEMBER METHODS"
         set/get current hostname
        Public Property HostName() As String
            Get
                Return _hostName
            End Get
            Set(ByVal Value As String)
                _hostName = Value
                 if we are already open, close and reopen with new host
                If (_open) Then
                    Me.Close()
                    Me.Open()
                End If
            End Set
        End Property

         get open state
        Public ReadOnly Property IsOpen() As Boolean
            Get
                Return _open
            End Get
        End Property

         creates new socket to host and remote and local end points
        Public Function Open() As Boolean
            Dim payload() As Byte

            If (Not _open) Then
                Try
                     initialize the packet
                    ReDim payload(DATA_SIZE)
                    _packet.Initialize(ICMP_ECHO, 0, payload)
                     Initilize a Socket of the Type ICMP
                    _socket = New Socket(AddressFamily.InterNetwork, SocketType.Raw, ProtocolType.Icmp)
                     set server end point
                    _server = New IPEndPoint(Dns.GetHostByName(_hostName).AddressList(0), 0)
                     Set the receiving endpoint to the client machine
                    _local = New IPEndPoint(Dns.GetHostByName(Dns.GetHostName()).AddressList(0), 0)
                    _open = True
                Catch
                    Return False
                End Try
            End If
            Return True
        End Function

         destroys socket and end points if needed
        Public Function Close() As Boolean
            If (_open) Then
                _socket.Close()
                _socket = Nothing
                _server = Nothing
                _local = Nothing
                _open = False
            End If
            Return True
        End Function

         does ping based on the default timeout
        Public Overloads Function Ping() As Integer
            Return Ping(DEFAULT_TIMEOUT)
        End Function

         does ping based on passed timeout
        Public Overloads Function Ping(ByVal timeOutMilliSeconds As Integer) As Integer
             initialize the time out value
            Dim timeOut As Integer = timeOutMilliSeconds + Environment.TickCount()

             send the packet
            If (SOCKET_ERROR = _socket.SendTo(_packet.Serialize(), _packet.Size(), 0, _server)) Then
                Return PING_ERROR
            End If

             loop until we get a response or a timeout
            Do
                 poll the read buffer every 1ms, if data exists, read it 
                 and return the round-trip time
                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 to hold static checksum routine
    
    Module MCheckSum
#Region "MEMBER METHODS"
         This Method has the algorithm to make a checksum 
        Public Function Calculate(ByRef buffer() As UInt16, ByVal size As Int32) As UInt16
            Dim counter As Int32 = 0
            Dim cksum As UNION_INT32
            Do While (size > 0)
                cksum.w32 += Convert.ToInt32(buffer(counter))
                counter += 1
                size -= 1
            Loop
             same as (cksum >> 16) << 1) + (cksum & 0xFFFF)
            cksum.w32 = cksum.msw.w16 + cksum.lsw.w16 + cksum.msw.w16
             16-bit bit-inverse
            Return Convert.ToUInt16(cksum.lsw.w16 Xor &HFFFF)
        End Function
#End Region
    End Module

End Namespace

 

[splice]

The above code is a VB.NET conversion from quwiltw C# code link. I needed it for a project and decided to share the final product with "yous guys"

I didnt have enough room to post the unions for the checkum routine. You should be able to drop the following code into the ICMP namespace. (As always, youll need to import System.Runtime.InteropServices to use the code.)

    <StructLayout(LayoutKind.Explicit)> _
    Structure UNION_INT16
        <FieldOffset(0)> Dim lsb As Byte       LSB
        <FieldOffset(1)> Dim msb As Byte       MSB
        <FieldOffset(0)> Dim w16 As Short
    End Structure

    <StructLayout(LayoutKind.Explicit)> _
    Structure UNION_INT32
        <FieldOffset(0)> Dim lsw As UNION_INT16      LSW
        <FieldOffset(2)> Dim msw As UNION_INT16      MSW
        <FieldOffset(0)> Dim w32 As Integer
    End Structure

 

[cporter71]

Joining late to this thread. I have inherited some VB.net code that performs some system/network level tasks. Being a newbie I am trying to learn someone elses code and the language at the same time ~ always fun! Anyway - I have been able to add the above code (converted from c# solution) however I cannot get it to work! It builds fine - just some sort of runtime error. Would it be possible to show a sample snip of code the uses CPing? just a simple main() - no forms or anything extra - just a main, a CPing instance, a hostname, a call to Ping(), and a test of the return value. Sorry for such a HelloWorld request - but it would be appreciated.

 

[cporter71]

OK - So I got a little driver to work - however, much like mentioned in the other postings - it only works on the first try! I get a response time of > 0 for the first host, however the subsequent calls return zero. Any further revelations on this?

It seels XP has a .net WIM lib you can use to perform the ping - doesnt help us NT folks, but it looks easy as pie.

 

[splice]

if you are pinging an address on the lan it will most likely show a ping of 0, which means a response time less then 10ms... Remember, the first ping reports a larger then usual number because of JIT compiling on the first run. If you get a negative value back that means the the host you tried to ping is unreachable (ie: port is blocked or no listening server).

GetTickCount() is only accurate to 10ms.. I suspose I could change the code to use Windows API PerformanceCounters if you need a finer response time resolution.

 

[iwonder]

Change this line:
ICMPSocket.Blocking = False
To this
ICMPSocket.Blocking = True

This should allow you to ping multiple times if your network administrator allows it.