Ping module in VB 2008

Hi Experts,

I have a old program in VB6 that I am trying to convert into VB 2008.
I have problem converting my ping module (that was working fine in vb6)
The information I found on the  net does a ping by IP and return the results on a shell screen.

What I am looking for is a module that validate if the remote computer is alive first. And if yes, I would like to get it's IP Adresse. If not, what is the error message. Like I had in my old module.
I have no clu on how to do this in VB.NEt

Can you help?
Here's my old VB6 code.

Thank you

Option Explicit

Public Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000

Public Const WS32_NOT_ENOUGH_SOCKETS = -4
Public Const WS32_NOT_SUPPORTED = -3
Public Const WS32_NOT_RESPONDING = -2
Public Const IP_STATUS_BASE = 11000
Public Const IP_SUCCESS = 0
Public Const IP_BUF_TOO_SMALL = (11000 + 1)
Public Const IP_DEST_NET_UNREACHABLE = (11000 + 2)
Public Const IP_DEST_HOST_UNREACHABLE = (11000 + 3)
Public Const IP_DEST_PROT_UNREACHABLE = (11000 + 4)
Public Const IP_DEST_PORT_UNREACHABLE = (11000 + 5)
Public Const IP_NO_RESOURCES = (11000 + 6)
Public Const IP_BAD_OPTION = (11000 + 7)
Public Const IP_HW_ERROR = (11000 + 8)
Public Const IP_PACKET_TOO_BIG = (11000 + 9)
Public Const IP_REQ_TIMED_OUT = (11000 + 10)
Public Const IP_BAD_REQ = (11000 + 11)
Public Const IP_BAD_ROUTE = (11000 + 12)
Public Const IP_TTL_EXPIRED_TRANSIT = (11000 + 13)
Public Const IP_TTL_EXPIRED_REASSEM = (11000 + 14)
Public Const IP_PARAM_PROBLEM = (11000 + 15)
Public Const IP_SOURCE_QUENCH = (11000 + 16)
Public Const IP_OPTION_TOO_BIG = (11000 + 17)
Public Const IP_BAD_DESTINATION = (11000 + 18)
Public Const IP_ADDR_DELETED = (11000 + 19)
Public Const IP_SPEC_MTU_CHANGE = (11000 + 20)
Public Const IP_MTU_CHANGE = (11000 + 21)
Public Const IP_UNLOAD = (11000 + 22)
Public Const IP_ADDR_ADDED = (11000 + 23)
Public Const IP_GENERAL_FAILURE = (11000 + 50)
Public Const MAX_IP_STATUS = 11000 + 50
Public Const IP_PENDING = (11000 + 255)
Public Const PING_TIMEOUT = 200
Public Const WS_VERSION_REQD = &H101
Public Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Public Const MIN_SOCKETS_REQD = 1
Public Const SOCKET_ERROR = -1
Public Const WSADescription_Len = 256
Public Const WSASYS_Status_Len = 128
Public Type ICMP_OPTIONS
    Ttl             As Byte
    Tos             As Byte
    Flags           As Byte
    OptionsSize     As Byte
    OptionsData     As Long
End Type
Public Type ICMP_ECHO_REPLY
    Address         As Long
    status          As Long
    RoundTripTime   As Long
    DataSize        As Integer
    reserved        As Integer
    DataPointer     As Long
    Options         As ICMP_OPTIONS
    Data            As String * 250
End Type
Public Type HOSTENT
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLength As Integer
    hAddrList As Long
End Type
Public Type LHOSTENTRY
    hName As String
    hAddress As String
    hStatus As String
End Type
Public Type WSADATA
    wversion As Integer
    wHighVersion As Integer
    szDescription(0 To WSADescription_Len) As Byte
    szSystemStatus(0 To WSASYS_Status_Len) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpszVendorInfo As Long
End Type
Public Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Public Declare Function IcmpCloseHandle Lib "icmp.dll" _
    (ByVal IcmpHandle As Long) As Long
Public Declare Function IcmpSendEcho Lib "icmp.dll" _
    (ByVal IcmpHandle As Long, ByVal DestinationAddress As Long, _
    ByVal RequestData As String, ByVal RequestSize As Integer, _
    ByVal RequestOptions As Long, ReplyBuffer As ICMP_ECHO_REPLY, _
    ByVal ReplySize As Long, ByVal Timeout As Long) As Long
Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Public Declare Function WSAStartup Lib "WSOCK32.DLL" _
   (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Public Declare Function gethostname Lib "WSOCK32.DLL" _
   (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Public Declare Function gethostbyname Lib "WSOCK32.DLL" _
   (ByVal szHost As String) As Long
Public Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, _
    ByVal hpvSource As Long, ByVal cbCopy As Long)
Public G_lhEntry As LHOSTENTRY

Public Function IsHostAlive(ByVal lHost As String) As Boolean
    Dim ECHO As ICMP_ECHO_REPLY
    Dim pos As Integer
    
    On Error Resume Next
    IsHostAlive = False
    SysPing lHost, ECHO
    If ECHO.status = IP_SUCCESS Then IsHostAlive = True
End Function

Public Function CvtHiByte(ByVal wParam As Integer)

    On Error Resume Next
    CvtHiByte = wParam \ &H100 And &HFF&
End Function

Public Function CvtLoByte(ByVal wParam As Integer)

    On Error Resume Next
    CvtLoByte = wParam And &HFF&
End Function

Public Function GetPingString(ByVal lHost As String) As String
    Dim ECHO As ICMP_ECHO_REPLY
    Dim pos As Integer
    If lHost <> "" Then
        SysPing lHost, ECHO
    Else
        Exit Function
    End If
    
    On Error Resume Next
    If ECHO.status = IP_SUCCESS Then
        GetPingString = G_lhEntry.hAddress
        'GetPingString = "Reply from " & G_lhEntry.hAddress
        'GetPingString = "Reply from " & G_lhEntry.hAddress & ": bytes=" & Trim$(CStr(ECHO.DataSize)) _
         '   & " time=" & Trim$(CStr(ECHO.RoundTripTime)) & "ms TTL=" _
          '  & Trim$(CStr(ECHO.Options.Ttl))
    Else
        GetPingString = GetPingMsg(ECHO.status)
    End If
End Function

Public Function GetPingMsg(status As Long) As String
    Dim msg As String
    
    On Error Resume Next
    Select Case status
        Case WS32_NOT_ENOUGH_SOCKETS:  msg = "Not enough sockets available"
        Case WS32_NOT_SUPPORTED:       msg = "Socket version not supported"
        Case WS32_NOT_RESPONDING:      msg = "Winsock 32 not responding"
        Case IP_SUCCESS:               msg = "OK"
        Case IP_BUF_TOO_SMALL:         msg = "IP buf too small"
        Case IP_DEST_NET_UNREACHABLE:  msg = "Destination network unreachable"
        Case IP_DEST_HOST_UNREACHABLE: msg = "Destination host unreachable"
        Case IP_DEST_PROT_UNREACHABLE: msg = "Destination protocol unreachable"
        Case IP_DEST_PORT_UNREACHABLE: msg = "Destination port unreachable"
        Case IP_NO_RESOURCES:          msg = "IP no resources"
        Case IP_BAD_OPTION:            msg = "IP bad option"
        Case IP_HW_ERROR:              msg = "IP hardware error"
        Case IP_PACKET_TOO_BIG:        msg = "IP packet too big"
        Case IP_REQ_TIMED_OUT:         msg = "Request timed out"
        Case IP_BAD_REQ:               msg = "Bad request"
        Case IP_BAD_ROUTE:             msg = "Bad route"
        Case IP_TTL_EXPIRED_TRANSIT:   msg = "IP TTL expired transit"
        Case IP_TTL_EXPIRED_REASSEM:   msg = "IP TTL expired reassem"
        Case IP_PARAM_PROBLEM:         msg = "IP param problem"
        Case IP_SOURCE_QUENCH:         msg = "IP source quench"
        Case IP_OPTION_TOO_BIG:        msg = "IP option too big"
        Case IP_BAD_DESTINATION:       msg = "IP bad destination"
        Case IP_ADDR_DELETED:          msg = "IP address deleted"
        Case IP_SPEC_MTU_CHANGE:       msg = "IP spec mtu change"
        Case IP_MTU_CHANGE:            msg = "IP mtu change"
        Case IP_UNLOAD:                msg = "IP unload"
        Case IP_ADDR_ADDED:            msg = "IP address added"
        Case IP_GENERAL_FAILURE:       msg = "IP general failure"
        Case IP_PENDING:               msg = "IP pending"
        Case PING_TIMEOUT:             msg = "Ping timeout"
        Case Else:                     msg = "Unknown message returned"
    End Select
    GetPingMsg = msg
End Function

Public Function GetHostInfo(lHost As String) As LHOSTENTRY
    Dim WSAD As WSADATA
    Dim Rval As Long
    Dim hostname As String * 256
    Dim hostent_addr As Long
    Dim host As HOSTENT
    Dim hostip_addr As Long
    Dim temp_ip_address() As Byte
    Dim ival As Integer
    Dim ip_address As String
     
    On Error Resume Next
    Rval = WSAStartup(WS_VERSION_REQD, WSAD)
    If Rval <> 0 Then
        GetHostInfo.hStatus = WS32_NOT_RESPONDING
        Exit Function
    End If
    If CvtLoByte(WSAD.wversion) < WS_VERSION_MAJOR Or _
       (CvtLoByte(WSAD.wversion) = WS_VERSION_MAJOR And _
        CvtHiByte(WSAD.wversion) < WS_VERSION_MINOR) Then
        GetHostInfo.hStatus = WS32_NOT_SUPPORTED
        WSACleanup
        Exit Function
    End If
    If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
        GetHostInfo.hStatus = WS32_NOT_ENOUGH_SOCKETS
        WSACleanup
        Exit Function
    End If
     
    GetHostInfo.hStatus = SOCKET_ERROR
    GetHostInfo.hName = Trim$(LCase$(lHost))
    hostname = Left$(lHost + String(256, Chr$(0)), 256)
    If (CheckIPAddress(lHost) = False) Then
        hostent_addr = gethostbyname(hostname)
        If hostent_addr = 0 Then
            WSACleanup
            Exit Function
        End If
        RtlMoveMemory host, hostent_addr, LenB(host)
        RtlMoveMemory hostip_addr, host.hAddrList, 4
        ReDim temp_ip_address(1 To host.hLength)
        RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
        For ival = 1 To host.hLength
            ip_address = ip_address & temp_ip_address(ival) & "."
        Next
        ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
    Else
        ip_address = lHost
    End If
    GetHostInfo.hAddress = ip_address
    GetHostInfo.hStatus = IP_SUCCESS
    WSACleanup
End Function

Public Function SysPing(lhostname As String, ECHO As ICMP_ECHO_REPLY, Optional EchoString As String) As Long
    Dim WSAD As WSADATA
    Dim hPort As Long
    Dim dwAddr As Long
    Dim iOpt As Long
    Dim Rval As Long
    Dim eString As String
    Dim szLoByte As String
    Dim szHiByte As String
    Dim szBuf As String
    
    On Error Resume Next
    eString = "ABCDEFGHIJKLMNOPQRSTUVWXYZ012345": If Not EchoString = "" Then eString = EchoString
    G_lhEntry = GetHostInfo(lhostname)
    If Not G_lhEntry.hStatus = 0 Then
        SysPing = IP_BAD_DESTINATION
        ECHO.status = IP_BAD_DESTINATION
        Exit Function
    End If
    dwAddr = CvtIPAddrClng(G_lhEntry.hAddress)
    If dwAddr = 0 Then
        SysPing = IP_BAD_DESTINATION
        ECHO.status = IP_BAD_DESTINATION
        Exit Function
    End If
    Rval = WSAStartup(WS_VERSION_REQD, WSAD)
    If Rval <> 0 Then
        SysPing = WS32_NOT_RESPONDING
        ECHO.status = WS32_NOT_RESPONDING
        Exit Function
    End If
    If CvtLoByte(WSAD.wversion) < WS_VERSION_MAJOR Or _
       (CvtLoByte(WSAD.wversion) = WS_VERSION_MAJOR And _
        CvtHiByte(WSAD.wversion) < WS_VERSION_MINOR) Then
        SysPing = WS32_NOT_SUPPORTED
        ECHO.status = WS32_NOT_SUPPORTED
        WSACleanup
        Exit Function
    End If
    If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
        SysPing = WS32_NOT_ENOUGH_SOCKETS
        ECHO.status = WS32_NOT_ENOUGH_SOCKETS
        WSACleanup
        Exit Function
    End If
    hPort = IcmpCreateFile()
    Rval = IcmpSendEcho(hPort, dwAddr, eString, Len(eString), 0, ECHO, Len(ECHO), PING_TIMEOUT)
    If Rval = 1 Then
        SysPing = IP_SUCCESS
    Else
        If ECHO.status = 0 Then ECHO.status = IP_DEST_NET_UNREACHABLE
        SysPing = ECHO.status * -1
    End If
    IcmpCloseHandle hPort
    WSACleanup
End Function

Public Function CvtIPAddrClng(ByVal Tmp As String) As Long
    Dim ival As Integer
    Dim IpWord(4) As String
    
    On Error Resume Next
    CvtIPAddrClng = 0: ival = 0
    While InStr(Tmp, ".") > 0
        ival = ival + 1
        IpWord(ival) = Mid(Tmp, 1, InStr(Tmp, ".") - 1)
        Tmp = Mid(Tmp, InStr(Tmp, ".") + 1)
    Wend
    ival = ival + 1
    IpWord(ival) = Tmp
    If ival <> 4 Then Exit Function
    CvtIPAddrClng = Val("&H" & Right("00" & Hex(IpWord(4)), 2) & _
        Right("00" & Hex(IpWord(3)), 2) & Right("00" & Hex(IpWord(2)), 2) & _
        Right("00" & Hex(IpWord(1)), 2))
End Function

Public Function CheckIPAddress(Addr As String) As Boolean
    Dim i As Integer, pos As Integer, Pos1 As Integer, Tmp As String
    
    On Error Resume Next
    Pos1 = 1
    For i = 1 To 4
        pos = IIf(i < 4, InStr(Pos1, Addr, "."), Len(Addr) + 1)
        If pos = 0 Then Exit Function
        Tmp = Mid$(Addr, Pos1, pos - Pos1)
        If Len(Tmp) = 0 Or Not IsNumeric(Tmp) Or _
                CInt(Tmp) > 255 Or CInt(Tmp) < 0 Or _
                InStr(1, Tmp, ".") Then Exit Function
        Pos1 = pos + 1
    Next
    CheckIPAddress = True
End Function

Open in new window

EricPelletierAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
Maverick543Connect With a Mentor Commented:
Hi There
The .NET framework has a standard class in the System.Net.NetworkInformation called Ping
http://msdn.microsoft.com/en-us/library/system.net.networkinformation.ping.aspx 
That class does exactly what you want.
Regards
Marco
0
 
EricPelletierAuthor Commented:
Ok I tried copying the example code as a test but it doesn't work. When I pass the variable that contains a computer name, it says "Value of type String cannot be converted to '1-dimensional array of String'"

Also, is there any problem changing the public shared sub to public function? I need the result of the ping in another module where the ping is called.
Imports System

Imports System.Net

Imports System.Net.NetworkInformation

Imports System.Text

Namespace Examples.System.Net.NetworkInformation.PingTest

    Public Class PingExample

        'args(0) can be an IPaddress or host name. 

        Public Shared Sub Main(ByVal args() As String)

            Dim pingSender As Ping = New Ping()

            Dim options As PingOptions = New PingOptions()

            ' Use the default TTL value which is 128, 

            ' but change the fragmentation behavior. 

            options.DontFragment = True

            ' Create a buffer of 32 bytes of data to be transmitted. 

            Dim data As String = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"

            Dim buffer() As Byte = Encoding.ASCII.GetBytes(data)

            Dim timeout As Integer = 120

            Dim reply As PingReply = pingSender.Send(args(0), timeout, buffer, options)

            If reply.Status = IPStatus.Success Then

                Console.WriteLine("Address: {0}", reply.Address.ToString())

                Console.WriteLine("Trip time: {0}", reply.RoundtripTime)

                Console.WriteLine("Time to live: {0}", reply.Options.Ttl)

                Console.WriteLine("Don't fragment: {0}", reply.Options.DontFragment)

                Console.WriteLine("Buffer size: {0}", reply.Buffer.Length)

                Console.WriteLine(vbCrLf + "Press any key...")

                Console.ReadKey()

            End If

        End Sub

    End Class

End Namespace

Open in new window

0
 
EricPelletierAuthor Commented:
Ok I figured out  and changed this

Public Shared Sub Main(ByVal args() As String)
Dim reply As PingReply = pingSender.Send(args(0), timeout, buffer, options)

to this

Public Shared Sub Main(ByVal args As String)
Dim reply As PingReply = pingSender.Send(args, timeout, buffer, options)

So now it works. Now I need to return the ip adress so I tried changing the Sub Main into a function and return the IP but it does not work. To do so, I changed the lines

If reply.Status = IPStatus.Success Then

                Console.WriteLine("Address: {0}", reply.Address.ToString())
end if

to

If reply.Status = IPStatus.Success Then

                 return reply.Address.ToString()
end if
I also tried the function name = reply.Address.ToString()
But it does not work.

Why?
0
 
EricPelletierAuthor Commented:
Ok, I found that if I do not treat the else statement, it doesn't work. So I added the code:

Else
       function name = CStr(reply.Status)

in case it not a success. Now I can get the IP of the machine that is correct. But If the machine doesn't ping, it does not return the status. I would like to get the error message if it does not ping.

Thank you.
0
All Courses

From novice to tech pro — start learning today.