Question

我一直在寻找一种方法来ping网络上的设备而不进行炮击（不要真的希望用户看到试图仅ping结果的东西），我想要类似下面的过程。

Sub pingdevice(myip As String)
Dim Pingable As Boolean

   'Code here to ping device using myip variable and return result true or false to pingable variable

   If Pingable = True Then
      'Do Something
   Else
      msgbox "Device not pingable"
   End IF
End Sub

Answer 1

没关系，在同一件事之后为任何人找到我的答案代码

Option Explicit

Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long

Private Declare Function inet_addr Lib "WSOCK32.DLL" (ByVal cp As String) 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 Type IP_OPTION_INFORMATION
   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
   Reserved        As Integer
   ptrData                 As Long
   Options        As IP_OPTION_INFORMATION
   data            As String * 250
End Type

Public Function Ping(strAddress As String, Reply As ICMP_ECHO_REPLY) As Boolean

Dim hIcmp As Long
Dim lngAddress As Long
Dim lngTimeOut As Long
Dim strSendText As String

'Short string of data to send
strSendText = "blah"

' timeout value in ms
lngTimeOut = 1000

'Convert string address to a long
lngAddress = inet_addr(strAddress)

If (lngAddress <> -1) And (lngAddress <> 0) Then

    hIcmp = IcmpCreateFile()

    If hIcmp <> 0 Then
        'Ping the destination IP
        Call IcmpSendEcho(hIcmp, lngAddress, strSendText, Len(strSendText), 0, Reply, Len(Reply), lngTimeOut)

        'Reply status
        Ping = (Reply.Status = 0)

        'Close the Icmp handle.
        IcmpCloseHandle hIcmp
    Else
        Ping = False
    End If
Else
    Ping = False
End If

End Function

Sub TestPinger()
   Dim pingable As Boolean, lngStatus As ICMP_ECHO_REPLY
   pingable = Ping("192.168.1.101", lngStatus)
   MsgBox pingable
End Sub

Excel VBA Ping设备

1 个答案: