Hi,
Here's how you do it. It's long but just copy and paste.
Put this code in a standard module:
wtach out for your newsreader adding line breaks
Option Compare Database
Option Explicit
Public Const NERR_SUCCESS As Long = 0&
Private Const NO_ERROR = 0
Public Const WSADESCRIPTION_LEN As Long = 256
Public Const WSASYS_STATUS_LEN As Long = 128
Public Const WS_VERSION_REQD As Long = &H101
Public Const IP_SUCCESS As Long = 0
Public Const PING_TIMEOUT As Long = 500
Public Const INADDR_NONE As Long = &HFFFFFFFF
Public Const SOCKET_ERROR As Long = -1
Public Const AF_INET As Long = 2
Private 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 WSADESCRIPTION_LEN) As Byte
szSystemStatus(0 To WSASYS_STATUS_LEN) As Byte
iMaxSockets As Integer
imaxudp As Integer
lpszvenderinfo As Long
End Type
Public Declare Function WSAStartup Lib "wsock32" _
(ByVal VersionReq As Long, _
WSADataReturn As WSAData) As Long
Public Declare Function WSACleanup Lib "wsock32" () As Long
Public Declare Function inet_addr Lib "wsock32" _
(ByVal s As String) As Long
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 Function SocketsInitialize() As Boolean
Dim WSAD As WSAData
SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function
Public Sub SocketsCleanup()
If WSACleanup() <> 0 Then
MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
End If
End Sub
Public Function fPing(sAddress As String, _
sDataToSend As String, _
ECHO As ICMP_ECHO_REPLY) As Long
'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
fPing = ECHO.status
Call IcmpCloseHandle(hPort)
End If
Else:
'the address format was probably invalid
fPing = INADDR_NONE
End If
End Function
Okay, now this code goes in your command buttons click event:
Dim ECHO As ICMP_ECHO_REPLY
Dim Success As Long
If SocketsInitialize() Then
'ping the ip passing the address, text
'to send, and the ECHO structure.
Success = fPing(("132.223.114.8"), ("test"), ECHO)
SocketsCleanup
If Success = IP_SUCCESS Then
'continue on
Me.Text1 = "Reply from 132.223.114.8" & vbCrLf & _
ECHO.RoundTripTime & "ms"
Else
Me.Text1 = "No Reply from 132.223.114.8"
End If
Else
MsgBox "Windows Sockets for 32 bit Windows " & _
"environments is not successfully responding"
End If
All you have to do is replace Text1 with your text box and substitute a variable for
the ip instead of hard coding it.
