订阅专栏
版权声明：本文为博主原创文章，转载请在显著位置标明本文出处以及作者网名，未经作者允许不得用于商业目的。
当按下“开始”按钮后设置Timer的时间间隔，同时先检测一次：
Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStart.Click
If btnStart.Text = "停止" Then
blStopCheck = True
If threadCheck.ThreadState = ThreadState.Running Then threadCheck.Abort()
tmCheck.Stop()
btnStart.Text = "开始"
btnAdd.Enabled = True
btnDel.Enabled = True
comTime.Enabled = True
Exit Sub
End If
blStopCheck = False
If My.Computer.Network.IsAvailable = False Then
tsslInfo.Text = "目前网络中断，请先检查网络"
Exit Sub
End If
If lvCheck.Items.Count < 1 Then
tsslInfo.Text = "没有设置要检查的计算机或网页"
Exit Sub
End If
btnAdd.Enabled = False
btnDel.Enabled = False
comTime.Enabled = True = False
Dim timeInterval As Integer
Select Case comTime.SelectedIndex
Case 0
timeInterval = 1 * 60 * 1000
Case 1
timeInterval = 3 * 60 * 1000
Case 2
timeInterval = 5 * 60 * 1000
Case 3
timeInterval = 10 * 60 * 1000
Case 4
timeInterval = 20 * 60 * 1000
Case 5
timeInterval = 30 * 60 * 1000
Case Else
timeInterval = 60 * 60 * 1000
End Select
tmCheck.Interval = timeInterval
tmCheck.Start()
btnStart.Text = "停止"
Call beginCheck()
End Sub
计时器的事件：
Private Sub tmCheck_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmCheck.Tick
Call beginCheck()
End Sub
检测代码，调用了多线程，实际将调用 checkAddr()方法
Private Sub beginCheck()
writeErrlog("启动检测")
If (threadCheck Is Nothing) Then
threadCheck = New Thread(AddressOf checkAddr)
threadCheck.Start()
Else
'如果检测线程还在运行
If threadCheck.ThreadState = ThreadState.Running Then
Exit Sub
Else
threadCheck = New Thread(AddressOf checkAddr)
threadCheck.Start()
End If
End If
End Sub
实际检测的时候又需要分别按照网络地址或网页地址检测：
Private Sub checkAddr()
If lvCheck.Items.Count < 1 Then Exit Sub
Dim lvAddrInfo As String = ""
Dim lvAddrType As String = ""
Dim checkResult As Boolean = False
For i As Integer = 0 To lvCheck.Items.Count - 1
If blStopCheck = True Then
btnStart.Text = "开始"
Exit Sub
End If
lvAddrInfo = lvCheck.Items(i).SubItems(3).Text
lvAddrType = lvCheck.Items(i).SubItems(2).Text
If lvAddrType.ToLower = "pc" Then
checkResult = getAddrStatePC(lvAddrInfo)
Else
checkResult = getAddrStateWww(lvAddrInfo)
End If
lvCheck.Items(i).UseItemStyleForSubItems = False
If checkResult = True Then
lvCheck.Items(i).SubItems(4).Text = "成功"
lvCheck.Items(i).SubItems(4).ForeColor = Color.Black
Else
lvCheck.Items(i).SubItems(4).Text = "失败"
lvCheck.Items(i).SubItems(4).ForeColor = Color.Red
writeErrlog(lvAddrType & ": 失败 " & lvAddrInfo)
End If
lvCheck.Items(i).SubItems(5).Text = Format(Now(), "yyyy-MM-dd HH:mm:ss")
Next
End Sub
实际的icmp协议比较复杂，因此偷懒的使用了My命名空间下的Ping方法：
Private Function getAddrStatePC(ByVal addr As String) As Boolean
Dim siteResponds As Boolean = False
Try
siteResponds = My.Computer.Network.Ping(addr, pingTime) '如果Ping失败返回False
Return siteResponds
Catch ex As Exception
writeErrlog("错误：" & ex.Message)
End Try
End Function
检测网页：
Private Function getAddrStateWww(ByVal addr As String) As Boolean
Dim LinkOk As Boolean = False
Try
Dim myHttpWebRequest As HttpWebRequest = CType(WebRequest.Create(addr), HttpWebRequest)
Dim myHttpWebResponse As HttpWebResponse = CType(myHttpWebRequest.GetResponse(), HttpWebResponse)
If myHttpWebResponse.StatusCode = HttpStatusCode.OK Then
LinkOk = True
Else
LinkOk = False
End If
' Release the resources of the response.
myHttpWebResponse.Close()
Catch e As WebException
writeErrlog("错误：" & e.Message)
Return False
Catch e As Exception
writeErrlog("错误：" & e.Message)
Return False
End Try
Return LinkOk
End Function
如果需要检测的地址不通，或网页不能访问，记录到Log文件：
Private Sub writeErrlog(ByVal errMsg As String)
Dim logfile As String = Application.StartupPath.TrimEnd("\") & "\err.txt"
Dim sw As New StreamWriter(logfile, True)
sw.WriteLine(Format(Now(), "yyyy-MM-dd HH:mm:ss") & " " & errMsg)
sw.Close()
End Sub
由于.net平台下C#和vb.NET很相似，本文也可以为C#爱好者提供参考。
学习更多vb.net知识，请参看vb.net教程 目录
————————————————
版权声明：本文为CSDN博主「VB.Net」的原创文章，遵循CC 4.0 BY-SA版权协议，转载请附上原文出处链接及本声明。
