Question

I called IcmpSendEcho in VB6 to test Ethernet protocol of one device. MTU for Ethernet is 1500 bytes, so I tried to send 1500bytes, but VB6 won't let me do so. It only allows me to send 1014, and when I sent 1014 bytes, then IcmpSendEcho gives me error of General Failure.

When I sent 250bytes, it worked fine, but if I send more than 250 byte, it gives me error (General Failure)

I can't figure out the problem. Ethernet Protocol can handle upto 1500 bytes, but mine can't even go upto 250 bytes. Is there anyway to debug or solve this problem?

  Private 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 ping(sAddress As String, Reply As ICMP_ECHO_REPLY) As Long

    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


'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  
'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, Len(Reply), lTimeOut)

    'Reply status
    ping = Reply.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
Was it helpful?

Solution

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
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top