VB 判断IP能否ping通.doc

VB判断IP能否ping通(2012-12-20 00:19:31)转载标签：pingipvb分类：计算机杂症窗体代码测试Private Sub Form_Load()If PingIP(122.22.255.255) ThenMsgBox 可以ping通ElseMsgBox ping 不通End IfEnd Sub模块代码：Option ExplicitPrivate Const IP_SUCCESS As Long = 0Private Const IP_STATUS_BASE As Long = 11000Private 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 = 500Private Const WS_VERSION_REQD As Long = &H101Private Const MIN_SOCKETS_REQD As Long = 1Private Const SOCKET_ERROR As Long = -1Private Const INADDR_NONE As Long = &HFFFFFFFFPrivate Const MAX_WSADescription As Long = 256Private Const MAX_WSASYSStatus As Long = 128Public PingTime As LongPrivate Type ICMP_OPTIONSTtl As ByteTos As ByteFlags As ByteOptionsSize As ByteOptionsData As LongEnd TypePrivate Type ICMP_ECHO_REPLYAddress As Longstatus As LongRoundTripTime As LongDataSize As LongDataPointer As LongOptions As ICMP_OPTIONSData As String * 250End TypePrivate Type WSADATAwVersion As IntegerwHighVersion As IntegerszDescription(0 To MAX_WSADescription) As ByteszSystemStatus(0 To MAX_WSASYSStatus) As BytewMaxSockets As LongwMaxUDPDG As LongdwVendorInfo As LongEnd TypePublic Declare Function timeGetTime Lib winmm.dll () As LongPrivate Declare Function WSAStartup Lib wsock32 (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As LongPrivate Declare Function WSACleanup Lib wsock32 () As LongPrivate Declare Function IcmpCreateFile Lib icmp.dll () As LongPrivate Declare Function inet_addr Lib wsock32 (ByVal s As String) As LongPrivate Declare Function IcmpCloseHandle Lib icmp.dll (ByVal IcmpHandle As Long) As LongPrivate 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 LongPrivate Function GetStatusCode(status As Long) As StringOn Error GoTo ErrLineDim Msg As StringGetStatusCode = Select Case statusCase IP_SUCCESSMsg = ip successCase INADDR_NONEMsg = inet_addr: bad IP formatCase IP_BUF_TOO_SMALLMsg = ip buf too_smallCase IP_DEST_NET_UNREACHABLEMsg = ip dest net unreachableCase IP_DEST_HOST_UNREACHABLEMsg = ip dest host unreachableCase IP_DEST_PROT_UNREACHABLEMsg = ip dest port unreachableCase IP_DEST_PORT_UNREACHABLEMsg = ip dest port unreachableCase IP_NO_RESOURCESMsg = ip no resourcesCase IP_BAD_OPTIONMsg = ip bad optionCase IP_HW_ERRORMsg = ip hw_errorCase IP_PACKET_TOO_BIGMsg = ip packet too_bigCase IP_REQ_TIMED_OUTMsg = ip req timed outCase IP_BAD_REQMsg = ip bad reqCase IP_BAD_ROUTEMsg = ip bad routeCase IP_TTL_EXPIRED_TRANSITMsg = ip ttl expired transitCase IP_TTL_EXPIRED_REASSEMMsg = ip ttl expired reassemCase IP_PARAM_PROBLEMMsg = ip param_problemCase IP_SOURCE_QUENCHMsg = ip source quenchCase IP_OPTION_TOO_BIGMsg = ip option too_bigCase IP_BAD_DESTINATIONMsg = ip bad destinationCase IP_ADDR_DELETEDMsg = ip addr deletedCase IP_SPEC_MTU_CHANGEMsg = ip spec mtu changeCase IP_MTU_CHANGEMsg = ip mtu_changeCase IP_UNLOADMsg = ip unloadCase IP_ADDR_ADDEDMsg = ip addr addedCase IP_GENERAL_FAILUREMsg = ip general failureCase IP_PENDINGMsg = ip pendingCase PING_TIMEOUTMsg = ping timeoutCase ElseMsg = unknown msg returnedEnd SelectGetStatusCode = MsgExit FunctionErrLine:End FunctionPrivate Function Ping(sAddress As String, sDataToSend As String, ECHO As ICMP_ECHO_REPLY) As LongOn Error GoTo ErrLineDim hPort As LongDim dwAddress As LongdwAddress = inet_addr(sAddress)If dwAddress INADDR_NONE ThenhPort = IcmpCreateFile()If hPort ThenCall IcmpSendEcho(hPort, dwAddress, sDataToSend, Len(sDataToSend), 0, ECHO, Len(ECHO), PING_TIMEOUT)Ping = ECHO.statusCall IcmpCloseHandle(hPort)End IfElsePing = INADDR_NONEEnd IfExit FunctionErrLine:Ping = INADDR_NONEEnd FunctionPublic Function PingIP(ByVal