在VB中如何使用ping命令

【 tulaoshi.com - 编程语言 】

OptionExplicit
　　PrivateConstIP_SUCCESSAsLong=0
　　PrivateConstIP_STATUS_BASEAsLong=11000
　　PrivateConstIP_BUF_TOO_SMALLAsLong=(11000 1)
　　PrivateConstIP_DEST_NET_UNREACHABLEAsLong=(11000 2)
　　PrivateConstIP_DEST_HOST_UNREACHABLEAsLong=(11000 3)
　　PrivateConstIP_DEST_PROT_UNREACHABLEAsLong=(11000 4)
　　PrivateConstIP_DEST_PORT_UNREACHABLEAsLong=(11000 5)
　　PrivateConstIP_NO_RESOURCESAsLong=(11000 6)
　　PrivateConstIP_BAD_OPTIONAsLong=(11000 7)
　　PrivateConstIP_HW_ERRORAsLong=(11000 8)
　　PrivateConstIP_PACKET_TOO_BIGAsLong=(11000 9)
　　PrivateConstIP_REQ_TIMED_OUTAsLong=(11000 10)
　　PrivateConstIP_BAD_REQAsLong=(11000 11)
　　PrivateConstIP_BAD_ROUTEAsLong=(11000 12)
　　PrivateConstIP_TTL_EXPIRED_TRANSITAsLong=(11000 13)
　　PrivateConstIP_TTL_EXPIRED_REASSEMAsLong=(11000 14)
　　PrivateConstIP_PARAM_PROBLEMAsLong=(11000 15)
　　PrivateConstIP_SOURCE_QUENCHAsLong=(11000 16)
　　PrivateConstIP_OPTION_TOO_BIGAsLong=(11000 17)
　　PrivateConstIP_BAD_DESTINATIONAsLong=(11000 18)
　　PrivateConstIP_ADDR_DELETEDAsLong=(11000 19)
　　PrivateConstIP_SPEC_MTU_CHANGEAsLong=(11000 20)
　　PrivateConstIP_MTU_CHANGEAsLong=(11000 21)
　　PrivateConstIP_UNLOADAsLong=(11000 22)
　　PrivateConstIP_ADDR_ADDEDAsLong=(11000 23)
　　PrivateConstIP_GENERAL_FAILUREAsLong=(11000 50)
　　PrivateConstMAX_IP_STATUSAsLong=(11000 50)
　　PrivateConstIP_PENDINGAsLong=(11000 255)
　　PrivateConstPING_TIMEOUTAsLong=500
　　PrivateConstWS_VERSION_REQDAsLong=&H101
　　PrivateConstMIN_SOCKETS_REQDAsLong=1
　　PrivateConstSOCKET_ERRORAsLong=-1
　　PrivateConstINADDR_NONEAsLong=&HFFFFFFFF
　　PrivateConstMAX_WSADescriptionAsLong=256
　　PrivateConstMAX_WSASYSStatusAsLong=128
　　
　　PrivateTypeICMP_OPTIONS
　　TtlAsByte
　　TosAsByte
　　FlagsAsByte
　　OptionsSizeAsByte
　　OptionsDataAsLong
　　EndType
　　
　　PublicTypeICMP_ECHO_REPLY
　　AddressAsLong
　　statusAsLong
　　RoundTripTimeAsLong
　　DataSizeAsLong注释：formerlyinteger
　　注释：ReservedAsInteger
　　DataPointerAsLong
　　OptionsAsICMP_OPTIONS
　　DataAsString*250
　　EndType
　　
　　PrivateTypeWSADATA
　　wVersionAsInteger
　　wHighVersionAsInteger
　　szDescription(0ToMAX_WSADescription)AsByte
　　szSystemStatus(0ToMAX_WSASYSStatus)AsByte
　　wMaxSocketsAsLong
　　wMaxUDPDGAsLong
　　dwVendorInfoAsLong
　　EndType
　　
　　PrivateDeclareFunctionIcmpCreateFileLib"icmp.dll"()AsLong
　　
　　PrivateDeclareFunctionIcmpCloseHandleLib"icmp.dll"(ByValIcmpHandleAsLong)AsLong
　　
　　PrivateDeclareFunctionIcmpSendEchoLib"icmp.dll"(ByValIcmpHandleAsLong,ByValDestinationAddressAsLong,ByValRequestDataAsString,ByValRequestSizeAsLong,ByValRequestOptionsAsLong,ReplyBufferAsICMP_ECHO_REPLY,ByValReplySizeAsLong,ByValTimeoutAsLong)AsLong
　　
　　PrivateDeclareFunctionWSAGetLastErrorLib"WSOCK32.DLL"()AsLong
　　
　　PrivateDeclareFunctionWSAStartupLib"WSOCK32.DLL"(ByValwVersionRequiredAsLong,lpWSADATAAsWSADATA)AsLong
　　
　　PrivateDeclareFunctionWSACleanupLib"WSOCK32.DLL"()AsLong
　　
　　PrivateDeclareFunctiongethostnameLib"WSOCK32.DLL"(ByValszHostAsString,ByValdwHostLenAsLong)AsLong
　　
　　PrivateDeclareFunctiongethostbynameLib"WSOCK32.DLL"(ByValszHostAsString)AsLong
　　
　　PrivateDeclareSubCopyMemoryLib"kernel32"Alias"RtlMoveMemory"(xDestAsAny,xSourceAsAny,ByValnbytesAsLong)
　　
　　PrivateDeclareFunctioninet_addrLib"WSOCK32.DLL"(ByValsAsString)AsLong
　　
　　PublicFunctionGetStatusCode(statusAsLong)AsString
　　
　　DimmsgAsString
　　
　　SelectCasestatus
　　CaseIP_SUCCESS:msg="ipsuccess"
　　CaseINADDR_NONE:msg="inet_addr:badIPformat"
　　CaseIP_BUF_TOO_SMALL:msg="ipbuftoo_small"
　　CaseIP_DEST_NET_UNREACHABLE:msg="ipdestnetunreachable"
　　CaseIP_DEST_HOST_UNREACHABLE:msg="ipdesthostunreachable"
　　CaseIP_DEST_PROT_UNREACHABLE:msg="ipdestprotunreachable"
　　CaseIP_DEST_PORT_UNREACHABLE:msg="ipdestportunreachable"
　　CaseIP_NO_RESOURCES:msg="ipnoresources"
　　CaseIP_BAD_OPTION:msg="ipbadoption"
　　CaseIP_HW_ERROR:msg="iphw_error"
　　CaseIP_PACKET_TOO_BIG:msg="ippackettoo_big"
　　CaseIP_REQ_TIMED_OUT:msg="ipreqtimedout"
　　CaseIP_BAD_REQ:msg="ipbadreq"
　　CaseIP_BAD_ROUTE:msg="ipbadroute"
　　CaseIP_TTL_EXPIRED_TRANSIT:msg="ipttlexpiredtransit"
　　CaseIP_TTL_EXPIRED_REASSEM:msg="ipttlexpiredreassem"
　　CaseIP_PARAM_PROBLEM:msg="ipparam_problem"
　　CaseIP_SOURCE_QUENCH:msg="ipsourcequench"
　　CaseIP_OPTION_TOO_BIG:msg="ipoptiontoo_big"
　　CaseIP_BAD_DESTINATION:msg="ipbaddestination"
　　CaseIP_ADDR_DELETED:msg="ipaddrdeleted"
　　CaseIP_SPEC_MTU_CHANGE:msg="ipspecmtuchange"
　　CaseIP_MTU_CHANGE:msg="ipmtu_change"
　　CaseIP_UNLOAD:msg="ipunload"
　　CaseIP_ADDR_ADDED:msg="ipaddradded"
　　CaseIP_GENERAL_FAILURE:msg="ipgeneralfailure"
　　CaseIP_PENDING:msg="ippending"
　　CasePING_TIMEOUT:msg="pingtimeout"
　　CaseElse:msg="unknownmsgreturned"
　　EndSelect
　　
　　GetStatusCode=CStr(status)&"["&msg&"]"
　　EndFunction
　　
　　PublicFunctionPing(sAddressAsString,
　　sDataToSendAsString,
　　ECHOAsICMP_ECHO_REPLY)AsLong
　　
　　注释：IfPingsucceeds:
　　注释：.RoundTripTime=timeinmsforthepingtocomplete,
　　注释：.Dataisthedatareturned(NULLterminated)
　　注释：.AddressistheIpaddressthatactuallyreplied
　　注释：.DataSizeisthesizeofthestringin.Data
　　注释：.Statuswillbe0
　　注释：
　　注释：IfPingfails.Statuswillbetheerrorcode
　　
　　DimhPortAsLong
　　DimdwAddressAsLong
　　
　　注释：converttheaddressintoalongrepresentation
　　dwAddress=inet_addr(sAddress)
　　
　　注释：ifavalidaddress..
　　IfdwAddressINADDR_NONEThen
　　
　　注释：openaport
　　hPort=IcmpCreateFile()
　　
　　注释：andifsuccessful,
　　IfhPortThen
　　
　　注释：pingit.
　　CallIcmpSendEcho(hPort,dwAddress,sDataToSend,Len(sDataToSend),0,ECHO,Len(ECHO),PING_TIMEOUT)
　　
　　注释：returnthestatusaspingsuccesandclose
　　Ping=ECHO.status
　　CallIcmpCloseHandle(hPort)
　　
　　EndIf
　　
　　Else:
　　注释：theaddressformatwasprobablyinvalid
　　Ping=INADDR_NONE
　　
　　EndIf
　　
　　EndFunction
　　
　　
　　PublicSubSocketsCleanup()
　　
　　IfWSACleanup()0Then
　　MsgBox"WindowsSocketserroroccurredinCleanup.",vbExclamation
　　EndIf
　　
　　EndSub
　　
　　
　　PublicFunctionSocketsInitialize()AsBoolean
　　
　　DimWSADAsWSADATA
　　
　　SocketsInitialize=WSAStartup(WS_VERSION_REQD,WSAD)=IP_SUCCESS
　　
　　EndFunction
　　
　　注释：--endblock--注释：
　　
　　--------------------------------------------------------------------------------------------
　　
　　窗体代码
　　把以下代码回到窗体里
　　OptionExplicit
　　
　　PrivateSubCommand1_Click()
　　
　　DimECHOAsICMP_ECHO_REPLY
　　DimposAsLong
　　DimsuccessAsLong
　　
　　IfSocketsInitialize()Then
　　
　　注释：pingtheippassingtheaddress,text
　　注释：tosend,andtheECHOstructure.
　　success=Ping((Text1.Text),(Text2.Text),ECHO)
　　
　　注释：displaytheresults
　　Text4(0).Text=GetStatusCode(success)
　　Text4(1).Text=ECHO.Address
　　Text4(2).Text=ECHO.RoundTripTime&"ms"
　　Text4(3).Text=ECHO.DataSize&"bytes"
　　
　　IfLeft$(ECHO.Data,1)Chr$(0)Then
　　pos=InStr(ECHO.Data,Chr$(0))
　　Text4(4).Text=Left$(ECHO.Data,pos-1)
　　EndIf
　　
　　Text4(5).Text=ECHO.DataPointer
　　
　　SocketsCleanup
　　
　　Else
　　
　　MsgBox"WindowsSocketsfor32bitWindows"&"environmentsisnotsuccessfullyresponding."
　　
　　EndIf
　　
　　EndSub