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..
IfdwAddress<>INADDR_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
