vb实现pingip源码_vbs ping命令

文章目录：

• 1、VB如何实现PING命令？
• 2、VB 怎么实现ping
• 3、怎么样通过VB实现ping指定IP
• 4、vb调用ping命令检测网络
• 5、VB中如何ping text的IP
• 6、vb ping 代码？

VB如何实现PING命令？

利用VB的Shell执行PING命令，将PING的输出重定向到文件 c:\r.txt，然后读取c:\r.txt文件显示运行结果。

由于VB中的Shell命令是异步执行的，即调用Shell后，没等Shell执行完毕，程序就继续执行下一条语句。为此，程序使用了系统API来判断Shell是否结束。

1）窗体及控件

2）代码

Option Explicit

Private Declare Function GetExitCodeProcess Lib "kernel32" ( _

        ByVal hProcess As Long, _

        lpExitCode As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" ( _

        ByVal hObject As Long) As Long

Private Declare Function OpenProcess Lib "kernel32" ( _

        ByVal dwDesiredAccess As Long, _

        ByVal bInheritHandle As Long, _

        ByVal dwProcessId As Long) As Long

Const PROCESS_QUERY_INFORMATION = H400

Const STILL_ALIVE = H103

Private Sub Command1_Click()

    If Trim(Text1.Text) = "" Then

        MsgBox "请输入域名或IP地址", vbInformation + vbOKOnly

        Text1.SetFocus

        Exit Sub

    End If

    '命令执行期间禁用命令按钮

    Command1.Enabled = False

    '调用Shell执行Ping，执行结果重定向到C:\r.txt中

    Dim pid As Long

    pid = Shell("cmd.exe /C Ping "  Text1.Text  "  c:\r.txt", vbHide)

    ' 提示

    Text2.Text = "正在执行Ping "  Text1.Text  " ..."

    '等待Shell执行结束

    Dim hProc As Long

    hProc = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)

    Dim ExitCode As Long

    Do

        Call GetExitCodeProcess(hProc, ExitCode)

        DoEvents

    Loop While ExitCode = STILL_ALIVE

    '清空，准备显示结果

    Text2.Text = ""

    '打开 C:\r.txt文件

    Open "c:\r.txt" For Input As #1

    Dim strLine As String

    Do Until EOF(1)

        Line Input #1, strLine

        '显示执行结果

        Text2.Text = Text2.Text  strLine  vbNewLine

    Loop

    '关闭文件

    Close #1

    '删除C:\r.txt

    On Error Resume Next

    Kill "c:\r.txt"

    On Error GoTo 0

    '使能命令按钮

    Command1.Enabled = True

End Sub

Private Sub Form_Load()

    Text1.Text = ""

    Text2.Text = ""

End Sub

3）运行结果

Ping baidu.com 正在执行中 ....

Ping baidu.com执行结果

VB 怎么实现ping

说明：不是调用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

怎么样通过VB实现ping指定IP

Dim pid As Long pid = Shell("cmd.exe /C Ping " Text1.Text " c:\r.txt", vbHide) ' 提示 Text2.Text = "正在执行Ping " Text1.Text " " '等待Shell执行结束 Dim hProc As Long hProc = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid) Dim ExitCode As Long Do Call GetExitCodeProcess(hProc, ExitCode) DoEvents Loop While ExitCode = STILL_ALIVE '清空，准备显示结果 Text2.Text = "" '打开 C:\r.txt文件 Open "c:\r.txt" For Input As #1 Dim strLine As String Do Until EOF(1) Line Input #1, strLine '显示执行结果 Text2.Text = Text2.Text strLine vbNewLine Loop '关闭文件 Close #1 '删除C:\r.txt On Error Resume Next Kill "c:\r.txt"

vb调用ping命令检测网络

添加一个textbox控件 代码如下：运行即可得到目的

Public Function CmdPing(ByVal strIp As String) As String

Dim p As New Process '创建一个线程

p.StartInfo.FileName = "cmd.exe"

p.StartInfo.UseShellExecute = False

p.StartInfo.RedirectStandardInput = True

p.StartInfo.RedirectStandardOutput = True

p.StartInfo.RedirectStandardError = True

p.StartInfo.CreateNoWindow = True

Dim pingrst As String

p.Start()

p.StandardInput.WriteLine("ping -n 1 " + strIp)

p.StandardInput.WriteLine("exit")

Dim strRst As String = p.StandardOutput.ReadToEnd()

If (strRst.IndexOf("(0% loss)") -1) Then

pingrst = "连接成功"

ElseIf (strRst.IndexOf("Destination host unreachable.") -1) Then

pingrst = "无法到达目的主机"

ElseIf ((strRst.IndexOf("Request timed out.") -1) Or (strRst.IndexOf("(100% loss)") -1)) Then

pingrst = "超时"

ElseIf (strRst.IndexOf("Unknown host") -1) Then

pingrst = "无法解析主机"

Else

pingrst = strRst

End If

p.Close()

Return pingrst

End Function

Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

Dim ip As String = ""

Dim strRst As String = CmdPing(ip)

TextBox1.Text = strRst

End Sub

VB中如何ping text的IP

第一个问题很简单，你读出text中的内容连接到ping后边就行了 如：shell("ping " text) 第二个问题你要发送text2中的内容到目标IP，那首先你的目标IP 计算机要有相应客户端或者服务端程序，可以使用socket完成

vb ping 代码？

Dim pid As Long

pid = Shell("cmd.exe /C Ping " Text1.Text " c:\r.txt", vbHide)

' 提示

Text2.Text = "正在执行Ping " Text1.Text " ..."

'等待Shell执行结束

Dim hProc As Long

hProc = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)

Dim ExitCode As Long

Do

Call GetExitCodeProcess(hProc, ExitCode)

DoEvents

Loop While ExitCode = STILL_ALIVE

'清空，准备显示结果

Text2.Text = ""

'打开 C:\r.txt文件

Open "c:\r.txt" For Input As #1

Dim strLine As String

Do Until EOF(1)

Line Input #1, strLine

'显示执行结果

Text2.Text = Text2.Text strLine vbNewLine

Loop

'关闭文件

Close #1

'删除C:\r.txt

On Error Resume Next

Kill "c:\r.txt"