troubleshooting Question

How to stop a background worker vb.net

Avatar of Corey_Steinwand
Corey_Steinwand asked on
.NET ProgrammingVisual Basic.NET
5 Comments1 Solution1421 ViewsLast Modified:
How can I stop the background worker in this code when I click the btnStop
Imports System.Net.Mail
Imports System.IO
Imports System.Threading
Imports System.Net.Dns
Imports System.Net
Imports System.ComponentModel

Public Class Form1

    'Declare the variable for the computer we are going to ping
    Dim myComputer As String = "www.google.com"

    'Declare the background worker
    Dim worker As BackgroundWorker

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

        'Without this the background ping would fail because the process is started in the GUI
        Control.CheckForIllegalCrossThreadCalls = False

        btnStop.Enabled = False

    End Sub

    Private Sub btnPing_Click(sender As Object, e As EventArgs) Handles btnPing.Click

        'starts the progress bar and continuously runs while the ping is running
        ProgressBar1.Enabled = True
        ProgressBar1.Style = ProgressBarStyle.Marquee
        btnPing.Enabled = False
        btnStop.Enabled = True
        'Run the ping in the background to keep the UI from freezing
        worker = New BackgroundWorker
        worker.WorkerSupportsCancellation = True
        worker.RunWorkerAsync()
        AddHandler worker.DoWork, AddressOf myWorker

    End Sub

    Private Sub btnStop_Click(sender As Object, e As EventArgs) Handles btnStop.Click
        ProgressBar1.Enabled = False
        worker.CancelAsync()
    End Sub

    Private Sub reportsuccess()

        rtbPingResults.AppendText("Ping Successful" & vbTab & myComputer.ToString & vbTab & IPAddresses(myComputer) & vbTab & Now)
        rtbPingResults.AppendText(Environment.NewLine)
        rtbPingResults.AppendText(Environment.NewLine)

    End Sub

    Private Sub reportfailure()

        rtbPingResults.AppendText("Ping Failure" & vbTab & myComputer.ToString & vbTab & IPAddresses(myComputer) & vbTab & Now)
        rtbPingResults.AppendText(Environment.NewLine)
        rtbPingResults.AppendText(Environment.NewLine)

    End Sub
    Sub myWorker(sender As Object, e As DoWorkEventArgs) 'Ping
        Do

                Try
                    If My.Computer.Network.Ping(myComputer) Then
                        Me.Text = "Successfully Pinging '" & myComputer & "'"
                        rtbPingResults.BackColor = Color.Honeydew
                        reportsuccess()
                    Else
                        Me.Text = "Failing to Ping '" & myComputer & "'"
                        rtbPingResults.BackColor = Color.Firebrick
                        reportfailure()
                    End If

                Catch ex As Exception
                    MsgBox("An error has occurred")
                    rtbPingResults.BackColor = Color.Red
                End Try
                Thread.Sleep(2000)

        Loop

    End Sub

    Function IPAddresses(Optional ByVal HostName As String = "") As String 'Gets all the ip addresses associated to the FQDN
        Dim IPEntry As IPHostEntry

        Try
            If HostName = "" Then
                IPEntry = GetHostEntry(GetHostName)
            Else
                IPEntry = GetHostEntry(HostName)
            End If
        Catch
            Return ""
        End Try

        Dim X As Integer = 0
        Dim Buffer As String = ""

        For X = 0 To IPEntry.AddressList.Count - 1
            If IPEntry.AddressList(X).AddressFamily = Sockets.AddressFamily.InterNetwork Then
                If Buffer = "" Then
                    Buffer = IPEntry.AddressList(X).ToString
                Else
                    Buffer = Buffer & ", " & IPEntry.AddressList(X).ToString
                End If
            End If
        Next

        Return Buffer

    End Function

End Class
ASKER CERTIFIED SOLUTION
Mike Tomlinson
High School Computer Science, Computer Applications, Digital Design, and Mathematics Teacher
Join our community to see this answer!
Unlock 1 Answer and 5 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 5 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros