当按下“开始”按钮后设置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 教程 目录