求助:如何编程实现两个网口ping通?
感谢您关注此问题!问题具体是这样的:
有8对网口,每对一一对应,本来通过PC机的cmd命令可以实现检测每对网口能否ping通,但是每次插拔光纤和输入命令比较费时费力,效率不高,我现在想设计一个小工具,软件部分主要实现,通过PC机选择某一对网口,选择后能够自动去ping所选择的那对网口,不知可有擅长此类编程的高手帮忙评估一下此方案的可行性,万分感谢!
2011-06-23 11:24
程序代码:
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

2011-06-23 14:09