• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 147
  • Last Modified:

Is this computer on-line?

I have an application that pipes 'net view' to a file ("net view > machine.txt") so that I can get a list of all machines on-line.  But some machines in this list are no longer on-line, because of the delays of the master browser.

I would like a way to check if a machine if accessible before I attempt to execute a DIR() function on the machine.  Because the DIR() will take about 50 sec. to timeout if the machine is not accessible.  Is there maybe an API call for this?

I can ping a host and get a "Timeout" response rather quickly.  But how to do this in VB?  Is there an API call that does want ping does?
0
jfunderb
Asked:
jfunderb
1 Solution
 
vettrangerCommented:
Here's a short article and a lot of source code for pinging using VB. Enjoy! :-)

With Visual Basic applications expanding more into the enterprise, basic networking functionality often needs to be duplicated by the application. Using the routine here, you will be able to ping any IP address passed.
Ping is a tool that helps to verify IP-level connectivity. When troubleshooting, the ping command is used to send an ICMP echo request to a target host name or IP address. Use ping whenever you need to verify that a host computer can connect to the TCP/IP network and network resources. You can also use the ping utility to isolate network hardware problems and incompatible configurations.

It is usually best to verify that a route exists between the local computer and a network host by first using ping and the IP address of the network host to which you want to connect. First try pinging the IP address of the target host to see if it will respond, because this is the simplest case.

The concept in the VB implementation is to pass to a routine the address to ping, and a message under 32 bytes that the ping should return if successful. This routine does not worked with named domains; it only works when passed the numerical address itself.

To test this application, you must be connected to a network or to your ISP via dial up networking (DUN).

I do not profess to know anything at all about networking or internet functions ... this code  (as a bas file only) was provided to me unsigned. If the author is known, I'd appreciate hearing from them so proper credit can be given. Furthermore, it is commented only as far as the author did, with a bit of MSDN descriptions thrown in.

Finally, just to keep the error message lines short (narrow), I've split them into multiple lines as needed.
 

 

 BAS Module Code
 
Add the following code to a BAS module:

--------------------------------------------------------------------------------
 

Option Explicit

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 MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128

Public Type ICMP_OPTIONS
    Ttl             As Byte
    Tos             As Byte
    Flags           As Byte
    OptionsSize     As Byte
    OptionsData     As Long
End Type

Dim ICMPOPT As ICMP_OPTIONS

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 HOSTENT
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLen As Integer
    hAddrList As Long
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.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 Sub RtlMoveMemory Lib "kernel32" _
   (hpvDest As Any, _
    ByVal hpvSource As Long, _
    ByVal cbCopy As Long)


Public Function GetStatusCode(status As Long) As String

   Dim msg As String

   Select Case status
      Case IP_SUCCESS:               msg = "ip success"
      Case IP_BUF_TOO_SMALL:         msg = "ip buf too_small"
      Case IP_DEST_NET_UNREACHABLE:  msg = "ip dest net unreachable"
      Case IP_DEST_HOST_UNREACHABLE: msg = "ip dest host unreachable"
      Case IP_DEST_PROT_UNREACHABLE: msg = "ip dest prot unreachable"
      Case IP_DEST_PORT_UNREACHABLE: msg = "ip dest port unreachable"
      Case IP_NO_RESOURCES:          msg = "ip no resources"
      Case IP_BAD_OPTION:            msg = "ip bad option"
      Case IP_HW_ERROR:              msg = "ip hw_error"
      Case IP_PACKET_TOO_BIG:        msg = "ip packet too_big"
      Case IP_REQ_TIMED_OUT:         msg = "ip req timed out"
      Case IP_BAD_REQ:               msg = "ip bad req"
      Case IP_BAD_ROUTE:             msg = "ip 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 addr 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 addr 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  msg returned"
   End Select
   
   GetStatusCode = CStr(status) & "   [ " & msg & " ]"
   
End Function


Public Function HiByte(ByVal wParam As Integer) As Integer
 
  'modified Oct 11/99
  'The origional method as  
  'HiByte = wParam \ &H100 And &HFF&  
  'would generate Division by 0 errors on some
  'systems when compiled to Native Code exe (yet
  'work in the IDE or when compiled as pCode).  
  'Although adding brackets should force the
  'correct evaluation to occur first, the problem
  'remained on some systems. The additional step below
  'assigning the initial evaluation result to a temp
  'variable should reslove the problem. If it doesn't,
  'then it looks like a pCode compile needs to be used  
  'with this (and, for that matter, possibly all)
  'projects.

   Dim tmp as Integer
   tmp = wParam \ &H100
   HiByte = tmp And &HFF&
 
End Function


Public Function LoByte(ByVal wParam As Long) As Integer

    LoByte = wParam And &HFF&    

End Function


Public Function Ping(szAddress As String, ECHO As ICMP_ECHO_REPLY) As Long

   Dim hPort As Long
   Dim dwAddress As Long
   Dim sDataToSend As String
   Dim iOpt As Long
   
   sDataToSend = "Echo This"
   dwAddress = AddressStringToLong(szAddress)
   
   hPort = IcmpCreateFile()
   
   If IcmpSendEcho(hPort, _
                   dwAddress, _
                   sDataToSend, _
                   Len(sDataToSend), _
                   0, _
                   ECHO, _
                   Len(ECHO), _
                   PING_TIMEOUT) Then
   
        'the ping succeeded,
        '.Status will be 0
        '.RoundTripTime is the 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
         Ping = ECHO.RoundTripTime
   Else: Ping = ECHO.status * -1
   End If
                       
   Call IcmpCloseHandle(hPort)
   
End Function
   

Function AddressStringToLong(ByVal tmp As String) As Long

   Dim i As Integer
   Dim parts(1 To 4) As String
   
   i = 0
   
  'we have to extract each part of the
  '123.456.789.123 string, delimited by
  'a period
   While InStr(tmp, ".") > 0
      i = i + 1
      parts(i) = Mid(tmp, 1, InStr(tmp, ".") - 1)
      tmp = Mid(tmp, InStr(tmp, ".") + 1)
   Wend
   
   i = i + 1
   parts(i) = tmp
   
   If i <> 4 Then
      AddressStringToLong = 0
      Exit Function
   End If
   
  'build the long value out of the
  'hex of the extracted strings
   AddressStringToLong = Val("&H" & Right("00" & Hex(parts(4)), 2) & _
                         Right("00" & Hex(parts(3)), 2) & _
                         Right("00" & Hex(parts(2)), 2) & _
                         Right("00" & Hex(parts(1)), 2))
   
End Function


Public Sub SocketsCleanup()

   Dim x As Long
   
  'need to use a var (insread of embedding
  'in the If..Then call) becuse the function
  'returns the error code if failed.
   x = WSACleanup()

   If x <> 0 Then
       MsgBox "Windows Sockets error " & Trim$(Str$(x)) & _
               " occurred in Cleanup.", vbExclamation
   End If
   
End Sub


Public Function SocketsInitialize() As Boolean

    Dim WSAD As WSADATA
    Dim X As Integer
    Dim szLoByte As String
    Dim szHiByte As String
    Dim szBuf As String
   
    x = WSAStartup(WS_VERSION_REQD, WSAD)
   
   'check for valid response
    If x <> 0 Then

        MsgBox "Windows Sockets for 32 bit Windows " & _
               "environments is not successfully responding."
        Exit Function

    End If
   
   'check that the version of sockets is supported
    If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or _
       (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _
        HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
       
        szHiByte = Trim$(Str$(HiByte(WSAD.wVersion)))
        szLoByte = Trim$(Str$(LoByte(WSAD.wVersion)))
        szBuf = "Windows Sockets Version " & szLoByte & "." & szHiByte
        szBuf = szBuf & " is not supported by Windows " & _
                          "Sockets for 32 bit Windows environments."
        MsgBox szBuf, vbExclamation
        Exit Function
       
    End If
   
   'check that there are available sockets
    If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then

        szBuf = "This application requires a minimum of " & _
                 Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
        MsgBox szBuf, vbExclamation
        Exit Function

    End If
   
    SocketsInitialize = True
       
End Function
'--end block--'
   

 Form Code
 
To a form add a command button (Command1), two text boxes (Text3, Text4)  and six text boxes in a control array (Text1(0) - Text1(5)). The labels are optional. Add the following to the command button:

--------------------------------------------------------------------------------
 

Option Explicit

Private Sub Command1_Click()
   
   Dim ECHO As ICMP_ECHO_REPLY
   Dim pos As Integer
   
   If SocketsInitialize() Then
   
     'ping an ip address, passing the
     'address and the ECHO structure
      Call Ping((Text3), ECHO)
     
     'display the results from the ECHO structure
      Text1(0) = GetStatusCode(ECHO.status)
      Text1(1) = ECHO.Address
      Text1(2) = ECHO.RoundTripTime & " ms"
      Text1(3) = ECHO.DataSize & " bytes"
     
      If Left$(ECHO.Data, 1) <> Chr$(0) Then
         pos = InStr(ECHO.Data, Chr$(0))
         Text1(4) = Left$(ECHO.Data, pos - 1)
      End If
   
      Text1(5) = ECHO.DataPointer
     
      SocketsCleanup
     
   End If
   
End Sub
'--end block--'

0
 
tureCommented:
I guess it is. At least you were able to post this question.

:O)

/Ture
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now