how to ping using winsock

Is there anyone can give an idea on how to ping a server using VB?

vb 6.0

VB Code:

Option Explicit
Public Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef saArray() As Any) As Long
Public Const IP_SUCCESS As Long = 0
Public Const MAX_IP_STATUS As Long = (11000 + 50)
Public Const IP_PENDING As Long = (11000 + 255)
Public Const PING_TIMEOUT As Long = 500
Public Const WS_VERSION_REQD As Long = &H101
Public Const MIN_SOCKETS_REQD As Long = 1
Public Const SOCKET_ERROR As Long = -1
Public Const INADDR_NONE As Long = &HFFFFFFFF
Public Const MAX_WSADescription As Long = 256
Public Const MAX_WSASYSStatus As Long = 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 Long 'formerly integer
   'Reserved        As Integer
    DataPointer     As Long
    Options         As ICMP_OPTIONS
    Data            As String * 250
End Type
 
Public Type WSADATA
   wVersion As Integer
   wHighVersion As Integer
   szDescription(0 To MAX_WSADescription) As Byte
   szSystemStatus(0 To MAX_WSASYSStatus) As Byte
   wMaxSockets As Long
   wMaxUDPDG As Long
   dwVendorInfo 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 Long, _
    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" () As Long
 
Public Declare Function WSAStartup Lib "wsock32" _
   (ByVal wVersionRequired As Long, _
    lpWSADATA As WSADATA) As Long
    
Public Declare Function WSACleanup Lib "wsock32" () As Long
 
Public Declare Function gethostname Lib "wsock32" _
   (ByVal szHost As String, _
    ByVal dwHostLen As Long) As Long
    
Public Declare Function gethostbyname Lib "wsock32" _
   (ByVal szHost As String) As Long
 
Public Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (xDest As Any, _
   xSource As Any, _
   ByVal nbytes As Long)
   
Public Declare Function inet_addr Lib "wsock32" _
   (ByVal s As String) As Long
   
Public Function Ping(sAddress As String, _
                     sDataToSend As String, _
                     ECHO As ICMP_ECHO_REPLY) As String
 
  'If Ping succeeds :
  '.RoundTripTime = 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
  '.Status will be 0
  '
  'If Ping fails .Status will be the error code
   
   Dim hPort As Long
   Dim dwAddress As Long
   
  'convert the address into a long representation
   dwAddress = inet_addr(sAddress)
   
  'if a valid address..
   If dwAddress <> INADDR_NONE Then
   
     'open a port
      hPort = IcmpCreateFile()
      
     'and if successful,
      If hPort Then
      
        'ping it.
         Call IcmpSendEcho(hPort, _
                           dwAddress, _
                           sDataToSend, _
                           Len(sDataToSend), _
                           0, _
                           ECHO, _
                           Len(ECHO), _
                           PING_TIMEOUT)
 
        'return the status as ping succes and close
         Ping = ECHO.status & "#" & ECHO.RoundTripTime
         
         Call IcmpCloseHandle(hPort)
      
      End If
      
   Else
        'the address format was probably invalid
         Ping = INADDR_NONE
         
   End If
End Function
   
 
Public Sub SocketsCleanup()
   
   If WSACleanup() <> 0 Then
       MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
   End If
    
End Sub
 
 
Public Function SocketsInitialize() As Boolean
 
   Dim WSAD As WSADATA
   
   SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
    
End Function
 
 
Public Function GetStatusCode(status As Long) As String
 
   Dim MSG As String
   
   Select Case status
      Case IP_SUCCESS:               MSG = "ip success"
      Case Else:                     MSG = "unknown  msg returned"
   End Select
   
   GetStatusCode = CStr(status) & "   [ " & MSG & " ]"
   
End Function

----------------------------------------------
VB.NET 2005 (FRAMEWORK 2.0)

VB Code:

Dim png As New System.Net.NetworkInformation.Ping
Dim rslt As System.Net.NetworkInformation.PingReply
Dim ba() As Byte = {1, 2, 3, 4, 5, 6, 7, 8, 9}
 
rslt = png.Send("63.236.73.220", 1500, ba)

Thank you very much TokersBall_CDXX!

I'm sorry I'am very new to VB and VB.net, I tried the VB.net code that you have gave but I've the error messages below. Please advise.

Type 'System.Net.NetworkInformation.Ping' is not defined.
Type 'System.Net.NetworkInformation.PingReply' is not defined.


Thanks again.

what version of .net are you using?

ping is unavailable in 2003 and you will need to use the vb6 code with some slight modifications.