IcmpSendEcho2 doesn't fill buffer

[goppi]

Hi,

I've got a tricky problem and am already working hours on it to solve it. Maybe I'm blind already, but I just can't find out what the problem is. I've got a nice piece of Excel Workbook with which I can scan and inventory devices on the network. to see what is on the network I currently use IcmpSendEcho, but depending on how big the network is it takes a while until the Pings run into a timeout. So instead of using IcmpSendEcho I tried to use IcmpSendEcho2. Basically the same funcitonality, but the function returns immediately and raises an event as soon as it has received the reply or run into time-out. So far so good - the only problem I have is that for whatever reason it doesn't fill the buffer with data. My guess is that this is because I haven't declared the API functions correctly and therefore the API writes the data to the wrong memory location. I don't think that the function itself has a bug. I didn't find a lot of pages on the internet relating to IcmpSendEcho2, but the ones that have used it seems not to have any problem.

Here is a test- code for both - btw, the functions are a quite nice solution for pings...


And just to clarify in advance - the IcmpSendEcho works perfectly - I only inlcuded it here in the test file so that you can compare the results.

IP Addresses are random ones - you need to change them if you want to test it.

Private Const PING_TIMEOUT As Long = 2000 'Wait 2 secs
 
Private Type ICMP_OPTIONS 
    ttl             As Byte 
    Tos             As Byte 
    Flags           As Byte 
    OptionsSize     As Byte 
    OptionsData     As Long 
End Type 
 
Private Type ICMP_ECHO_REPLY 
    Address         As Long 
    Status          As Long 
    RoundTripTime   As Long 
    datasize        As Long 
    DataPointer     As Long 
    Options         As ICMP_OPTIONS 
    Data            As String * 250 
End Type 
 
Public Type SECURITY_ATTRIBUTES 
    nLength As Long 
    lpSecurityDescriptor As Long 
    bInheritHandle As Long 
End Type 
 
Public Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As SECURITY_ATTRIBUTES, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long 
Public Declare Function WaitForMultipleObjects Lib "kernel32" (ByVal nCount As Long, lpHandles As Long, ByVal bWaitAll As Long, ByVal dwMilliseconds As Long) As Long 
Public Declare Function ResetEvent Lib "kernel32" (ByVal hEvent As Long) As Long 
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long 
 
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long 
Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long 
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 
Private Declare Function IcmpSendEcho2 Lib "icmp.dll" (ByVal IcmpHandle As Long, ByVal hEvent As Long, ByVal ApcRoutine As Any, _ 
ByVal ApcContext 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 
 
Private Declare Function inet_addr Lib "wsock32.dll" (ByVal s As String) As Long 
Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal addr As Long) As Long 
 
 
Sub test1() 
    Const sSendData As String = "TESTMESSAGE" 
    Dim buffer As ICMP_ECHO_REPLY 
    Dim lhwndPort As Long 
     
    lhwndPort = IcmpCreateFile 
    Cells(1, 1) = "Pinging 10.10.11.1 using IcmpSendEcho" 
    If IcmpSendEcho(lhwndPort, inet_addr("10.10.11.1"), sSendData, Len(sSendData), _ 
    0, buffer, Len(buffer), PING_TIMEOUT) <> 0 Then 
    Cells(1, 2) = buffer.Address 
Else 
    Cells(1, 2) = "Failed" 
End If 
End Sub 
 
 
Sub test2() 
    Const sSendData As String = "TESTMESSAGE" 
    Dim buffer As ICMP_ECHO_REPLY 
    Dim lhwndPort As Long 
    Dim hEvent As Long 
    Dim sd As SECURITY_ATTRIBUTES 
     
    With sd 
        .nLength = Len(sd) 'we pass the length of sd
        .lpSecurityDescriptor = 0 
        .bInheritHandle = 0 
    End With 
     
    hEvent = CreateEvent(sd, True, False, "PING2") 
     
    lhwndPort = IcmpCreateFile 
    Cells(2, 1) = "Pinging 10.10.11.1 using IcmpSendEcho2" 
    Call IcmpSendEcho2(lhwndPort, hEvent, 0&, 0, inet_addr("10.10.11.1"), sSendData, Len(sSendData), _ 
    0, buffer, Len(buffer), PING_TIMEOUT) 
    If WaitForMultipleObjects(1, hEvent, True, 10000) = 0 Then 
        Cells(2, 2) = buffer.Address 
    Else 
        Cells(2, 2) = "Failed" 
    End If 
End Sub

Hope somebody can help me...

goppi.

[goppi]

Solved it alrady... - it had to do with the buffer pointer

I changed the declaration to

Private Declare Function IcmpSendEcho2 Lib "icmp.dll" ( _
  ByVal IcmpHandle As Long, _
  ByVal hEvent As Long, _
  ByVal ApcRoutine As Any, _
  ByVal ApcContext As Long, _
  ByVal DestinationAddress As Long, _
  ByVal RequestData As String, _
  ByVal RequestSize As Long, _
  ByVal RequestOptions As Long, _
  ByVal ReplyBuffer As Long, _
  ByVal ReplySize As Long, _
  ByVal Timeout As Long) As Long

.. and the call to

IcmpSendEcho2(lhwndPort, hEvent, 0, 0, inet_addr("10.10.11.1"), sSendData, Len(sSendData), 0, VarPtr(buffer), Len(buffer), 10000)

The trick is the undocumented VBA routine VarPtr.

Goppi