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

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

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

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

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