how can i ping in VB?

i have used the code i found on this site to determine if i'm on line either via lan or modem. The problem is my cable company is crap and my cable modem goes down all the time. I have a complete loss of internet connectivity. But the code in the example isConnected = ViaLan() still returns TRUE even though I have no internet access. I need to use a different method to determine if i'm online. If I knew how to PING in VB that should do the trick.

Thanks!

With the Internet Control Message Protocol

Code:

---

Sub Ping(Message As String, IPAddress As String) 'Ping an IP Address
Dim hFileAs Long, lRetAs Long, lIPAddress As Long, lPingRetAs Long
Dim strMessage As String, iValAs Integer 
Dim pOptionsAs ip_option_information, pReturn As icmp_echo_reply
Dim pWsaDataAs tagWSAData
On Error Resume Next 
strMessage = Message$
iVal = WSAStartup(&H101, pWsaData)
lIPAddress = ConvertIPAddressToLong(IPAddress$)
hFile = IcmpCreateFile()
pOptions.Ttl = 30: pOptions.Tos = 12
pWsaData.wVersion = 4
lRet = IcmpSendEcho(hFile, lIPAddress, strMessage, Len(strMessage), pOptions, pReturn, Len(pReturn), PING_TIMEOUT)
If lRet = 0 Then
Else
  If pReturn.Status <> 0 Then
  Else
    lRet = IcmpCloseHandle(hFile)
    iVal = WSACleanup()
    Exit Sub
  End If
End If
lRet = IcmpCloseHandle(hFile)
iVal = WSACleanup()
End Sub

Private Function ConvertIPAddressToLong(strAddress As String) As Long
Dim strTemp As String, lAddressAs Long, iValCountAs Integer
Dim lDotValues(1 To 4) As String
On Error Resume Next
strTemp = strAddress
iValCount = 0
While InStr(strTemp, ".") 0
  iValCount = iValCount + 1
  lDotValues(iValCount) = Mid(strTemp, 1, InStr(strTemp, ".") - 1)
  strTemp = Mid(strTemp, InStr(strTemp, ".") + 1)
Wend
iValCount = iValCount + 1
lDotValues(iValCount) = strTemp
If iValCount <> 4 Then
  ConvertIPAddressToLong = 0
  Exit Function
End If
lAddress = Val("&H" & Right("00" & Hex(lDotValues(4)), 2) & _
  Right("00" & Hex(lDotValues(3)), 2) & _
  Right("00" & Hex(lDotValues(2)), 2) & _
  Right("00" & Hex(lDotValues(1)), 2))
ConvertIPAddressToLong = lAddress
End Function

---

you could also do:

Send a packet of data to an IP address and see whether you get a response.

Tip Code

Make a new project. Add a module. To the form add a command button, two text boxes (Text3,Text4) and six text boxe's in a control array Text1(0) tp Text1(5).

Add this code to the 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 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 Integer
wMaxUDPDG As Integer
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 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 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)

HiByte = wParam \ &H1 And &HFF&

End Function


Public Function LoByte(ByVal wParam 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 Function SocketsCleanup() As Boolean

Dim X As Long

X = WSACleanup()

If X <> 0 Then
MsgBox "Windows Sockets error " & Trim$(Str$(X)) & _
" occurred in Cleanup.", vbExclamation
SocketsCleanup = False
Else
SocketsCleanup = True
End If

End Function


Public Function SocketsInitialize() As Boolean

Dim WSAD As WSADATA
Dim X As Integer
Dim szLoByte As String, szHiByte As String, szBuf As String

X = WSAStartup(WS_VERSION_REQD, WSAD)

If X <> 0 Then
MsgBox "Windows Sockets for 32 bit Windows " & _
"environments is not successfully responding."
SocketsInitialize = False
Exit Function
End If

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
SocketsInitialize = False
Exit Function

End If

If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
szBuf = "This application requires a minimum of " & _
Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
MsgBox szBuf, vbExclamation
SocketsInitialize = False
Exit Function
End If

SocketsInitialize = True

End Function

Add this code to the form's General Declarations procedure:
Private Sub Command1_Click()
Dim ECHO As ICMP_ECHO_REPLY
Dim pos As Integer
Call Ping("209.68.48.118", ECHO)
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
End Sub

This is from a tips page that I use regularly

Code:

---


Option Explicit
Private Type ICMPReqOpt
  TTL As Byte ' time-to-live
  tos As Byte ' type-of-service
  flags As Byte ' see below
  optsize As Byte ' length of options string
  options As String ' use empty string (haven't figured this yet)
End Type
Private Type ICMPEchoReply
  Address(1 To 4) As Byte ' address of system responding
  status As Long ' error code
  triptime As Long ' time in milliseconds
  datasize As Integer ' buffer size
  reserved As Integer ' not used
  replydata As String ' buffer returned
  ipoptions As ICMPReqOpt ' options structure
End Type
' ICMP API calls
Private Declare Function IcmpCreateFile Lib "ICMP.DLL" () As Long
Private Declare Function IcmpCloseHandle Lib "ICMP.DLL" _
  (ByVal lngHandle As Long) As Integer
Private Declare Function IcmpSendEcho Lib "ICMP.DLL" _
  (ByVal lngHandle As Long, ByVal lngIP As Long, _
  strData As String, ByVal intDataLen As Integer, _
  usrOpt As ICMPReqOpt, bytBuff As Byte, _
  ByVal lngRepLen As Long, ByVal lngTimeOut As Long) As Long
Private Declare Function IcmpGetLastError Lib "wsock32.dll" _
  Alias "WSAGetLastError" () As Long
' ICMP error codes
Private Const ICMP_SUCCESS = 0
Private Const ICMP_BUFFER_TOO_SMALL = 11001
Private Const ICMP_NET_UNREACHABLE = 11002
Private Const ICMP_HOST_UNREACHABLE = 11003
Private Const ICMP_DEST_PROT_UNREACHABLE = 11004
Private Const ICMP_DEST_PORT_UNREACHABLE = 11005
Private Const ICMP_NO_RESOURCES = 11006
Private Const ICMP_BAD_OPTION = 11007
Private Const ICMP_HW_ERROR = 11008
Private Const ICMP_PACKET_TOO_BIG = 11009
Private Const ICMP_REQ_TIMED_OUT = 11010
Private Const ICMP_BAD_REQ = 11011
Private Const ICMP_BAD_ROUTE = 11012
Private Const ICMP_TTL_EXPIRED_TRANSMIT = 11013
Private Const ICMP_TTL_EXPIRED_REASSEM = 11014
Private Const ICMP_PARAM_PROBLEM = 11015
Private Const ICMP_SOURCE_QUENCH = 11016
Private Const ICMP_OPTION_TOO_BIG = 11017
Private Const ICMP_BAD_DESTINATION = 11018
Private Const ICMP_ADDRESS_DELETED = 11019
Private Const ICMP_SPEC_MTU_CHANGE = 11020
Private Const ICMP_MTU_CHANGE = 11021
Private Const ICMP_UNLOAD = 11022
Private Const ICMP_GENERAL_FAILURE = 11050
Private Const ICMP_PENDING = 11255
' ICMP flags
Private Const ICMP_FLAG_NO_FRAGMENT = 2
' ICMP type-of-service options
Private Const ICMP_ECHO_REQUEST = 7
Private Const ICMP_END_OF_LIST = 0
Private Const ICMP_SECURITY = 1
Private Const ICMP_LOOSE_SOURCE_ROUTE = &H82
Private Const ICMP_STRICT_SOURCE_ROUTE = &H83
Private Const ICMP_RECORD_ROUTE = &H89
Private Const ICMP_TIMESTAMP = 7
Private Const ICMP_STREAM_id = &H44
Private Const ICMP_NOOP = &H88
' we also need some basic Winsock stuff
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128

Private 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
  imaxudp As Integer
  lpszvenderinfo As Long
End Type
Private Declare Function gethostname Lib "wsock32.dll" _
  (ByVal hostname As String, ByVal nbytes As Long) As Long
Private Declare Function gethostbyname Lib "wsock32.dll" _
  (ByVal hostname As String) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" _
  (ByVal VersionReq As Long, WSADataReturn As WSADATA) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
' and a way to copy memory directly...
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (xDest As Any, xSource As Any, ByVal nbytes As Long)
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" _
  (lpString As Any) As Long
' finally, we need a handle for ICMP
Dim hICMP As Long

Private Function TextToIP(IPAddress As String) As Long
Dim x As Integer ' scratch
Dim intOctet As Integer ' octet value
Dim bytIP(1 To 4) As Byte ' temp IP storage
Dim lngIP As Long ' IP value
Dim intDots As Integer ' count of dots found
lngIP = 0
intOctet = 0
intDots = 0
For x = 1 To Len(IPAddress)
  If Mid$(IPAddress, x, 1) = "." Then
    intDots = intDots + 1
    If intDots > 3 Then Exit For ' bad format!
    bytIP(intDots) = intOctet
    intOctet = 0
  Else
    ' add digit but restrict to 8 bits
    intOctet = (intOctet * 10 + Val("0" & Mid$(IPAddress, x, 1))) And 255
  End If
Next 'x
bytIP(4) = intOctet ' save last one
CopyMemory lngIP, bytIP(1), 4 ' copy to LONG value
TextToIP = lngIP ' copy to return value
End Function

Private Function IPToText(ByVal IPAddress As String) As String
IPToText = CStr(Asc(IPAddress)) & "." & _
    CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
    CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
    CStr(Asc(Mid$(IPAddress, 4, 1)))
End Function

Private Function MyHostName() As String
Dim sTemp As String
Dim x As Long
sTemp = Space$(256)
x = gethostname(sTemp, Len(sTemp))
x = InStr(sTemp, vbNullChar)
If x > 0 Then sTemp = Left$(sTemp, x - 1)
MyHostName = sTemp
End Function

Function NameLookup(strName As String) As String
' routine to convert hostname to IP
' this routine actually gets all known aliases
' and IP addresses but only returns the first IP
Dim x As Long ' scratch
Dim nbytes As Long
Dim strTarget As String ' null-delimited hostname
Dim lngHostEnt As Long ' address of hostent structure
Dim lngHEName As Long ' address of name pointer
Dim lngHEAlias As Long ' address of alias pointer
Dim lngHEAddress As Long ' address of address pointer
Dim lngIPpointer As Long ' address of IP address
Dim lngAPointer As Long ' address of Alias

Dim intAliasCount As Long
Dim intAddressCount As Long
Dim strIP() As String
Dim strAlias() As String
Dim strAddress() As String

'default values
intAliasCount = 0
intAddressCount = 0
NameLookup = ""
strTarget = strName & vbNullChar
Debug.Print "Resolve: " & strName
lngHostEnt = gethostbyname(strTarget) ' do actual winsock call
If lngHostEnt = 0 Then
  NameLookup = 0
  Exit Function ' failed!
End If
lngHEName = lngHostEnt ' set pointer addresses
lngHEAlias = lngHostEnt + 4
lngHEAddress = lngHostEnt + 12
' convert addresses of pointers to the pointers...
CopyMemory lngHEName, ByVal lngHEName, 4
CopyMemory lngHEAlias, ByVal lngHEAlias, 4
CopyMemory lngHEAddress, ByVal lngHEAddress, 4

' Get resolved hostname
nbytes = lstrlen(ByVal lngHEName)
If nbytes > 0 Then
  strName = Space$(nbytes)
  CopyMemory ByVal strName, ByVal lngHEName, nbytes
Debug.Print "Full name: " & strName
End If

' get all IP addresses
CopyMemory lngIPpointer, ByVal lngHEAddress, 4
Do While lngIPpointer ' end-of-list is null pointer
  ReDim Preserve strAddress(intAddressCount + 1)
  strAddress(intAddressCount) = Space$(4)
  CopyMemory ByVal strAddress(intAddressCount), ByVal lngIPpointer, 4
Debug.Print "IP address " & CStr(intAddressCount) & _
  ": " & IPToText(strAddress(intAddressCount))
  CopyMemory ByVal lngHEAddress, 0&, 4 ' null for next call
  intAddressCount = intAddressCount + 1
  ' move to next IP
  lngHEAddress = lngHEAddress + 4
  CopyMemory lngIPpointer, ByVal lngHEAddress, 4
Loop

' get any/all aliases
CopyMemory lngAPointer, ByVal lngHEAlias, 4
Do While lngAPointer ' end-of-list is a null
  ReDim Preserve strAlias(intAliasCount + 1)
  nbytes = lstrlen(ByVal lngAPointer)
  strAlias(intAliasCount) = Space$(nbytes)
  CopyMemory ByVal strAlias(intAliasCount), ByVal lngAPointer, nbytes
Debug.Print "Alias " & CStr(intAliasCount) & ": " & _
  strAlias(intAliasCount)
  CopyMemory ByVal lngHEAlias, 0&, 4
  intAliasCount = intAliasCount + 1
  ' move to next IP
  lngHEAlias = lngHEAlias + 4
  CopyMemory lngAPointer, ByVal lngHEAlias, 4
Loop

If intAddressCount > 0 Then
  ' success
  NameLookup = IPToText(strAddress(0))
Else
  NameLookup = "" ' weird!
End If
End Function

Private Sub cmdResolve_Click()
Dim strName As String
Dim strIP As String
strName = txtIP.Text
strIP = NameLookup(strName)
txtIP.Text = strIP
End Sub

Private Sub cmdPing_Click()
Dim lngAddress As Long ' IP address to ping
Dim lngTimeOut As Long ' Timeout in milliseconds
Dim udtIRO As ICMPReqOpt ' ICMP Request Options
Dim udtIER As ICMPEchoReply ' ICMP Response
Dim bytResponse(1 To 4096) As Byte ' response buffer
Dim x As Long ' scratch
' convert IP Address
lngAddress = TextToIP(Trim$(txtIP.Text))
' build request packet
udtIRO.TTL = Val("0" & txtTimeToLive.Text)
udtIRO.tos = ICMP_ECHO_REQUEST ' we want a simple PING
udtIRO.options = "" ' no options...
udtIRO.optsize = Len(udtIRO.options)
udtIRO.flags = ICMP_FLAG_NO_FRAGMENT
' do it
lngTimeOut = Val("0" & txtTimeout.Text)
x = IcmpSendEcho(hICMP, lngAddress, Space$(32), 32, _
  udtIRO, bytResponse(1), UBound(bytResponse), _
  lngTimeOut)
If x = 0 Then
  ' call failed
  lblAddress.Caption = "ICMP ERROR"
  lblError.Caption = CStr(IcmpGetLastError())
Else
  ' copy buffer to structure to make it easier
  CopyMemory udtIER.Address(1), bytResponse(1), LenB(udtIER)
  lblAddress.Caption = CStr(udtIER.Address(1)) & "." & _
    CStr(udtIER.Address(2)) & "." & _
    CStr(udtIER.Address(3)) & "." & _
    CStr(udtIER.Address(4))
  lblError.Caption = CStr(udtIER.status) & ":" & _
    CStr(udtIER.triptime)
End If
End Sub

Private Sub Form_Load()
Dim udtWSAData As WSADATA
Dim x As Long
x = WSAStartup(257, udtWSAData)
If x Then
  MsgBox "Unable to initialize Winsock", vbOKOnly, "Winsock Error"
  Unload Me
  Exit Sub
End If
hICMP = IcmpCreateFile()
If hICMP = 0 Then
  MsgBox "Unable to initialize ICMP", vbOKOnly, "ICMP Error"
  Unload Me
  Exit Sub
End If
txtIP.Text = MyHostName
End Sub

Private Sub Form_Unload(Cancel As Integer)
If hICMP Then IcmpCloseHandle hICMP
WSACleanup
End Sub

---