queing jobs in threadpool vb.net - vb.net

i have 20,000 items in a queue, and i want to process them using the threadpool.
will this be the best way to do it?
for i as integer = 0 to 19999
ThreadPool.QueueUserWorkItem (PerformTask, ListTask(i))
next
Sub PerformTask(i as string)
' do the work here
end sub
How can i return or set ui control from the PerformTask sub?

You cannot.
However, you can allocate a container (array, list) with a different slot for each result, and write into it. Alternatively, you could pass an object into the worker method that holds both the input and the result. I’d use this method:
Class TaskObject
Dim Input As String
Dim Result As Whatever
End Class
Dim tasks As TaskObject() = New TaskObject(20000) { }
For i as Integer = 0 to tasks.Length - 1
ThreadPool.QueueUserWorkItem(PerformTask, tasks(i))
next
Sub PerformTask(arg As Object)
Dim task As TaskObject = DirectCast(arg, TaskObject)
' do the work here
end sub
Unrelated: you should always enable Option Strict in your projects. No exception. Your code has type errors that the compiler should detect.

Related

For Each loop encountered 'Collection was modified; enumeration operation may not execute', but I need to change list's size at runtime

I'm attempting to code a Huffman Encoding system in VB, using .NET 6. Here is the main code as it currently stands, using 'ConstructionQueue' as a priority queue to handle the nodes being added to the 'Tree' list. 'Node' is an abstract class from which 'LeafNode' and 'InternalNode' inherit; at the time this class is run, ConstructionQueue is filled with only LeafNode's. My issue is that I need to add InternalNodes to the queue during this initialization process to be handled. Here is the current code:
Public Class HuffmanTree
Private Tree As New List(Of Node)
Public Sub New(ByVal ConstructionQueue As PriorityQueue)
Dim PairMade As Boolean = False
Dim NodesProcessed As Integer = 0
Dim TempWeight As Integer
For Each Node In ConstructionQueue.QueueFrame
If ConstructionQueue.GetFrontPointer <> 0 And ConstructionQueue.GetFrontPointer Mod 2 = 0 Then
PairMade = True
End If
Tree.Insert(NodesProcessed, Node)
If PairMade = True Then
Dim TempNode As New InternalNode(ConstructionQueue.QueueFrame(ConstructionQueue.GetFrontPointer).GetWeight + TempWeight)
TempNode.SetLeftPointer(Tree(NodesProcessed - 1))
TempNode.SetRightPointer(Tree(NodesProcessed))
ConstructionQueue.Enqueue(TempNode)
PairMade = False
Else
TempWeight = Node.GetWeight
End If
NodesProcessed += 1
ConstructionQueue.SetFrontPointer(NodesProcessed)
Next
End Sub
End Class
Collection was modified; enumeration operation may not execute.
is the error I receive on the 'Next' before End Sub. I completely understand why, the issue is that I can't alter the size of the 'QueueFrame' List, but I need a method of doing this that is going to allow me to go through each node in the list whilst being able to change its size, as there will be multiple instances where I need to add to the list as I'm using it.
Does anyone know of any sort of workaround or fix to this? I'd be happy to provide any more information needed.

How to unit test VBA code? - Two different pointers

I am working on this excellent tutorial, but in the end my first test is not passing, due to the fact that I can clearly see I am creating two different arrays (and pointers), and trying to compare them with one another.
Now the tutorial from what I can see leaves out a few lines of code that I have added, which is also where I see the problem, but without those lines the code does not even run of coarse.
All my other test methods are the same as the example, except for this method that I created the following lines - else nothing happens when you run the test.
Public Sub Run(ByVal dataService As IDataService, ByVal wsService As IWorksheetService)
Dim data As Variant 'Added this line
data = dataService.GetSomeTable 'Added this line
Call wsService.WriteAllData(data) 'Added this line
End Sub
And here is where I can see the code going south...
'#TestMethod
Public Sub WorksheetServiceWorksOffDataFromDataService()
'Arrange
Dim dataServiceStub As MyDataServiceStub
Set dataServiceStub = New MyDataServiceStub
Dim expected As LongLong
expected = VarPtr(dataServiceStub.GetSomeTable) 'expected creates an Array
Dim wsServiceStub As MyWorksheetServiceStub
Set wsServiceStub = New MyWorksheetServiceStub
'Act
With New MyTestableMacro
.Run dataServiceStub, wsServiceStub 'here we create a second array
End With
Dim actual As LongLong
actual = wsServiceStub.WrittenArrayPointer 'here we point to the address of the second array
'Assert
Assert.AreEqual expected, actual ' this test fails cause it points to two different addresses
End Sub
I had to change the type from Long as in the tutorial for the array pointers to LongLong due to the fact that the number on 64 bit is too long for Long. LongPtr also worked
VarPtr is what's artificially complicating that test, introducing frail and flawed pointer logic that doesn't need to be there.
Change your stub data service to return some non-empty data - literally anything will do:
Option Explicit
Implements IDataService
'#Folder "Services.Stubs"
Private Function IDataService_GetSomeTable() As Variant
IDataService_GetSomeTable = GetSomeTable
End Function
Public Function GetSomeTable() As Variant
Dim result(1 To 50, 1 To 10) As Variant
result(1, 1) = "test"
GetSomeTable = result
End Function
Now change the stub worksheet service to keep a copy of the actual data (rather than just a LongPtr):
Option Explicit
Implements IWorksheetService
'#Folder "Services.Stubs"
Private Type TStub
WasWritten As Boolean
WrittenData As Variant
End Type
Private this As TStub
Private Sub IWorksheetService_WriteAllData(ByRef data As Variant)
this.WasWritten = True
this.WrittenData = data
End Sub
Public Property Get DataWasWritten() As Boolean
DataWasWritten = this.WasWritten
End Property
Public Property Get WrittenData() As Variant
WrittenData = this.WrittenData
End Property
Now change the test to assert that IDataService.GetSomeTable is returning the same data that IWorksheetService.WriteAllData works with - you can do that using Assert.SequenceEquals, which compares all elements of two arrays and fails if anything is different:
'#TestMethod
Public Sub WorksheetServiceWorksOffDataFromDataService()
'Arrange
Dim dataServiceStub As StubDataService
Set dataServiceStub = New StubDataService
Dim expected As Variant
expected = dataServiceStub.GetSomeTable
Dim wsServiceStub As StubWorksheetService
Set wsServiceStub = New StubWorksheetService
'Act
With New Macro
.Run dataServiceStub, wsServiceStub
End With
Dim actual As Variant
actual = wsServiceStub.WrittenData
'Assert
Assert.SequenceEquals expected, actual
End Sub
This makes the test much simpler, and it passes:
I will be updating the article with this simpler test later today.

How can I dequeue an item at certain index in a queue of string?

I am trying to dequeue items if they contain a certain string. This is the idea I was hoping would work but does not:
Dim baseUri As String = myuri.GetLeftPart(UriPartial.Authority)
For i = workerURLs.Count - 1 To 0 Step -1
If workerURLs(i).Contains(baseUri) Then
workerURLs.Dequeue(i)
End If
Next
Since the queue method has no "Dequeue at index" option like a list would how can I accomplish this?
One way to implement it would be to wrap a Queue(Of T) and recreate it when an element gets "dequeued" from the middle:
Class IndexableQueue(Of T)
Private _queue As New Queue(Of T)()
Public Sub Enqueue(item As T)
_queue.Enqueue(item)
End Sub
Public Function Dequeue() As T
Return _queue.Dequeue()
End Function
Public Function Dequeue(index As Integer) As T
Dim list = _queue.ToList()
Dim item = list(index)
list.RemoveAt(index)
_queue = New Queue(Of T)(list)
Return item
End Function
End Class
This is the simplest implementation although it's not the most efficient as we are recreating the Queue on every call to Dequeue(Integer). But if it's uncommon and the queue is not massive it should be fine.
The best way would be to completely reimplement the Queue and use a List instead of an array as underlying type.

For each element in list byref

I have a list of structures that have to be passed as argument to threads; one for each element in the list. The thread will loop until a boolean in the structure become true.
So I made:
For Each ScaleElement In Scales
Dim NewThread As New System.Threading.Thread(Sub() ScaleThread(ScaleElement))
NewThread.Start()
Next
With ScaleElement passed byref. But then, I have a warning: "Wsing the iteration variable in a lambda expression may have unexpected results". And the warning it's right because it seems to run the thread on the same element.
If I try:
For Each ScaleElement In Scales
Dim NewScale = ScaleElement
Dim NewThread As New System.Threading.Thread(Sub() ScaleThread(NewScale))
NewThread.Start()
Next
It works fine but, as the "NewScale" is a different element, when I try to set the condition for breaking the loop in the elements in the list, of course it doesn't work.
ScaleStruct:
Public Structure ScaleStruct
Dim Key As String
Public Scale
Dim Database As String
Dim Table As String
Dim Field As String
Dim Keyname As String
Dim Interval As Integer
Dim Insert As Boolean
Dim Format As String
Public Abort As Boolean
Dim FailCount As Integer
End Structure
The scale variable is set (on the configuration file reading) to a class that reads the scale.
Scales is a "Public Scales As New List(Of ScaleStruct)" so, when I want to stop the threads, I would like to use a boolean (Abort) in the struct.
Then, the thread is a loop:
Private Sub ScaleThread(ByRef Tscale As ScaleStruct)
Do Until Tscale.Abort
...
Loop
End Sub
How can I solve this?
Do you mean that ScaleElement has a Boolean property to determine whether or not to keep going? If so, it sounds like the simplest approach would be to make it a class rather than a structure. (It sounds like it would be a better fit as a class anyway, to be honest.)

Threading Exception: The number of WaitHandles must be less than or equal to 64

The title is to make this easy to find for others having this error. I'm new to Threading, so this is really giving me heck. I'm getting this runtime error that crashed Cassini. This is code that I'm maintaining originally developed as a website project in VS 2003 and converted to a VS 2008 website project.
Important Info:
The number of objects in the manualEvents array is 128 in this case.
products is an array of Strings
Need to support .NET 2.0
For Each product As String In products
If Not product.Trim().ToUpper().EndsWith("OBSOLETE") Then
calls += 1
End If
Next
Dim results(calls - 1) As DownloadResults
'Dim manualEvents(calls - 1) As Threading.ManualResetEvent '128 objects in this case.
Dim manualEvents(0) As Threading.ManualResetEvent
manualEvents(0) = New Threading.ManualResetEvent(False)
'NOTE: I don't think this will work because what is not seen here, is that
' this code is being used to populate and cache a long list of products,
' each with their own category, etc. Am I misunderstanding something?
'initialize results structures
'spawn background workers
calls = 0
For Each product As String In products
If Not product.Trim().ToUpper().EndsWith("OBSOLETE") Then
Dim result As New DownloadResults
'manualEvents(calls) = New Threading.ManualResetEvent(False)
'Moved above For Each after declaration of variable
result.params.product = product
result.params.category = docType
'result.ManualEvent = manualEvents(calls)
result.ManualEvent = manualEvents(0)
result.Context = Me._context
results(calls) = result
Threading.ThreadPool.QueueUserWorkItem(AddressOf ProcessSingleCategoryProduct, results(calls))
Threading.Interlocked.Increment(calls) 'Replaces below incrementation
'calls += 1
End If
Next
Threading.WaitHandle.WaitAll(manualEvents) 'CRASHES HERE
Thread Helper Function (for the sake of completion)
Public Shared Sub ProcessSingleCategoryProduct(ByVal state As Object)
Dim drs As DownloadResults = CType(state, DownloadResults)
Dim adc As New cADCWebService(drs.Context)
drs.docs = adc.DownloadADC(drs.params.category, drs.params.product)
drs.ManualEvent.Set()
End Sub
You don't need an array of 128 manual events to check for completion of all 128 threads.
Create only one manual reset event and a plain integer starting at 128. Decrement that integer using Interlocked.Decrement at the end of ProcessSingleCategoryProduct, and only signal the event when the count reaches zero:
if (Interlocked.Decrement(ByRef myCounter) = 0) myEvent.Set();
Then declare only one Threading.ManualResetEvent as opposed to an array of them, and you can call WaitOne instead of WaitAll on it, and you are done.
See also usr's comment for an easier alternative in case you have .NET 4.