How to pause loop while multithreading is alive - vb.net

I have 3 threads that are called inside a loop.
For i As Integer = 0 To DG.Rows.Count - 1
Dim thread1 = New System.Threading.Thread(AddressOf processData)
Dim thread2 = New System.Threading.Thread(AddressOf processData2)
Dim thread3 = New System.Threading.Thread(AddressOf processData3)
If Not thread1.IsAlive Then
x1 = i
thread1.Start()
ElseIf Not thread2.IsAlive Then
x2 = i
thread2.Start()
ElseIf Not thread3.IsAlive Then
x3 = i
thread3.Start()
End If
Next
How do I pause the loop while all threads are alive?
What I want is, if one of the threads finishes then continue the loop and get the (i), then pause the loop again if there are no available threads. Because sometimes DG.Rows items are more than 3.

Let the framework handle this for you: use the ThreadPool.
First, create an array to hold thread status for each item:
Dim doneEvents(DG.Rows.Count) As ManualResetEvent
Like the x1,x2,x3 variables, this needs to be accessible from both your main thread and the processData method.
Then modify your processData method to accept an Object argument at the beginning and set a ResetEvent at the end:
Public Sub processData(ByVal data As Object)
Dim x As Integer = CInt(data)
'...
'Existing code here
doneEvents(x).Set()
End Sub
Now you can just queue them all up like this:
For i As Integer = 0 To DG.Rows.Count - 1
ThreadPool.QueueUserWorkItem(processData, i)
Next
WaitHandle.WaitAll(doneEvents)
Console.WriteLine("All data is processed.")
Though I suspect you should also pass the data from your grid for each row to the processData method.
You can also use the newer Async/Await keywords, but I'll have a hard time writing a sample for this without knowing something of the contents of processData.

I think you want to do something like this. Don't pause, just launch a thread per loop iteration.
For i As Integer = 0 To DG.Rows.Count - 1
Dim thread1 = New System.Threading.Thread(AddressOf processData)
thread1.Start(i)
Next
But in any case, I don't think you want to call new System.Threading.Thread in each loop. Those should be moved outside the For loop.

It could be that you use TPL's Parallel methods and write your code like this:
Parallel.For( _
0, _
DG.Rows.Count, _
New ParallelOptions() With {.MaxDegreeOfParallelism = 3}, _
Sub(i) processData(i))
I don't understand why you have processData, processData2, and processData3 though.

Related

Ping multiple device names (hostname) on the Network

A DataGridView displays hostnames at Column index 0, computer / printer names on the network.
pc1
pc2
print3
pc5
print
....
There are more than 500 such names.
I know how to ping them:
For i = 0 To DataGridView1.Rows.Count - 1
Try
If My.Computer.Network.Ping(DataGridView1.Item(0, i).Value) = True Then
DataGridView1.Rows(i).DefaultCellStyle.BackColor = Color.Lime
Else
DataGridView1.Rows(i).DefaultCellStyle.BackColor = Color.Red
End If
Catch ex As Exception
DataGridView1.Rows(i).DefaultCellStyle.BackColor = Color.Red
End Try
Next
The problem is that the Ping takes a very long time and the application freezes.
How can you speed up this procedure?
And let's say if the node is not available, then simply remove it from the list.
An example to Ping multiple addresses at the same time, using the async version of provided by the Ping class, Ping.SendPingAsync().
This version is await-able, not the same as the Ping.SendAsync() method, still asynchronous but event-driven.
Since you're using a DataGridView to both store the IpAddress/HostName and to present the PingReply results, you need to determine a way to match the Ping result to correct Cell of the DataGridView from which the Ip/Host address was taken.
Here, I'm passing to the method the Row's Index, so when the Ping result comes back, asynchronously, we can match the response to a specific Cell in the DataGridView.
To make the initialization method more generic, I'm passing also the index of the Column where the Ip/Host address is stored and the index of the Column that will show the result (you could also just pass all indexes, not a DataGridView Control reference to the method and handle the results in a different way).
A loop extracts the addresses from the the DataGridView and creates a List(Of Task), adding a PingAsync() Task for each address found.
When the collection is completed, the List(Of Task) is passed to the Task.WhenAll() method, which is then awaited.
This method starts all the Task in the list and returns when all Task have a result.
► Note that the Ping procedure sets a TimeOut, to 5000ms here, so all the Tasks will return before or within that interval, successful or not.
You can then decide if you want to reschedule the failed Pings or not.
The UI update is handled using a Progress delegate. It's just a method (Action delegate) that is called when the Ping procedure has a result to show.
It can also be used when the method that updates the UI runs in a different Thread: the Report() method will call the Progress object delegate in the Thread that created the delegate: the UI Thread, here (in the example, we're not actually ever leaving it, though).
This is how it works:
Assume you're starting the ping sequence from Button.Click event handler.
Note that the handler is declared async.
Private Async Sub btnMassPing_Click(sender As Object, e As EventArgs) Handles btnMassPing.Click
Await MassPing(DataGridView1, 1, 2)
End Sub
Initialization method and IProgress<T> report handler:
Imports System.Drawing
Imports System.Net.NetworkInformation
Imports System.Net.Sockets
Imports System.Threading.Tasks
Private Async Function MassPing(dgv As DataGridView, statusColumn As Integer, addressColumn As Integer) As Task
Dim obj = New Object()
Dim tasks = New List(Of Task)()
Dim progress = New Progress(Of (sequence As Integer, reply As Object))(
Sub(report)
SyncLock obj
Dim status = IPStatus.Unknown
If TypeOf report.reply Is PingReply Then
status = DirectCast(report.reply, PingReply).Status
ElseIf TypeOf report.reply Is SocketError Then
Dim socErr = DirectCast(report.reply, SocketError)
status = If(socErr = SocketError.HostNotFound,
IPStatus.DestinationHostUnreachable,
IPStatus.Unknown)
End If
Dim color As Color = If(status = IPStatus.Success, Color.Green, Color.Red)
Dim cell = dgv(statusColumn, report.sequence)
cell.Style.BackColor = color
cell.Value = If(status = IPStatus.Success, "Online", status.ToString())
End SyncLock
End Sub)
For row As Integer = 0 To dgv.Rows.Count - 1
If row = dgv.NewRowIndex Then Continue For
Dim ipAddr = dgv(addressColumn, row).Value.ToString()
tasks.Add(PingAsync(ipAddr, 5000, row, progress))
Next
Try
Await Task.WhenAll(tasks)
Catch ex As Exception
' Log / report the exception
Console.WriteLine(ex.Message)
End Try
End Function
PingAsync worker method:
Private Async Function PingAsync(ipAddress As String, timeOut As Integer, sequence As Integer, progress As IProgress(Of (seq As Integer, reply As Object))) As Task
Dim buffer As Byte() = New Byte(32) {}
Dim ping = New Ping()
Try
Dim options = New PingOptions(64, True)
Dim reply = Await ping.SendPingAsync(ipAddress, timeOut, buffer, options)
progress.Report((sequence, reply))
Catch pex As PingException
If TypeOf pex.InnerException Is SocketException Then
Dim socEx = DirectCast(pex.InnerException, SocketException)
progress.Report((sequence, socEx.SocketErrorCode))
End If
Finally
ping.Dispose()
End Try
End Function

Datarow ends up with wrong or lost data

I'm scraping twitter tweets, I launch multiple backgroundworkers and they do the following:
For x as Integer = 0 to 5
Dim BGW As New BackgroundWorker
AddHandler BGW.DoWork, AddressOf TweetGrab
BGW.RunWorkerAsync(tweeturl)
Next
Public TemporaryRows As New List(Of DataRow)
Private Sub TweetGrab(tweeturl as String)
'some html stuff here
Dim ImageUrl as String = twitterImage.Attributes("src").Value
Dim ThumbnailUrl As String = ImageUrl & ":small"
Dim DataRowTemporary As DataRow = DataTable1.NewRow()
DataRowTemporary("ImageUrl") = ImageUrl
DataRowTemporary("ThumbnailUrl") = ThumbnailUrl
DataRowTemporary("Checked") = False
'I detect the error even here
TemporaryRows.Add(DataRowTemporary)
End Sub
Later on, I do stuff with the TemporaryRows. I loop over the rows and check if they meet some conditions.
The problem is that DataRowTemporary("Checked") ends being DBNull and DataRowTemporary("ThumbnailUrl") is completely different than ImageUrl even though I specified Dim ThumbnailUrl As String = ImageUrl & ":small"
This happens in about 2/10 cases. I would guess it has something to do with background threads but I don't have any ideas how to solve it. I can reedit the fields after the error occurs, but I would like to prevent the error from occurring in the first place.
The problem was changing the collection when its being accessed by other threads (in parallel).
You can not do add/remove in parallel, the collection must be locked in order to not get strange errors.
SyncLock TemporaryRows
TemporaryRows 'Add/Remove
End SyncLock

Is calling a subroutine inside Parallel.For (and passing a variable ByRef to it) thread safe?

I call a subroutine MyPartsMatrix inside nested Parallel.For loops (vb.net). MyPartsMatrix requires a variable called "unfilled" that is passed ByRef because this value is modified inside MyPartsMatrix subroutine. I need to grab and store this value after the subroutine MyPartsMatrix executes.
The "unfilled" variable yields a different value when I run the parallel version of this code compared to a one that is non-parallel, using normal nested For...Next loops. I can't figure out why this is the case.
Is it thread safe to call another subroutine from inside the Parallel.For loop?
Is this variable "unfilled" thread safe?
Dim ConcurrentListofResults As ConcurrentQueue(Of FindBestResults)
ConcurrentListofResults = New ConcurrentQueue(Of FindBestResults)
Dim x = 5, y = 5
Parallel.For(0, x, Sub(oD)
Parallel.For(0, y, Sub(oT)
Dim unfilled As Integer = 0
MyPartsMatrix (oD, oT, unfilled)
'Create a FBS item to add to the concurrent list collection
Dim FBSResultsItem = New FindBestResults
FBSResultsItem.oD = oD
FBSResultsItem.oT = oT
FBSResultsItem.unfilled = unfilled
'Add this item to the Concurent collection
ConcurrentListofResults.Enqueue(FBSResultsItem)
End Sub)
End Sub)
'Get best result.
Dim bestResult As FindBestResults
For Each item As FindBestResults In ConcurrentListofResults
If item.unfilled < bestResult.unfilled Then
bestResult.oD = item.oD
bestResult.oT = item.oT
bestResult.unfilled = item.unfilled
End If
Next
Public Sub MyPartsMatrix (ByVal oD As Integer, ByVal oT As Integer, ByRef unfilled As Integer)
'....do stuff with the unfilled variable....
'unfilled is a counter that is incremented while we run through the PartsMatrix
unfilled = unfilled + 1
End Sub
If this is not thread safe, is there another way to write this so that the "unfilled" variable is thread safe or to make calling another subroutine thread safe?
Without the definition of MakeSchedule (which you've called MyMakePartsMatrix in another place) it's impossible to say whether it's thread safe.
To be threadsafe the sub needs to not modify anything other than unfilled. This will ensure that calling it multiple times with the same inputs will always yield the same outputs. I'd also recommend converting to a function as I find this much easier to understand whats happening.
On another note:
Your performance will be better if you don't nest parallel loops. You're currently waiting for your inner loop to finish before launching your second loop. If you're using larger x + y values then something similar to the code will work better.
Dim scenarios = From x2 In Enumerable.Range(0, x)
From y2 In Enumerable.Range(0, y)
Select New With {x2, y2}
Parallel.ForEach(scenarios, Sub(s)
End Sub)

Status for threading

I am using a multi thread concept in my application.I am using below code
Dim threadHistory As Thread = Nothing
For Each dRow As DataRow In sqlDS.Tables(0).Rows
GetPropertyBidHistory(dRow("ID"))
threadHistory = New Threading.Thread(AddressOf GetRowHistory)
threadHistory.Name = "Row" + dRow("ID")
threadHistory.Start(dRow("ID"))
threadHistory.Join()
Next
Public Sub GetRowHistory(ByVal ID As String)
'1 min code from web srvice
End Sub
If i have 10 Id's , how can i know whether all 10 threads were completed or not.
You're starting and joining the thread one after the other. That is, perhaps, not your intent. If you keep it that way ou create a single thread, wait for it to finish and only then proceed to the next element.
I'd try the following: for each thread add it to a list or array and after the For Each/Next Statement You can Join them all with the property, i guess, JoinAll()
Dim List( Of Thread) allThreads = new List
Dim threadHistory As Thread = Nothing
For Each dRow As DataRow In sqlDS.Tables(0).Rows
GetPropertyBidHistory(dRow("ID"))
threadHistory = New Threading.Thread(AddressOf GetRowHistory)
threadHistory.Name = "Row" + dRow("ID")
allThreads.Add(threadHistory)
threadHistory.Start(dRow("ID"))
Next
Thread.JoinAll(allThreads) 'Blocks until all the threads finish

.NET Terminating Threads in an orderly fashion

Currently, I have a RingBuffer which is run by a producer and a consumer thread.
In looking for a method of terminating them orderly, I thought I'd use a flag to indicate when the producer had finished and then check that flag in my consumer along with the number of ring buffer slots that need to be written. If the producer has finished and the ring buffer has no slots that need to be written the consumer can terminate.
That works well.
However, if I artificially lengthen the time the producer takes by inserting a sleep, the consumer does not terminate. I believe this is a consequence of the semaphores being used.
Here is the code I'm working with. Notice that the program will "hang" after all slots have been written. The producer terminates, but the consumer "hangs".
Any advice on terminating both in an orderly fashion would be greatly appreciated.
Edit - Updated code with Henk's suggestion of using a Queue. +1000 points to the first person to suggest a better method of terminating the consumer/producer threads than either knowing the exact amount of items being worked with or returning a value such as null/nothing indicating that no more items exist in the queue (though this doesn't mean they aren't still being produced.)
Edit - I believe I've figured it out. Simply pass null or nothing to RingBuffer.Enqueue for each consumer and catch the null or nothing object in the consumer to terminate it. Hopefully someone finds this useful.
Imports System.Collections
Module Module1
Public Class RingBuffer
Private m_Capacity As Integer
Private m_Queue As Queue
Public Sub New(ByVal Capacity As Integer)
m_Capacity = Capacity
m_Queue = Queue.Synchronized(New Queue(Capacity))
End Sub
Public Sub Enqueue(ByVal value As Object)
SyncLock m_Queue.SyncRoot
If m_Queue.Count = m_Capacity Then
Threading.Monitor.Wait(m_Queue.SyncRoot)
End If
m_Queue.Enqueue(value)
Threading.Monitor.PulseAll(m_Queue.SyncRoot)
End SyncLock
End Sub
Public Function Dequeue() As Object
Dim value As Object = Nothing
SyncLock m_Queue.SyncRoot
If m_Queue.Count = 0 Then
Threading.Monitor.Wait(m_Queue.SyncRoot)
End If
value = m_Queue.Dequeue()
Console.WriteLine("Full Slots: {0} - Open Slots: {1}", m_Queue.Count, m_Capacity - m_Queue.Count)
Threading.Monitor.PulseAll(m_Queue.SyncRoot)
End SyncLock
Return value
End Function
End Class
Public Class Tile
Public buffer() As Byte
Public Sub New()
buffer = New Byte(1023) {}
End Sub
End Class
Public Sub Producer(ByVal rb As RingBuffer)
Dim enq As Integer = 0
Dim rng As New System.Security.Cryptography.RNGCryptoServiceProvider
For i As Integer = 0 To 1023
Dim t As New Tile
rng.GetNonZeroBytes(t.buffer)
rb.Enqueue(t)
enq += 1
Threading.Thread.Sleep(10)
Next i
rb.Enqueue(Nothing)
Console.WriteLine("Total items enqueued: " & enq.ToString())
Console.WriteLine("Done Producing!")
End Sub
Public Sub Consumer(ByVal rb As RingBuffer)
Dim deq As Integer = 0
Using fs As New IO.FileStream("c:\test.bin", IO.FileMode.Create)
While True
Dim t As Tile = rb.Dequeue()
If t Is Nothing Then Exit While
fs.Write(t.buffer, 0, t.buffer.Length)
deq += 1
Threading.Thread.Sleep(30)
End While
End Using
Console.WriteLine("Total items dequeued: " & deq.ToString())
Console.WriteLine("Done Consuming!")
End Sub
Sub Main()
Dim rb As New RingBuffer(1000)
Dim thrdProducer As New Threading.Thread(AddressOf Producer)
thrdProducer.SetApartmentState(Threading.ApartmentState.STA)
thrdProducer.Name = "Producer"
thrdProducer.IsBackground = True
thrdProducer.Start(rb)
Dim thrdConsumer As New Threading.Thread(AddressOf Consumer)
thrdConsumer.SetApartmentState(Threading.ApartmentState.STA)
thrdConsumer.Name = "Consumer"
thrdConsumer.IsBackground = True
thrdConsumer.Start(rb)
Console.ReadKey()
End Sub
End Module
If I look at the Consumer function:
If rb.FullSlots = 0 And Threading.Interlocked.Read(ProducerFinished) = 0 Then
Exit While
End If
Dim t As Tile = rb.Read()
The consumer could find rb.FullSlots = 0 but ProducerFinished = False and continue to Read(). Inside Read() it waits for the writerSemaphore but in the mean time the Producer could finish and never release the writerSemaphore.
So (at least) the producer should take steps to let the readers continue after it decreases the ProducerFinished.
But I think you get a better design if you move this 'Closing' logic to the Ring buffer. There you can combine it with the Data-available logic.