VB.Net - Timer Controlはアプリケーションをフリーズします

Question

Webサイトがアップまたはダウンしているかどうかをチェックするために使用されるvb.netアプリケーションにTimerコントロールを追加しました。アプリには2つのタイマーコントロールがあります。どちらもSystem.Windows.Forms.Timerのものです。

Timer1とTimer2があります。 Timer1はウェブサイトのチェックを実行するために使用されます。 Timer2は、フォームのベースにあるToolStripに現在の日付と時刻を表示するだけです。 Timer2は問題なく時間を表示しますが、Timer1を実行するWebサイトのチェックを開始すると、2回チェックした後にアプリケーションがフリーズします。時にはそれはより長く実行されますが、最終的にフリーズします。

アプリケーションをシャットダウンするには、タスクマネージャ内からタスクを終了する必要があります。私はデバッガ内と実行可能ファイルの実行後にこれをテストしました。私もTimer2を完全に削除してテストしましたが、フリーズは残っています。ここに私のコードです。どんな支援も大歓迎です。

Imports System 


Public Class Form1 

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load 

     lblStatus.Text = "" 
     Timer1.Stop() 

     btnStart.Enabled = True 
     btnStop.Enabled = False 

    End Sub 

    Public Function CheckAddress(ByVal URL As String) As Boolean 
     Try 
      Dim request As WebRequest = WebRequest.Create(URL) 
      Dim response As WebResponse = request.GetResponse() 
     Catch ex As Exception 
      Return False 
     End Try 
     Return True 
    End Function 

    Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick 

     Dim startPoint As Integer = -1 

     If CheckAddress(txtAddress.Text).ToString() = True Then 
      rtxtResults.AppendText(" -- " & txtAddress.Text & " - Website shows UP at " & tsClock.Text & " - " & vbNewLine) 
     ElseIf CheckAddress(txtAddress.Text).ToString() = False Then 
      rtxtResults.AppendText(" -- " & txtAddress.Text & " - Website shows DOWN at " & tsClock.Text & " - " & vbNewLine) 
     End If 

     Do 
      startPoint = rtxtResults.Find("Website shows DOWN at", startPoint + 1, RichTextBoxFinds.None) 
      If (startPoint >= 0) Then 
       rtxtResults.SelectionStart = startPoint 
       rtxtResults.SelectionLength = "Website shows DOWN at".Length 
       rtxtResults.SelectionColor = Color.Red 
      End If 
     Loop Until startPoint < 0 


    End Sub 

    Private Sub Timer2_Tick(sender As System.Object, e As System.EventArgs) 
     tsClock.Text = Now() 
    End Sub 

    Private Sub btnStart_Click(sender As System.Object, e As System.EventArgs) Handles btnStart.Click 

     If txtInterval.Text = "" Then 
      MsgBox("Must enter a number") 
      Exit Sub 
     End If 
     lblStatus.ForeColor = Color.Green 
     lblStatus.Text = "Running" 
     btnStart.Enabled = False 
     btnStop.Enabled = True 
     Timer1.Interval = Int(txtInterval.Text) * 1000 
     Timer1.Start() 

    End Sub 

    Private Sub btnStop_Click(sender As System.Object, e As System.EventArgs) Handles btnStop.Click 
     lblStatus.ForeColor = Color.Red 
     lblStatus.Text = "Stopped" 
     btnStop.Enabled = False 
     btnStart.Enabled = True 

     Timer1.Stop() 
    End Sub 


End Class 

Answer 1

Timer1_Tickメソッドが完了するまで、アプリケーションのUIが「フリーズ」します。おそらくあなたのTimer1_TickのDo...Loopが終了していない可能性があります。 DoとLoop行を削除してみてください。