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

前端之家收集整理的这篇文章主要介绍了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
检测代码调用了多线程,实际将调用 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 教程 目录

原文链接:https://www.f2er.com/vb/256199.html

猜你在找的VB相关文章