Question

VB 怎么实现ping

用VB 怎么实现ping
比如我要ping 192.168.0.250
30秒内ping得通就弹出MsgBox "网络PING通"
30秒内ping不通就弹出MsgBox "网络不通"

Answer 1

说明：不是调用cmd命令ping，完全是内置的。

用法：PingIP("202.108.22.142", TTL(可选,默认10), TimeOut(可选,默认1000))，返回延时时长

注意：不能ping域名。

可自定义TTL和超时时间。

这个是改国外的，原版超级啰嗦。给精简了。

原作者是谁已不得而知。

以下是Ping 模块代码：

Option Explicit
'Ping 模块，用法：PingIP("202.108.22.142", TTL(可选,默认10), TimeOut(可选,默认1000))，返回延时时长
'注意：不能ping域名。

Private Type ip_option_information
TTL As Byte 'Time To Live
Tos As Byte 'Type Of Service
Flags As Byte 'IP header flags
OptionsSize As Byte 'Size in bytes of options data
OptionsData As Long 'Pointer to options data
End Type

Private Type icmp_echo_reply
Address As Long 'Replying address
Status As Long 'Reply IP_STATUS, values as defined above
RoundTripTime As Long 'RTT in milliseconds
DataSize As Integer 'Reply data size in bytes
Reserved As Integer 'Reserved for system use
DataPointer As Long 'Pointer to the reply data
Options As ip_option_information 'Reply options
Data As String * 250 'Reply data which should be a copy of the string sent, NULL terminated
'this field length should be large enough to contain the string sent
End Type

Private CurIp As Long
Private CurIpDes As String
Private Const WSADESCRIPTION_LEN = 256
Private Const WSASYSSTATUS_LEN = 256
Private Const WSADESCRIPTION_LEN_1 = WSADESCRIPTION_LEN + 1
Private Const WSASYSSTATUS_LEN_1 = WSASYSSTATUS_LEN + 1
Private Const SOCKET_ERROR = -1

Private Type tagWSAData
wVersion As Integer
wHighVersion As Integer
szDescription As String * WSADESCRIPTION_LEN_1
szSystemStatus As String * WSASYSSTATUS_LEN_1
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As String * 200
End Type

Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Private 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, RequestOptions As ip_option_information, ReplyBuffer As icmp_echo_reply, ByVal ReplySize As Long, ByVal TimeOut As Long) As Long
Private Declare Function WSAStartup Lib "wsock32" (ByVal wVersionRequested As Integer, lpWSADATA As tagWSAData) As Integer
Private Declare Function WSACleanup Lib "wsock32" () As Integer
Public Function PingIP(ByVal strIPAddress As String, Optional ByVal lngTTL As Long = 10, Optional ByVal lngTimeOut As Long = 1000) As String
Dim hFile As Long 'handle for the icmp port opened
Dim lRet As Long 'hold return values as required
Dim lIPAddress As Long
Dim strMessage As String
Dim pOptions As ip_option_information
Dim pReturn As icmp_echo_reply
Dim iVal As Integer
Dim lPingRet As Long
Dim pWsaData As tagWSAData

strMessage = "Echo this string of data"
iVal = WSAStartup(&H101, pWsaData)
ConvertIPAddressToLong strIPAddress
lIPAddress = CurIp
hFile = IcmpCreateFile()
pOptions.TTL = lngTTL
lRet = IcmpSendEcho(hFile, lIPAddress, strMessage, Len(strMessage), pOptions, pReturn, Len(pReturn), lngTimeOut)

If lRet = 0 Then
PingIP = "Fail"
Else
If pReturn.Status <> 0 Then
PingIP = "Fail"
Else
PingIP = pReturn.RoundTripTime & "ms"
End If
If pReturn.RoundTripTime > lngTimeOut Then
PingIP = "TimeOut"
End If
End If

lRet = IcmpCloseHandle(hFile)
iVal = WSACleanup()
End Function
Private Sub ConvertIPAddressToLong(ByVal strIPAddress As String)
On Error Resume Next
Dim strTemp As String, lAddress As Long, iValCount As Integer, lDotValues(1 To 4) As String

strTemp = strIPAddress '建立初始储存和计数器
iValCount = 0

Do While InStr(strTemp, ".") > 0 'keep going while we still have dots in the string
iValCount = iValCount + 1 'count the number
lDotValues(iValCount) = Mid(strTemp, 1, InStr(strTemp, ".") - 1) 'pick it off and convert it
strTemp = Mid(strTemp, InStr(strTemp, ".") + 1) 'chop off the number and the dot
Loop

iValCount = iValCount + 1 'the string only has the last number in it now
lDotValues(iValCount) = strTemp

If iValCount <> 4 Then 'if we didn't get four pieces then the IP address is no good
CurIp = 0
Exit Sub
End If

'take the four value, hex them, pad to 2 digits, make a hex string and then convert the whole mess to a long for returning
lAddress = Val("&H" & Right("00" & Hex(lDotValues(4)), 2) & Right("00" & Hex(lDotValues(3)), 2) & Right("00" & Hex(lDotValues(2)), 2) & Right("00" & Hex(lDotValues(1)), 2))

CurIp = lAddress '设置返回值
CurIpDes = strIPAddress
End Sub

Answer 2

要Ping一个IP为什么要用Shell来调用呢？
不专业，而且不易维护。
其实要现成API的
找一下，很多的
－－－－
另外一种思路
dim str as string
str= "Ping 192.168.5.1 > c:\a.txt " '其他参数放到> 号前面
shell str
这样分析c:\a.txt就知道结果了

Answer 3

用这个
If PingIP("192.168.0.250") = True Then
和我发给你的模块就OK了

Answer 4

调用系统命令，然后分析返回的数据
Shell "cmd.exe /c ping " & Text1.Text & ”>“ & App.Path

Answer 5

按16进制数(10进制)发送命令:
Option Explicit
Dim bytSend() As Byte
Private Sub Command1_Click() 'Open
ReDim bytSend(4)
bytSend(0) = &H43
bytSend(1) = &H30
bytSend(2) = &H30
bytSend(3) = &HD
bytSend(4) = &HA
MSComm1.Output = bytSend
End Sub

Private Sub Command2_Click() 'Close
ReDim bytSend(4)
bytSend(0) = &H43
bytSend(1) = &H30
bytSend(2) = &H31
bytSend(3) = &HD
bytSend(4) = &HA
MSComm1.Output = bytSend
End Sub

Private Sub Form_Load()
MSComm1.CommPort = 1 '
MSComm1.Settings = "9600,n,8,1"
MSComm1.PortOpen = True
End Sub