请问用shell+ping,如果让VB自动判断局域网内某台机器是否连上??

解决方案 »

  1.   

    我用 shell "ping xxx.xxx.xxx",vbhide 能进行ping操作,但是我想让VB来自动判断是否连通,请高手赐教如何实现,谢谢.
      

  2.   

    给你一个纯VB PING模块Option ExplicitPrivate Const IP_STATUS_BASE = 11000
    Private Const IP_SUCCESS = 0
    Private Const IP_BUF_TOO_SMALL = (11000 + 1)
    Private Const IP_DEST_NET_UNREACHABLE = (11000 + 2)
    Private Const IP_DEST_HOST_UNREACHABLE = (11000 + 3)
    Private Const IP_DEST_PROT_UNREACHABLE = (11000 + 4)
    Private Const IP_DEST_PORT_UNREACHABLE = (11000 + 5)
    Private Const IP_NO_RESOURCES = (11000 + 6)
    Private Const IP_BAD_OPTION = (11000 + 7)
    Private Const IP_HW_ERROR = (11000 + 8)
    Private Const IP_PACKET_TOO_BIG = (11000 + 9)
    Private Const IP_REQ_TIMED_OUT = (11000 + 10)
    Private Const IP_BAD_REQ = (11000 + 11)
    Private Const IP_BAD_ROUTE = (11000 + 12)
    Private Const IP_TTL_EXPIRED_TRANSIT = (11000 + 13)
    Private Const IP_TTL_EXPIRED_REASSEM = (11000 + 14)
    Private Const IP_PARAM_PROBLEM = (11000 + 15)
    Private Const IP_SOURCE_QUENCH = (11000 + 16)
    Private Const IP_OPTION_TOO_BIG = (11000 + 17)
    Private Const IP_BAD_DESTINATION = (11000 + 18)
    Private Const IP_ADDR_DELETED = (11000 + 19)
    Private Const IP_SPEC_MTU_CHANGE = (11000 + 20)
    Private Const IP_MTU_CHANGE = (11000 + 21)
    Private Const IP_UNLOAD = (11000 + 22)
    Private Const IP_ADDR_ADDED = (11000 + 23)
    Private Const IP_GENERAL_FAILURE = (11000 + 50)
    Private Const MAX_IP_STATUS = 11000 + 50
    Private Const IP_PENDING = (11000 + 255)
    Private Const PING_TIMEOUT = 200
    Private Const WS_VERSION_REQD = &H101
    Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
    Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
    Private Const MIN_SOCKETS_REQD = 1
    Private Const SOCKET_ERROR = -1Private Const MAX_WSADescription = 256
    Private Const MAX_WSASYSStatus = 128Private Type ICMP_OPTIONS
        Ttl             As Byte
        Tos             As Byte
        Flags           As Byte
        OptionsSize     As Byte
        OptionsData     As Long
    End Type
    Private ICMPOPT As ICMP_OPTIONSPrivate Type ICMP_ECHO_REPLY
        Address         As Long
        status          As Long
        RoundTripTime   As Long
        DataSize        As Integer
        Reserved        As Integer
        DataPointer     As Long
        Options         As ICMP_OPTIONS
        Data            As String * 250
    End TypePrivate Type HOSTENT
        hName           As Long
        hAliases        As Long
        hAddrType       As Integer
        hLen            As Integer
        hAddrList       As Long
    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 Integer
        wMaxUDPDG       As Integer
        dwVendorInfo    As Long
    End Type
    Private 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 Integer, _
    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.DLL" () As LongPrivate Declare Function WSAStartup Lib "WSOCK32.DLL" _
    (ByVal wVersionRequired As Long, _
    lpWSADATA As WSADATA) As Long
        
    Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As LongPrivate Declare Function gethostname Lib "WSOCK32.DLL" _
    (ByVal szHost As String, _
    ByVal dwHostLen As Long) As Long
        
    Private Declare Function gethostbyname Lib "WSOCK32.DLL" _
    (ByVal szHost As String) As Long
       
    Private Declare Sub RtlMoveMemory Lib "kernel32" _
    (hpvDest As Any, _
    ByVal hpvSource As Long, _
    ByVal cbCopy As Long)Public m As ICMP_ECHO_REPLY
      

  3.   

    Private Function GetStatusCode(status As Long) As String    Dim msg As String
        
        'Message Boxes
        Select Case status
            Case IP_SUCCESS:               msg = "IP Successful"
            Case IP_BUF_TOO_SMALL:         msg = "IP Buffer Too Small"
            Case IP_DEST_NET_UNREACHABLE:  msg = "IP Destination Net Unreachable"
            Case IP_DEST_HOST_UNREACHABLE: msg = "IP Destination Host Unreachable"
            Case IP_DEST_PROT_UNREACHABLE: msg = "IP Destination Protocol Unreachable"
            Case IP_DEST_PORT_UNREACHABLE: msg = "IP Destination 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 currently timed out"
            Case IP_BAD_REQ:               msg = "IP Bad Request"
            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 Parameter 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 Address 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 Message Returned!"
        End Select
        
        GetStatusCode = CStr(status) & "   [ " & msg & " ]"
       
    End FunctionPrivate Function HiByte(ByVal wParam As Integer)
        HiByte = wParam \ &H100 And &HFF&
    End FunctionPrivate Function LoByte(ByVal wParam As Integer)
        LoByte = wParam And &HFF&
    End FunctionPublic Function PingIPAddress(szAddress As String, ECHO As ICMP_ECHO_REPLY) As Long '以IP地址方式检测计算机是否在线    Dim hPort        As Long
        Dim dwAddress    As Long
        Dim sDataToSend  As String
        Dim iOpt         As Long
           
        sDataToSend = "Echo This"
        dwAddress = AddressStringToLong(szAddress)
           
        Call SocketsInitialize
            hPort = IcmpCreateFile()
               
        If IcmpSendEcho(hPort, _
            dwAddress, _
            sDataToSend, _
            Len(sDataToSend), _
            0, _
            ECHO, _
            Len(ECHO), _
            PING_TIMEOUT) Then
            PingIPAddress = ECHO.RoundTripTime
            Else: PingIPAddress = ECHO.status * -1
        End If
                               
        Call IcmpCloseHandle(hPort)
        Call SocketsCleanup
       
    End Function
       Function AddressStringToLong(ByVal tmp As String) As Long
        
        Dim i As Integer
        Dim parts(1 To 4) As String
           
        i = 0
        
        While InStr(tmp, ".") > 0
            i = i + 1
            parts(i) = Mid(tmp, 1, InStr(tmp, ".") - 1)
            tmp = Mid(tmp, InStr(tmp, ".") + 1)
        Wend
           
        i = i + 1
        parts(i) = tmp
           
        If i <> 4 Then
            AddressStringToLong = 0
            Exit Function
        End If
        
        AddressStringToLong = Val("&H" & Right("00" & Hex(parts(4)), 2) & _
        Right("00" & Hex(parts(3)), 2) & _
        Right("00" & Hex(parts(2)), 2) & _
        Right("00" & Hex(parts(1)), 2))
       
    End Function
    Private Function SocketsCleanup() As Boolean    Dim X As Long
        X = WSACleanup()
        If X <> 0 Then
            MsgBox "Windows Sockets error " & Trim$(str$(X)) & _
            " occurred in Cleanup.", vbExclamation
            SocketsCleanup = False
        Else
            SocketsCleanup = True
        End If
        
    End Function
    Private Function SocketsInitialize() As Boolean    Dim WSAD As WSADATA
        Dim X As Integer
        Dim szLoByte As String, szHiByte As String, szBuf As String
        X = WSAStartup(WS_VERSION_REQD, WSAD)
            
        If X <> 0 Then
            MsgBox "Windows Sockets for 32 bit Windows " & _
            "environments is not successfully responding."
            SocketsInitialize = False
            Exit Function
        End If
            
        If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or _
            (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _
            HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
            
            szHiByte = Trim$(str$(HiByte(WSAD.wVersion)))
            szLoByte = Trim$(str$(LoByte(WSAD.wVersion)))
            szBuf = "Windows Sockets Version " & szLoByte & "." & szHiByte
            szBuf = szBuf & " is not supported by Windows " & _
            "Sockets for 32 bit Windows environments."
            MsgBox szBuf, vbExclamation
            SocketsInitialize = False
            Exit Function
        End If
            
        If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
            szBuf = "This application requires a minimum of " & _
            Trim$(str$(MIN_SOCKETS_REQD)) & " supported sockets."
            MsgBox szBuf, vbExclamation
            SocketsInitialize = False
            Exit Function
        End If
            
        SocketsInitialize = True
    End Function
      

  4.   

    谢谢chenhui530(陈辉),不过我想问就用shell加ping简单的命令能不能实现