Excel VBA Ping a设备

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