Ping!

L

LeeSalter

Freshman
Joined
Feb 13, 2003
Messages
26
Location
In a House
Has anybody figured out Ping in vb.Net yet??

I've 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 can't be trusted.

The code I'm on about is posted below:-
Visual Basic: 
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 one's 
    ' complement of the one's 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
 
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, I'll try to convert the c# code. :D
 
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
 
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.
 
Code: 
'' (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 it's 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

        '' destroy's 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
 
Last edited:
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" :P

I didn't 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, you'll need to import System.Runtime.InteropServices to use the code.)


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
 
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.
 
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 - doesn't help us NT folks, but it looks easy as pie.
 
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.
 
Back
Top