Your code wasn't immediately runnable, so I had to work out all the missing definitions from the Win32 documentation. You also have made some mistakes in the definition of IcmpSendEcho(). The RequestSize parameter is defined as:
_ In _ WORD RequestSize,
... which is equivalent to VB6's Integer type, not Long.
However, the main issue is probably to do with you not allocating enough space for the ReplyBuffer. It is not obvious from your sample as to how you allocated this buffer. The specification actually asks for an array of ICMP_ECHO_REPLY, followed by extra data. To make sure this would definitely work, I created a new type, ReplyBuffer, and allocating more space than I would ever need:
Private Const m_knImcpEchoReplyCount As Long = 8
Private Const m_knReplyDataSize As Long = 4096
Public Type ReplyBuffer
IER(1 To m_knImcpEchoReplyCount) As IMCP_ECHO_REPLY
Data(1 To m_knReplyDataSize) As Byte
End Type
I then pass ReplyBuffer := uReplyBuffer.IER(1) and ReplySize := LenB(uReplyBuffer) when calling IcmpSendEcho().
Fiddle with the two constants until you are comfortable with this. You probably only need to set m_knImcpEchoReplyCount to 1. As for m_knReplyDataSize, this needs to be bigger than the largest string you send.
My full code is as follows:
Option Explicit
Public Enum PingStatus
IP_SUCCESS = 0
IP_BUF_TOO_SMALL = 11001
IP_DEST_NET_UNREACHABLE = 11002
IP_DEST_HOST_UNREACHABLE = 11003
IP_DEST_PROT_UNREACHABLE = 11004
IP_DEST_PORT_UNREACHABLE = 11005
IP_NO_RESOURCES = 11006
IP_BAD_OPTION = 11007
IP_HW_ERROR = 11008
IP_PACKET_TOO_BIG = 11009
IP_REQ_TIMED_OUT = 11010
IP_BAD_REQ = 11011
IP_BAD_ROUTE = 11012
IP_TTL_EXPIRED_TRANSIT = 11013
IP_TTL_EXPIRED_REASSEM = 11014
IP_PARAM_PROBLEM = 11015
IP_SOURCE_QUENCH = 11016
IP_OPTION_TOO_BIG = 11017
IP_BAD_DESTINATION = 11018
IP_GENERAL_FAILURE = 11050
End Enum
Public Type IPAddr
s_b1 As Byte
s_b2 As Byte
s_b3 As Byte
s_b4 As Byte
End Type
Public Type IP_OPTION_INFORMATION
Ttl As Byte
Tos As Byte
Flags As Byte
OptionsSize As Byte
OptionsData As Long
End Type
Public Type IMCP_ECHO_REPLY
Address As IPAddr
Status As PingStatus
RoundTripTime As Long
DataSize As Integer
Reserved As Integer
Data As Long
Options As IP_OPTION_INFORMATION
End Type
Private Const m_knImcpEchoReplyCount As Long = 8
Private Const m_knReplyDataSize As Long = 4096
Public Type ReplyBuffer
IER(1 To m_knImcpEchoReplyCount) As IMCP_ECHO_REPLY
Data(1 To m_knReplyDataSize) As Byte
End Type
Private 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, _
ByRef ReplyBuffer As IMCP_ECHO_REPLY, _
ByVal ReplySize As Long, _
ByVal Timeout As Long) As Long
Private Declare Function inet_addr Lib "Ws2_32.dll" ( _
ByVal cp As String _
) As Long
Private Declare Function IcmpCreateFile Lib "Iphlpapi.dll" () As Long
Private Declare Function IcmpCloseHandle Lib "Iphlpapi.dll" (ByVal IcmpHandle As Long) As Long
Public Function Ping(sAddress As String, Reply As ReplyBuffer) As PingStatus
Dim hIcmp As Long
Dim lAddress As Long
Dim lTimeOut As Long
Dim StringToSend As String
Dim PingOutput As String 'Variable that shows Ping status Dim Index As Integer
Dim Index As Long
'Short string of data to send
'400byte
'StringToSend = "ddd...." 'First of all I can't put more than 1014 characters in string.
'Secondly, "ddd..." is just example, putting 1014 will make it so messy
' I declared
StringToSend = String$(2048, 32)
'ICMP (ping) timeout
lTimeOut = 1000 'ms
'Convert string address to a long representation.
lAddress = inet_addr(sAddress)
If (lAddress <> -1) And (lAddress <> 0) Then
'Create the handle for ICMP requests.
hIcmp = IcmpCreateFile()
Do
If hIcmp Then
'Ping the destination IP address.
Call IcmpSendEcho(hIcmp, lAddress, StringToSend, Len(StringToSend), 0, Reply.IER(1), LenB(Reply), lTimeOut)
'Reply status
Ping = Reply.IER(1).Status
PingOutput = EvaluatePingResponse(Ping)
If Ping = 0 Then
Index = Index + 1
Else
MsgBox (PingOutput)
Exit Do
End If
'Close the Icmp handle.
'IcmpCloseHandle hIcmp
Else
Debug.Print "failure opening icmp handle."
Ping = -1
End If
Loop Until (Index > 1000)
'Close the Icmp handle.
IcmpCloseHandle hIcmp
Else
Ping = -1
End If
End Function
Private Function EvaluatePingResponse(ByVal Ping As PingStatus) As String
Select Case Ping
Case IP_SUCCESS
EvaluatePingResponse = "The status was success."
Case IP_BUF_TOO_SMALL
EvaluatePingResponse = "The reply buffer was too small."
Case IP_DEST_NET_UNREACHABLE
EvaluatePingResponse = "The destination network was unreachable."
Case IP_DEST_HOST_UNREACHABLE
EvaluatePingResponse = "The destination host was unreachable."
Case IP_DEST_PROT_UNREACHABLE
EvaluatePingResponse = "The destination protocol was unreachable."
Case IP_DEST_PORT_UNREACHABLE
EvaluatePingResponse = "The destination port was unreachable."
Case IP_NO_RESOURCES
EvaluatePingResponse = "Insufficient IP resources were available."
Case IP_BAD_OPTION
EvaluatePingResponse = "A bad IP option was specified."
Case IP_HW_ERROR
EvaluatePingResponse = "A hardware error occurred."
Case IP_PACKET_TOO_BIG
EvaluatePingResponse = "The packet was too big."
Case IP_REQ_TIMED_OUT
EvaluatePingResponse = "The request timed out."
Case IP_BAD_REQ
EvaluatePingResponse = "A bad request."
Case IP_BAD_ROUTE
EvaluatePingResponse = "A bad route."
Case IP_TTL_EXPIRED_TRANSIT
EvaluatePingResponse = "The time to live (TTL) expired in transit."
Case IP_TTL_EXPIRED_REASSEM
EvaluatePingResponse = "The time to live expired during fragment reassembly."
Case IP_PARAM_PROBLEM
EvaluatePingResponse = "A parameter problem."
Case IP_SOURCE_QUENCH
EvaluatePingResponse = "Datagrams are arriving too fast to be processed and datagrams may have been discarded."
Case IP_OPTION_TOO_BIG
EvaluatePingResponse = "An IP option was too big."
Case IP_BAD_DESTINATION
EvaluatePingResponse = "A bad destination."
Case IP_GENERAL_FAILURE
EvaluatePingResponse = "A general failure. This error can be returned for some malformed ICMP packets."
End Select
End Function