求助:如何编程实现两个网口ping通?
感谢您关注此问题!问题具体是这样的:
有8对网口,每对一一对应,本来通过PC机的cmd命令可以实现检测每对网口能否ping通,但是每次插拔光纤和输入命令比较费时费力,效率不高,我现在想设计一个小工具,软件部分主要实现,通过PC机选择某一对网口,选择后能够自动去ping所选择的那对网口,不知可有擅长此类编程的高手帮忙评估一下此方案的可行性,万分感谢!
Option Explicit ' 字符常数说明 Private Const IP_SUCCESS = 0 Private Const IP_REQ_TIMED_OUT = 11010 Private Const IP_BAD_DESTINATION = 11018 Private Const PING_TIMEOUT = 200 ' 结构型变量声明 Private Type ICMP_ECHO_REPLY Address As Long Status As Long RoundTripTime As Long Reserved As Integer Data As String * 250 End Type ' API 函数声明 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, ByVal RequestOptions As Long, ReplyBuffer As ICMP_ECHO_REPLY, ByVal ReplySize As Long, ByVal Timeout As Long) As Long Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then If IsNumeric(Text1) Then If Val(Text1) < 0 Or Val(Text1) > 255 Then MsgBox " 请输入 0 至 255 之间的数据 " Text1 = "" Text1.SetFocus Else Text2.SetFocus End If Else MsgBox " 请输入数据 " Text1 = "" Text1.SetFocus End If End If End Sub Private Sub Text2_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then If IsNumeric(Text2) Then If Val(Text2) < 0 Or Val(Text2) > 255 Then MsgBox " 请输入 0 至 255 之间的数据 " Text2 = "" Text2.SetFocus Else Text3.SetFocus End If Else MsgBox " 请输入数据 " Text2 = "" Text2.SetFocus End If End If End Sub Private Sub Text3_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then If IsNumeric(Text3) Then If Val(Text3) < 0 Or Val(Text3) > 255 Then MsgBox " 请输入 0 至 255 之间的数据 " Text3 = "" Text3.SetFocus Else Text4.SetFocus End If Else MsgBox " 请输入数据 " Text3 = "" Text3.SetFocus End If End If End Sub Private Sub Text4_KeyPress(KeyAscii As Integer) Dim Echo As ICMP_ECHO_REPLY, Add As String Dim pos As Integer If KeyAscii = 13 Then If IsNumeric(Text4) Then If Val(Text4) < 0 Or Val(Text4) > 255 Then MsgBox " 请输入 0 至 255 之间的数据 " Text4 = "" Text4.SetFocus Else Add = Text1 & "." & Text2 & "." & Text3 & "." & Text4 Call Ping(Add, Echo) Text5 = GetStatusCode(Echo.Status) Command1.SetFocus End If Else MsgBox " 请输入数据 " Text4 = "" Text4.SetFocus End If End If End Sub Private Sub Command1_Click() Text1 = "": Text2 = "": Text3 = "" Text4 = "": Text5 = "" Text1.SetFocus End Sub Private Sub Command2_Click() Unload Me End End Sub Private Function Ping(szAddress As String, Echo As ICMP_ECHO_REPLY) As Long Dim hPort As Long Dim dwAddress As Long Dim sDataToSend As String sDataToSend = "" dwAddress = AddressStringToLong(szAddress) hPort = IcmpCreateFile() If IcmpSendEcho(hPort, dwAddress, sDataToSend, Len(sDataToSend), 0, Echo, Len(Echo), PING_TIMEOUT) Then Ping = Echo.RoundTripTime Else Ping = -Echo.Status End If Call IcmpCloseHandle(hPort) End Function Function AddressStringToLong(ByVal Tmp As String) As Long Dim Parts(1 To 4) As String, I As Integer I = 0 While InStr(Tmp, ".") > 0 I = I + 1 Parts(I) = Mid(Tmp, 1, InStr(Tmp, ".") - 1) Tmp = Mid(Tmp, InStr(Tmp, ".") + 1) Wend I = I + 1 Parts(I) = Tmp If I <> 4 Then AddressStringToLong = 0 Exit Function End If AddressStringToLong = Val("&H" & Right("00" & Hex(Parts(4)), 2) & Right("00" & Hex(Parts(3)), 2) & Right("00" & Hex(Parts(2)), 2) & Right("00" & Hex(Parts(1)), 2)) End Function Private Function GetStatusCode(Status As Long) As String Dim msg As String Select Case Status Case IP_SUCCESS: msg = "测试成功" Case IP_REQ_TIMED_OUT: msg = "测试失败" Case IP_BAD_DESTINATION: msg = "测试失败" Case Else: End Select GetStatusCode = msg End Function
Option Explicit Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Integer, ByVal dwReserved As Long) As Long Dim sConnType As String * 255 Private Sub Form_Load() Dim Ret As Long Ret = InternetGetConnectedStateEx(Ret, "", 254, 0) If Ret = 1 Then MsgBox "您已经连接到 Internet ", vbInformation Else MsgBox "您没能连接到 Internet ", vbInformation End If End Sub
Private Sub Command1_Click() Dim strComputer As String Dim objWMIService As Variant, colItems As Variant, obj As Variant Dim Status As Boolean, j As Long strComputer = "10.0.0.1": Status = False Set objWMIService = GetObject("winmgmts:") Set colItems = objWMIService.ExecQuery("Select * from Win32_PingStatus " & "Where Address='" & strComputer & "'") Me.Hide Do While Status <> True For Each obj In colItems If obj.StatusCode <> 0 Then ' MsgBox "成功 !" Exit Sub Else ' MsgBox "失败 !" Me.Show End If Next 'Label1.Caption = j 'DoEvents 'j = j + 1 'If j > 2147483646 Then 'j = 0 'End If Loop End Sub