BASModule模块
把以下代码回到BASModule模块: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
->
