vb.net 教程 4-10 XML文件操作 4-4

今天药忘吃喽~ 2022-09-10 12:13 186阅读 0赞

订阅专栏  
版权声明：本文为博主原创文章，转载请在显著位置标明本文出处以及作者网名，未经作者允许不得用于商业目的。

当按下“开始”按钮后设置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教程 ][vb.net_] 目录  
————————————————  
版权声明：本文为CSDN博主「VB.Net」的原创文章，遵循CC 4.0 BY-SA版权协议，转载请附上原文出处链接及本声明。

[vb.net_]: https://www.xin3721.com/eschool/vbnetxin3721