ＶＢでpingを打って応答を返すにはどのようにやればよいのでしょうか？

> ＶＢでpingを打って応答を返すにはどのようにやればよいのでしょうか？

Win32_PingStatus クラスを使ってみては如何でしょう。


Option Explicit

Private Sub Form_Load()
    Text1.Text = "127.0.0.1"
    Label1.Caption = ""
End Sub

Private Sub Command1_Click()
    Dim ServerName As String
    ServerName = Replace(Text1.Text, "\", "\\")
    ServerName = Replace(ServerName, "'", "\'")

    Dim WQL As String
    WQL = "SELECT * FROM Win32_PingStatus WHERE Address='" & ServerName & "'"

    Dim Ping As Object
    For Each Ping In GetObject("winmgmts:").ExecQuery(WQL)
        Select Case Ping.StatusCode
          Case 0
            Label1.Caption = "成功"
          Case 11010
            Label1.Caption = "タイムアウト"
          Case Else
            Label1.Caption = "その他のエラー"
        End Select
    Next
End Sub

レスありがとうございます！
応答を返すことが出来ました。

IcmpSendEchoを使ってpingの応答時間を表示させたいのですが、「0」と表示してしまいます。
RoundTripTimeはLong型で宣言してあります。何が悪いのでしょうか…

Public Function Ping_Click(f_form As Object, msg_str As String)
    Dim hFile       As Long             ' handle
    Dim lRet        As Long
    Dim lIPAddress  As Long
    Dim strMessage  As String
    Dim pOptions    As ip_option_information
    Dim pReturn     As icmp_echo_reply
    Dim iVal        As Integer
    Dim lPingRet    As Long
    Dim pWsaData    As tagWSAData
'    Dim msg_str As String
    
    '送信するメッセージのセット  これは何でもよい。
    strMessage = "Echo data"
    'ソケットのオープン
    iVal = WSAStartup(&H101, pWsaData)
    
    'ＩＰアドレスを999.999.999.999の形式から10進数への変換
    lIPAddress = inet_addr(txIPAddress)
    
    'ハンドルの確保
    hFile = IcmpCreateFile()
    
    'TTLのセット 1 to 255の範囲で設定
    pOptions.Ttl = 5
    
    'pingパケットを流す。
    lRet = IcmpSendEcho(hFile, lIPAddress, strMessage, Len(strMessage), pOptions, pReturn, Len(pReturn), PING_TIMEOUT)
    
    
    
    If lRet = 0 Then
        ' 戻り値0はエラー
'        MsgBox "Pingは失敗しました。"
'        f_form.Label4.Caption = "Pingは失敗しました。"
        f_form.Text2.Text = f_form.Text2.Text & "time=" & CStr(pReturn.RoundTripTime) & "ms  " & "タイムアウト" & vbCrLf
    Else
        'ステータスが何かあったらエラー
        If pReturn.Status <> 0 Then
'            MsgBox "Pingは失敗しました。"
'            f_form.Label4.Caption = "Pingは失敗しました。"
            f_form.Text2.Text = f_form.Text2.Text & "time=" & CStr(pReturn.RoundTripTime) & "ms  " & "pingエラー" & vbCrLf
        Else
'            MsgBox "Pingは成功しました。"
'            f_form.Label4.Caption = "Pingは成功しました。"
'            MsgBox "Pingは成功しました。"
            f_form.Text2.Text = f_form.Text2.Text & "time=" & CStr(pReturn.RoundTripTime) & "ms  " & "ping成功" & vbCrLf
        End If
    End If
                        
    'ハンドルの開放
    lRet = IcmpCloseHandle(hFile)
    'ソケットのクローズ
    iVal = WSACleanup()
    

End Function