有API可以ping别人吗,谢谢指教

解决方案 »

  1.   

    用单个的API当然做不到了,主要是用scoket编程,用什么API是次要的.去找找相关的文档,关键是如何构建IP头,填充一系列的数据结构.网上这种代码还是很多的.
      

  2.   

    对,ping是一堆Socket API实现的。VB高级网络编程书上一般都有的。
      

  3.   

    我看做一个死循环批处理来ping 更好。
      

  4.   

    如果不想做网络编程方面的,直接调用ping命令吧,相关的信息可以从建立管道从控制台里提取.类似的代码坛子里很多的.
      

  5.   

    ping主要是用ICMPSendData这个api,当然还要初始化,等
      

  6.   

    用SHELL函数来调用PING程序不知道可不可行
      

  7.   

    'BAS Module Code  Option Explicit
    Private Const IP_SUCCESS As Long = 0
    Private Const IP_STATUS_BASE As Long = 11000
    Private Const IP_BUF_TOO_SMALL As Long = (11000 + 1)
    Private Const IP_DEST_NET_UNREACHABLE As Long = (11000 + 2)
    Private Const IP_DEST_HOST_UNREACHABLE As Long = (11000 + 3)
    Private Const IP_DEST_PROT_UNREACHABLE As Long = (11000 + 4)
    Private Const IP_DEST_PORT_UNREACHABLE As Long = (11000 + 5)
    Private Const IP_NO_RESOURCES As Long = (11000 + 6)
    Private Const IP_BAD_OPTION As Long = (11000 + 7)
    Private Const IP_HW_ERROR As Long = (11000 + 8)
    Private Const IP_PACKET_TOO_BIG As Long = (11000 + 9)
    Private Const IP_REQ_TIMED_OUT As Long = (11000 + 10)
    Private Const IP_BAD_REQ As Long = (11000 + 11)
    Private Const IP_BAD_ROUTE As Long = (11000 + 12)
    Private Const IP_TTL_EXPIRED_TRANSIT As Long = (11000 + 13)
    Private Const IP_TTL_EXPIRED_REASSEM As Long = (11000 + 14)
    Private Const IP_PARAM_PROBLEM As Long = (11000 + 15)
    Private Const IP_SOURCE_QUENCH As Long = (11000 + 16)
    Private Const IP_OPTION_TOO_BIG As Long = (11000 + 17)
    Private Const IP_BAD_DESTINATION As Long = (11000 + 18)
    Private Const IP_ADDR_DELETED As Long = (11000 + 19)
    Private Const IP_SPEC_MTU_CHANGE As Long = (11000 + 20)
    Private Const IP_MTU_CHANGE As Long = (11000 + 21)
    Private Const IP_UNLOAD As Long = (11000 + 22)
    Private Const IP_ADDR_ADDED As Long = (11000 + 23)
    Private Const IP_GENERAL_FAILURE As Long = (11000 + 50)
    Private Const MAX_IP_STATUS As Long = (11000 + 50)
    Private Const IP_PENDING As Long = (11000 + 255)
    Private Const PING_TIMEOUT As Long = 500
    Private Const WS_VERSION_REQD As Long = &H101
    Private Const MIN_SOCKETS_REQD As Long = 1
    Private Const SOCKET_ERROR As Long = -1
    Private Const INADDR_NONE As Long = &HFFFFFFFF
    Private Const MAX_WSADescription As Long = 256
    Private Const MAX_WSASYSStatus As Long = 128Private Type ICMP_OPTIONS
        Ttl             As Byte
        Tos             As Byte
        Flags           As Byte
        OptionsSize     As Byte
        OptionsData     As Long
    End TypePublic Type ICMP_ECHO_REPLY
        Address         As Long
        status          As Long
        RoundTripTime   As Long
        DataSize        As Long 'formerly integer
       'Reserved        As Integer
        DataPointer     As Long
        Options         As ICMP_OPTIONS
        Data            As String * 250
    End TypePrivate Type WSADATA
       wVersion As Integer
       wHighVersion As Integer
       szDescription(0 To MAX_WSADescription) As Byte
       szSystemStatus(0 To MAX_WSASYSStatus) As Byte
       wMaxSockets As Long
       wMaxUDPDG As Long
       dwVendorInfo As Long
    End TypePrivate Declare Function IcmpCreateFile Lib "icmp.dll" () As LongPrivate 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 WSAGetLastError Lib "wsock32" () As LongPrivate Declare Function WSAStartup Lib "wsock32" _
       (ByVal wVersionRequired As Long, _
        lpWSADATA As WSADATA) As Long
        
    Private Declare Function WSACleanup Lib "wsock32" () As LongPrivate Declare Function gethostname Lib "wsock32" _
       (ByVal szHost As String, _
        ByVal dwHostLen As Long) As Long
        
    Private Declare Function gethostbyname Lib "wsock32" _
       (ByVal szHost As String) As LongPrivate Declare Sub CopyMemory Lib "kernel32" _
       Alias "RtlMoveMemory" _
      (xDest As Any, _
       xSource As Any, _
       ByVal nbytes As Long)
       
    Private Declare Function inet_addr Lib "wsock32" _
       (ByVal s As String) As Long
        Public Function GetStatusCode(status As Long) As String   Dim msg As String
       
       Select Case status
          Case IP_SUCCESS:               msg = "ip success"
          Case INADDR_NONE:              msg = "inet_addr: bad IP format"
          Case IP_BUF_TOO_SMALL:         msg = "ip buf too_small"
          Case IP_DEST_NET_UNREACHABLE:  msg = "ip dest net unreachable"
          Case IP_DEST_HOST_UNREACHABLE: msg = "ip dest host unreachable"
          Case IP_DEST_PROT_UNREACHABLE: msg = "ip dest prot unreachable"
          Case IP_DEST_PORT_UNREACHABLE: msg = "ip dest port unreachable"
          Case IP_NO_RESOURCES:          msg = "ip no resources"
          Case IP_BAD_OPTION:            msg = "ip bad option"
          Case IP_HW_ERROR:              msg = "ip hw_error"
          Case IP_PACKET_TOO_BIG:        msg = "ip packet too_big"
          Case IP_REQ_TIMED_OUT:         msg = "ip req timed out"
          Case IP_BAD_REQ:               msg = "ip bad req"
          Case IP_BAD_ROUTE:             msg = "ip bad route"
          Case IP_TTL_EXPIRED_TRANSIT:   msg = "ip ttl expired transit"
          Case IP_TTL_EXPIRED_REASSEM:   msg = "ip ttl expired reassem"
          Case IP_PARAM_PROBLEM:         msg = "ip param_problem"
          Case IP_SOURCE_QUENCH:         msg = "ip source quench"
          Case IP_OPTION_TOO_BIG:        msg = "ip option too_big"
          Case IP_BAD_DESTINATION:       msg = "ip bad destination"
          Case IP_ADDR_DELETED:          msg = "ip addr deleted"
          Case IP_SPEC_MTU_CHANGE:       msg = "ip spec mtu change"
          Case IP_MTU_CHANGE:            msg = "ip mtu_change"
          Case IP_UNLOAD:                msg = "ip unload"
          Case IP_ADDR_ADDED:            msg = "ip addr added"
          Case IP_GENERAL_FAILURE:       msg = "ip general failure"
          Case IP_PENDING:               msg = "ip pending"
          Case PING_TIMEOUT:             msg = "ping timeout"
          Case Else:                     msg = "unknown  msg returned"
       End Select
       
       GetStatusCode = CStr(status) & "   [ " & msg & " ]"
       
    End FunctionPublic Function Ping(sAddress As String, _
                         sDataToSend As String, _
                         ECHO As ICMP_ECHO_REPLY) As Long  'If Ping succeeds :
      '.RoundTripTime = time in ms for the ping to complete,
      '.Data is the data returned (NULL terminated)
      '.Address is the Ip address that actually replied
      '.DataSize is the size of the string in .Data
      '.Status will be 0
      '
      'If Ping fails .Status will be the error code
       
       Dim hPort As Long
       Dim dwAddress As Long
       
      'convert the address into a long representation
       dwAddress = inet_addr(sAddress)
       
      'if a valid address..
       If dwAddress <> INADDR_NONE Then
       
         'open a port
          hPort = IcmpCreateFile()
          
         'and if successful,
          If hPort Then
          
            'ping it.
             Call IcmpSendEcho(hPort, _
                               dwAddress, _
                               sDataToSend, _
                               Len(sDataToSend), _
                               0, _
                               ECHO, _
                               Len(ECHO), _
                               PING_TIMEOUT)        'return the status as ping succes and close
             Ping = ECHO.status
             Call IcmpCloseHandle(hPort)
          
          End If  
          
       Else:
            'the address format was probably invalid
             Ping = INADDR_NONE
             
       End If
      
    End Function
       Public Sub SocketsCleanup()
       
       If WSACleanup() <> 0 Then
           MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
       End If
        
    End SubPublic Function SocketsInitialize() As Boolean
       Dim WSAD As WSADATA   
       SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS    
    End Function
      

  8.   

    Form Code 
      
    To a form add a command button (Command1), two text boxes (Text1, Text2) to the top of the form, and six text boxes in a control array (Text4(0) - Text4(5)) below. The labels are optional. Add the following to the form:  
    Option ExplicitPrivate Sub Command1_Click()
       
       Dim ECHO As ICMP_ECHO_REPLY
       Dim pos As Long
       Dim success As Long
       
       If SocketsInitialize() Then
       
         'ping the ip passing the address, text
         'to send, and the ECHO structure.
          success = Ping((Text1.Text), (Text2.Text), ECHO)
          
         'display the results
          Text4(0).Text = GetStatusCode(success)
          Text4(1).Text = ECHO.Address
          Text4(2).Text = ECHO.RoundTripTime & " ms"
          Text4(3).Text = ECHO.DataSize & " bytes"
          
          If Left$(ECHO.Data, 1) <> Chr$(0) Then
             pos = InStr(ECHO.Data, Chr$(0))
             Text4(4).Text = Left$(ECHO.Data, pos - 1)
          End If
       
          Text4(5).Text = ECHO.DataPointer
          
          SocketsCleanup
          
       Else
       
            MsgBox "Windows Sockets for 32 bit Windows " & _
                   "environments is not successfully responding."
       
       End If
       
    End Sub