Question

vb调用ping命令检测网络

我在网上搜到一个代码
如下，我复制粘贴到vb中不能用，即使添加了代码中的控件
希望哪位大侠帮忙修改下，使其可以在窗体load时候打印输出网络状态

Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
Dim ip As String = "192.168.0.1"
Dim strRst As String = CmdPing(ip)
TextBox4.Text = strRst
End Sub

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

Answer 1

添加一个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 = "www.baidu.com"
Dim strRst As String = CmdPing(ip)
TextBox1.Text = strRst
End Sub

追问

感谢你的回答，我这边用vb6.0还是不行，也编译不了

追答

晕死。。。这个代码是 VB.NET 和VB6是两回事

Answer 2

Option Explicit
' 添加winsock控件，取名sckClient，timer1(inteval=100,true)、timer2(interval=1000,false)、text1、text2
'检测网络连接1/3
Private Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
Private Const RAS95_MaxEntryName = 256
Private Const RAS95_MaxDeviceType = 16
Private Const RAS95_MaxDeviceName = 32
Private Type RASCONN95
dwSize As Long
hRasCon As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
Private Type RASCONNSTATUS95
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type

Public MaxCN As Long
Public cdlg As New GCommonDialog ' Common dialog
'检测网络连接2/3
Public Function IsConnected() As Boolean
Dim TRasCon(255) As RASCONN95, lg As Long, lpcon As Long, RetVal As Long, Tstatus As RASCONNSTATUS95
TRasCon(0).dwSize = 412
lg = 256 * TRasCon(0).dwSize
RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
If RetVal <> 0 Then
MsgBox "错误"
Exit Function
End If
Tstatus.dwSize = 160
RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
If Tstatus.RasConnState = &H2000 Then
IsConnected = True
Else
IsConnected = False
End If
End Function

Private Sub Command1_Click()
Clipboard.Clear
text2.SelStart = 0
text2.SelLength = Len(text2)
Clipboard.SetText text2.SelText
End Sub

Private Sub sckClient_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim Recieve As String
sckClient(MaxCN).GetData Recieve
' Call ParseRecv(Recieve) 'Analyze data
End Sub

Private Sub Timer1_Timer()
If IsConnected = True Then
Label1 = "您已经连通了Internet！"
Timer2.Enabled = True
ElseIf IsConnected = False Then
Label1 = "网络已经断开..."
Timer2.Enabled = False
Text1 = "" 'ip
text2 = "" 'ftp
End If
End Sub

Private Sub Timer2_Timer() '看ip
If sckClient(MaxCN).State = sckConnected Then
' Label1.Caption = "已连接: " & "端口: " & sckClient(MaxCN).LocalPort & " 套结字号: " & MaxCN
text2 = ""
Else
Text1 = ""
Text1.Text = sckClient(MaxCN).LocalIP 'Loopback. Handly if you only have one computer
text2 = "ftp://" & Text1 & "/"

End If
Timer2.Enabled = False
End Sub

Answer 3

要加上控件