Hey all I am am currently getting the value for the progress bar that a application is using when I use the following code:
Dim progressBarThread = New Thread(New ThreadStart(AddressOf Me.ThreadProcSafe))
Me.Invoke(New MethodInvoker(AddressOf progressBarThread.Start))
Do
status = range.Current.Value.ToString
numwaits += 1
'Me.Invoke(New MethodInvoker(AddressOf progressBarThread.Start))
Wait(5)
Loop While status <> 100 AndAlso numwaits < 50
LogMessage("100%" + Environment.NewLine)
Delegate Sub SetTextCallback([text] As String)
Private Sub ThreadProcSafe()
Me.SetText(status)
End Sub
Private Sub SetText(ByVal [text] As String)
If Me.TextBox1.InvokeRequired Then
Dim d As New SetTextCallback(AddressOf SetText)
Me.Invoke(d, New Object() {[text]})
Else
Me.ProgressBar1.Value = [text]
End If
End Sub
Problem being is that it only gets the value once and doesn't constantly update the value as I am wanting. As you see in the code above, I tried to use Me.Invoke(New MethodInvoker(AddressOf progressBarThread.Start)) within the loop in order to see if it would update the value that way but it does not work and causes an error.
How can I accomplish this?
Related
I have code that sends a ping to a batch of computers, and opens a VNC session to any that respond that they are online.
The pings are sent in a parallel.foreach loop, and an event is raised when a reply is receieved.
Despite putting a synclock block around the AddHost code, it is still being entered by multiple threads simultaneously.
I think it has something to do with the code being called by a raiseevent on another object.
This is the method that is handling the event
Private Sub AddHost(hostname As String)
' panesList is an list(of RemoteDesktop) prepopulated with 36 individual RemoteDesktop objects
Dim vnc As RemoteDesktop = panesList(Position)
vnc.GetPassword = New AuthenticateDelegate(Function() vncPassword)
SyncLock Semaphore
Try
If Position = 36 Then
Return
End If
vnc.Connect(hostname, 0, True, True)
Position += 1
Catch ex As Exception
End Try
End SyncLock
End Sub
Private Sub HandleConnect(hostFilter As String)
AddHandler OnlineFinder.LiveComputer, AddressOf AddHost
Dim bg As New Task(Sub() OnlineFinder.CheckFilteredASync(hostFilter))
bg.Start()
' AddHandler OnlineFinder.SearchComplete, AddressOf Finished
End Sub
From the object OnlineFinder.vb
Public Sub CheckFilteredASync(filterString As String)
Dim Ctable As DataTable = CTableAdapter.GetDataByPartName($"{filterString}%")
Dim clist As New List(Of String)
For Each drow As DataRow In Ctable.Rows
clist.Add(drow.Field(Of String)("Name"))
Next
Searching = True
Dim parallelLoopResult = Parallel.ForEach(clist, Sub(site) Ping(site))
RaiseEvent SearchComplete()
End Sub
Private Sub Ping(host As String)
If ValidPing(host) Then
RaiseEvent LiveComputer(host)
End If
End Sub
How should I be doing this so only one event is processed at a time (but it doesn't hang the UI)
Issue
I am using multi-threading inside my application and the way it works is that i have an array that contains 22 string which stand for some file names:
Public ThreadList As String() = {"FSANO1P", "FJBJB1P", "COPOR1P", "FFBIVDP", "FFCHLDP", "FFDBKDP", "FFDREQP", "FFINVHP", "FFJMNEP", "FFPIVHP", "FFUNTTP", "FJBJM1P", "FJBJM2P", "FJBNT2P", "FPPBE9P", "FTPCP1P", "FTTEO1P", "FTTRQ1P", "FJBJU1P", "FTTEG1P", "FFJACPP", "XATXTDP"}
I then loop through the array and create a new thread for each file:
For Each mThreadName As String In ThreadList
Dim mFileImportThread = New FileImportThreadHandling(mThreadName, mImportGuid, mImportDate, Directory_Location, mCurrentProcessingDate, mRegion)
Next
So inside the new thread 'FileImportThreadHandling' it will call a method by starting a new thread:
mThread = New Thread(AddressOf DoWork)
mThread.Name = "FileImportThreadHandling"
mThread.Start()
Then in 'DoWork' it will determine what file is current in question and will run the code related to the file.
After the code has ran for the file I want to report this back to the main thread. Can somebody give me a solution please.
You will need to use Delegates
EDIT:
Take a look at this snippet:
Sub Main()
mThread = New Thread(AddressOf doWork)
mThread.Name = "FileImportThreadHandling"
mThread.Start()
End Sub
Sub doWork()
'do a lot of hard work
workDone(result)
End Sub
Delegate Sub workDoneDelegate(result As Integer)
Sub workDone(abilita As Boolean, Optional src As Control = Nothing)
If Me.InvokeRequired Then
Me.Invoke(New workDoneDelegate(AddressOf workDone), {result})
Else
'here you're on the main thread
End If
End Sub
Here is an example that might give you some ideas. Note the use of Async and Task. You will need a form with two buttons, and a label.
Public Class Form1
Public ThreadList As String() = {"FSANO1P", "FJBJB1P", "COPOR1P", "FFBIVDP", "*******", "FFJACPP", "XATXTDP"}
'note Async keyword on handler
Private Async Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Button1.Enabled = False
Dim running As New List(Of Task)
For Each tskName As String In ThreadList
'start new task
Dim tsk As Task
tsk = Task.Run(Sub()
For x As Integer = 1 To 10
Dim ct As Integer = x
'simulate code related to the file
Threading.Thread.Sleep(500)
'report to the UI
Me.Invoke(Sub()
Label1.Text = String.Format("{0} {1}", tskName, ct)
End Sub)
Next
End Sub)
Threading.Thread.Sleep(100) 'for testing delay between each start
running.Add(tsk)
Next
'async wait for all to complete
For Each wtsk As Task In running
Await wtsk
Next
Button1.Enabled = True
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
'test UI responsive during test
Label1.Text = DateTime.Now.ToString
End Sub
End Class
Using Actions and a callback to track remaining operations. (Simplified your class for my example)
Public ThreadList As String() = {"FSANO1P", "FJBJB1P", "COPOR1P", "FFBIVDP", "FFCHLDP"}
Private actionCounter As Integer = 0
Private lockActionCounter As New Object()
Sub Main()
Console.WriteLine("Starting...")
For Each mThreadName As String In ThreadList
Dim mFileImportThread = New FileImportThreadHandling(mThreadName)
actionCounter += 1
Call New Action(AddressOf mFileImportThread.DoWork).
BeginInvoke(AddressOf callback, mThreadName)
Next
Console.Read()
End Sub
Private Sub callback(name As IAsyncResult)
Dim remainingCount As Integer
SyncLock lockActionCounter
actionCounter -= 1
remainingCount = actionCounter
End SyncLock
Console.WriteLine("Finished {0}, {1} remaining", name.AsyncState, actionCounter)
If remainingCount = 0 Then Console.WriteLine("All done")
End Sub
Private Class FileImportThreadHandling
Shared r = New Random()
Private _name As String
Public Sub New(name As String)
_name = name
End Sub
Public Sub DoWork()
Dim delayTime = (r).Next(500, 5000)
Console.WriteLine("Doing {0} for {1:0}ms.", _name, delayTime)
Thread.Sleep(delayTime)
End Sub
End Class
I have a BackgrounWorker that calls vairous methods from a custom class called ExcelOutput. The below function works, but it does not allow me to check for cancellation.
Private Sub bw_DoWork(ByVal sender As Object,
ByVal e As DoWorkEventArgs)
Dim UserDump As New CurrentUserDumpInfo(Me.MainForm.ConfigForm) ' Create a new instance of the CurrentUserDumpInfo
Dim Excel As New ExcelOutput(Me) ' Create a new instance of the ExcelOutput
Dim FirstRow As Integer = 4 ' The row on which the output should start
Dim CurrentRow As Integer ' The currnet row on which the output shoud continue
'** Prepare the CurrentUserDumpInfo and the ExcelOutput *'
Call UserDump.prepare()
Call Excel.Prepare()
CurrentRow = Excel.OutputGroup("General", UserDump.lstGeneralHeaders, UserDump.lstGeneralData, FirstRow)
CurrentRow = Excel.OutputGroup("Address", UserDump.lstAddressHeaders, UserDump.lstAddressData, CurrentRow + 2)
Call Excel.AutofitContents(4, CurrentRow)
Call Excel.AlignCells(4, CurrentRow)
Call Excel.StyleWorksheet()
Call Excel.MakeSafeCopy()
Call Excel.LockWorksheet()
Call Excel.Finish(UserDump.CurrentUser.FullName)
End Sub
To do this, I've set each methods listed above to check for errors (using Try/Catch), and if there is an error, I set bw.WorkerSupportsCancellation = True call the bw.CancelAsync() method (you'll notice I pass Me when initiating the ExcelOutput instance, making this possible).
This method works, but to implement it fully I have to wrap every call in an If block like so, making the code very long and difficult to read (each call goes from 1 line to 6 lines) -
If bw.CancellationPending = True Then
e.Cancel = True
Exit Sub
Else
CurrentRow = Excel.OutputGroup("General", UserDump.lstGeneralHeaders, UserDump.lstGeneralData, 4)
End If
Is there a better way to do this, that will both keep the code short and sweat but offer the functionality of the cancellation check? Thanks.
Update
Thanks to the answer below, here is the exact bw_DoWork() method that I am now using, which achieves exactly what I was looking for -
Private Sub bw_DoWork(ByVal sender As Object,
ByVal e As DoWorkEventArgs)
Dim UserDump As New CurrentUserDumpInfo(Me.MainForm.ConfigForm) ' Create a new instance of the CurrentUserDumpInfo
Dim Excel As New ExcelOutput(Me) ' Create a new instance of the ExcelOutput
Dim FirstRow As Integer = 4 ' The row on which the output should start
Dim CurrentRow As Integer ' The currnet row on which the output shoud continue
Dim Counter As Integer = 0
While Not bw.CancellationPending = True
Select Case Counter
Case 0 : Call UserDump.prepare() : Exit Select ' Prepare the CurrentUserDumpInfo object ready for use
Case 1 : Call Excel.Prepare() : Exit Select ' Prepare the ExcelOutput object ready for use
Case 2 : CurrentRow = Excel.OutputGroup("General", UserDump.lstGeneralHeaders, UserDump.lstGeneralData, FirstRow) : Exit Select
Case 3 : CurrentRow = Excel.OutputGroup("Address", UserDump.lstAddressHeaders, UserDump.lstAddressData, CurrentRow + 2) : Exit Select
Case 4 : CurrentRow = Excel.OutputGroup("Account", UserDump.lstAccountHeaders, UserDump.lstAccountData, CurrentRow + 2) : Exit Select
Case 5 : CurrentRow = Excel.OutputGroup("Profile", UserDump.lstProfileHeaders, UserDump.lstProfileData, CurrentRow + 2) : Exit Select
Case 6 : Call Excel.AutofitContents(4, CurrentRow) : Exit Select
Case 7 : Call Excel.AlignCells(4, CurrentRow) : Exit Select
Case 8 : Call Excel.StyleWorksheet() : Exit Select
Case 9 : Call Excel.MakeSafeCopy() : Exit Select
Case 10 : Call Excel.LockWorksheet() : Exit Select
Case 11 : Call Excel.Finish(UserDump.CurrentUser.FullName) : Exit Select
Case Else : Exit While
End Select
Counter += 1
End While
'** Check to see if the BackgroundWorker should be cancelled *'
If bw.CancellationPending = True Then e.Cancel = True
End Sub
There's a "common" rule not to use try/catch in a DoWork event. The exception is if you want to dispose or clean up objects. If an error occurs it will be available in the RunWorkerCompleted event (e.Error).
Private Sub bw_DoWork(sender As Object, e As DoWorkEventArgs) Handles bw.DoWork
Dim obj As IDisposable = Nothing
Dim [error] As Exception = Nothing
Try
obj = New Control()
Throw New Exception("Simulated exception")
Catch ex As Exception
[error] = ex
Finally
If (Not obj Is Nothing) Then
obj.Dispose()
obj = Nothing
End If
End Try
If (Not [error] Is Nothing) Then
Throw [error]
End If
End Sub
With that being said, you can try to do the work in a While Loop and check for cancellation after each cycle.
Private Sub bw_DoWork(sender As Object, e As DoWorkEventArgs) Handles bw.DoWork
Dim worker As BackgroundWorker = DirectCast(sender, BackgroundWorker)
Dim num As Integer = Nothing
Dim obj As IDisposable = Nothing
Dim [error] As Exception = Nothing
Try
'TDOD: obj = New IDisposable ()
num = 0
While (Not e.Cancel)
Select Case num
Case 0
'Do somthing
Exit Select
Case 1
'Do somthing
Exit Select
Case 2
'Do somthing
Exit Select
Case Else
Exit While
End Select
num += 1
e.Cancel = worker.CancellationPending
End While
Catch ex As Exception
[error] = ex
Finally
If (Not obj Is Nothing) Then
obj.Dispose()
obj = Nothing
End If
End Try
If (Not [error] Is Nothing) Then
Throw [error]
ElseIf (Not e.Cancel) Then
'TODO: e.Result = Nothing
End If
End Sub
I am writing an application in VB.NET that allows users to schedule submissions (emails) to be sent at a later date. I use threads to wait until the time is right to send a particular submission, but for some reason I can't access one of the class objects from the listener threads (or something else is happening, that's what I'm trying to figure out). Here is the relevant code:
Public Class AppContext
Inherits ApplicationContext
Private submsnMngr As SubmissionManager
Public Sub New()
submsnMgr = New SubmissionManager()
menuAddEdit = New ToolStripMenuItem("Add/Edit Submissions")
...
End Sub
Private Sub menuAddEdit_Click(ByVal sender As Object, ByVal e As System.EventArgs)
Handles menuAddEdit.Click
' The user clicking this tray button is the ONLY way that the form can be shown
submsnMngr.ShowWelcome()
End Sub
...
End Class
Class SubmissionManager
Public currentSubmissions As SubmissionList
Public WelcomeForm As Welcome
Public Sub ShowWelcome()
If WelcomeForm Is Nothing Then
' Welcome is the form that needs to be refreshed down in the MailSender subroutine
WelcomeForm = New Welcome(Me)
End If
WelcomeForm.Show()
End Sub
Public Sub CheckDates()
For Each submsn In currentSubmissions.Submissions
SyncLock submsn
If Today.Date >= submsn.EffDate.AddDays(-90).Date And Not submsn.Sent90 And Not submsn.Denied90 And submsn.Thread Is Nothing Then
submsn.Send(1)
submsn.Sent90 = True
currentSubmissions.Save()
ElseIf Today.Date = submsn.EffDate.AddDays(-91).Date And submsn.Thread Is Nothing Then
Dim thd As New Thread(AddressOf MailSender)
thd.IsBackground = True
submsn.Thread = thd
Dim args As New ThreadArgs(submsn.Insured, 1)
thd.Start(args)
End If
If Today.Date >= submsn.EffDate.AddDays(-60).Date And submsn.Thread Is Nothing Then
submsn.Send(2)
currentSubmissions.RemoveSubmission(submsn)
If WelcomeForm IsNot Nothing Then
WelcomeForm.RefreshSubmissions()
End If
ElseIf Today.Date = submsn.EffDate.AddDays(-61).Date And submsn.Thread Is Nothing Then
Dim thd As New Thread(AddressOf MailSender)
thd.IsBackground = True
submsn.Thread = thd
Dim args As New ThreadArgs(submsn.Insured, 2)
thd.Start(args)
End If
End SyncLock
Next
End Sub
Private Sub DateListener()
Do
CheckDates()
Thread.Sleep(3600000)
Loop
End Sub
Private Sub MailSender(args As ThreadArgs)
Dim wait As New TimeSpan(14 - DateTime.Now.Hour, 23 - DateTime.Now.Minute, 0)
Thread.Sleep(wait.TotalMilliseconds)
Dim submsn As Submission = currentSubmissions.GetSubmission(args.insured)
SyncLock submsn
submsn.Send(args.mode)
If args.mode = 1 Then
submsn.Sent90 = True
submsn.Thread = Nothing
currentSubmissions.Save()
Else
currentSubmissions.RemoveSubmission(submsn)
End If
End SyncLock
If WelcomeForm IsNot Nothing Then
' Here is the issue, this code is not being run, even though WelcomeForm is set
' in New() above
WelcomeForm.RefreshSubmissions()
End If
End Sub
End Class
Paying special attention to the few comment lines in the code above, why is WelcomeForm Nothing when I clearly set it to reference the form created in the New() subroutine? I tried alternatively sending the reference to the MailSender thread as an argument, but the same thing happened. Note that I need the If statement there because the user may have closed the form before the thread gets to that point. But it is essential that RefreshSubmissions() be called on it if it is still open.
Sorry guys, realized my thread was being aborted elsewhere in my application's code. No problems with the actual code I posted above.
I am trying to multi thread my application so as it is visible while it is executing the process, this is what I have so far:
Private Sub SendPOST(ByVal URL As String)
Try
Dim DataBytes As Byte() = Encoding.ASCII.GetBytes("")
Dim Request As HttpWebRequest = TryCast(WebRequest.Create(URL.Trim & "/webdav/"), HttpWebRequest)
Request.Method = "POST"
Request.ContentType = "application/x-www-form-urlencoded"
Request.ContentLength = DataBytes.Length
Request.Timeout = 1000
Request.ReadWriteTimeout = 1000
Dim PostData As Stream = Request.GetRequestStream()
PostData.Write(DataBytes, 0, DataBytes.Length)
Dim Response As WebResponse = Request.GetResponse()
Dim ResponseStream As Stream = Response.GetResponseStream()
Dim StreamReader As New IO.StreamReader(ResponseStream)
Dim Text As String = StreamReader.ReadToEnd()
PostData.Close()
Catch ex As Exception
If ex.ToString.Contains("401") Then
TextBox2.Text = TextBox2.Text & URL & "/webdav/" & vbNewLine
End If
End Try
End Sub
Public Sub G0()
Dim siteSplit() As String = TextBox1.Text.Split(vbNewLine)
For i = 0 To siteSplit.Count - 1
Try
If siteSplit(i).Contains("http://") Then
SendPOST(siteSplit(i).Trim)
Else
SendPOST("http://" & siteSplit(i).Trim)
End If
Catch ex As Exception
End Try
Next
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim t As Thread
t = New Thread(AddressOf Me.G0)
t.Start()
End Sub
However, the 'G0' sub code is not being executed at all, and I need to multi thread the 'SendPOST' as that is what slows the application.
Catch ex As Exception
End Try
A very effective way to stop .NET from telling you what you did wrong. Not knowing why it doesn't work is however the inevitable outcome.
Delete that.
Public Class Form1
'This just shows some concepts of threading.
'it isn't intended to do anything
'requires a Button, and two Labels
'
Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) _
Handles Button1.Click
'starts / stops a test thread
'isRun = 0 no thread running, start one
'isRun = 1 thread running, stop it
If Threading.Interlocked.Read(isRun) = 0L Then
'start thread
Threading.Interlocked.Increment(isRun)
t = New Threading.Thread(AddressOf showTime)
'simple threading app - display time about twice per second
t.IsBackground = True 'from a background thread
t.Start()
Else
'stop thread
Threading.Interlocked.Exchange(isRun, 0L)
t.Join() 'wait for thread to end
Threading.Monitor.Enter(listLock)
intervalList.Clear() 'clear the list
Threading.Monitor.Exit(listLock)
Label1.Text = "Stop"
Label2.Text = ""
End If
End Sub
Dim t As Threading.Thread
Dim intervalList As New List(Of Double)
Dim listLock As New Object
Dim isRun As Long = 0L
Private Sub showTime()
Dim dlgt As New UpdLblDel(AddressOf UpdateLabel) 'delegate for UI access
Dim lastDateTime As DateTime = Nothing
Do
Dim d As DateTime = DateTime.Now
If lastDateTime <> Nothing Then
'record difference of times - check sleep interval
Threading.Monitor.Enter(listLock)
intervalList.Add((d - lastDateTime).TotalMilliseconds)
Threading.Monitor.Exit(listLock)
End If
lastDateTime = DateTime.Now
dlgt.BeginInvoke(d, Nothing, Nothing) 'update the UI - note immediate return
Threading.Thread.Sleep(500) 'sleep for approx. 500 ms.
Loop While Threading.Interlocked.Read(isRun) = 1L
End Sub
Delegate Sub UpdLblDel(ByVal theTime As Object)
Private Sub UpdateLabel(ByVal theTime As Object)
If Threading.Interlocked.Read(isRun) = 1L Then
If Label1.InvokeRequired Then 'prevent cross-thread errors
Label1.BeginInvoke(New UpdLblDel(AddressOf UpdateLabel), theTime)
Exit Sub
Else
Label1.Text = CType(theTime, DateTime).ToString("HH:mm:ss.f") 'show the time from the background thread
End If
If Threading.Interlocked.Read(intervalList.Count) >= 10L Then
'take average
Threading.Monitor.Enter(listLock)
Dim avg As Double = intervalList.Sum / intervalList.Count 'sum all of the intervals / count
intervalList.Clear() 'clear the list
intervalList.Add(avg) 'forward the average
Label2.Text = avg.ToString("n2") 'show average
Threading.Monitor.Exit(listLock)
End If
End If
End Sub
End Class
You have to wrap the method that accesses the UI component in a delegate (it doesn't have to be a named delegate; it can be anonymous or an Action or Func), and then pass that to Me.Invoke, as others have alluded to.
In this example, I'm wrapping the split functionality in a lambda, and assigning that lambda to a variable of type Func(Of String()). I then pass that variable to Me.Invoke.
Public Sub G0()
Dim siteSplitFunc As Func(Of String()) = Function() _
TextBox1.Text.Split(vbNewLine.ToCharArray())
Dim siteSplit As String() = CType(Me.Invoke(siteSplitFunc), String())
For i = 0 To siteSplit.Count - 1
Try
If siteSplit(i).Contains("http://") Then
SendPOST(siteSplit(i).Trim)
Else
SendPOST("http://" & siteSplit(i).Trim)
End If
Catch ex As Exception
'Do something useful
End Try
Next
End Sub
You cannot access UI object directly from a thread.
When you want to read/write a textbox, you have to do it in the UI thread. This can be done by using Invoke. Or better yet, send/receive the information with parameters.
Here's a Delegate and a matching method. You call the method to update the textbox and it figures out if it should proxy the method for you by basically asking form if its on the same thread:
Private Delegate Sub UpdateTextBoxDelegate(ByVal text As String)
Private Sub UpdateTextBox(ByVal text As String)
If Me.InvokeRequired Then
Me.Invoke(New UpdateTextBoxDelegate(AddressOf UpdateTextBox), text)
Else
TextBox2.Text &= text
End If
End Sub
To use it, just change your catch statement to:
If ex.ToString.Contains("401") Then
UpdateTextBox(URL & "/webdav/" & vbNewLine)
End If