Hi folks I have the code below which i wanted to use all my processors cores. Originally, the code in the sub chekFileDupe was all within the For..Next loop in SearchForDupes sub and worked just fine on one thread. I'm a bit stuck as to create 4 threads that execute the checkFileDupe code so that i can check 4 items at a time, then wait till all 4 threads have completed. Then carry on with the next iteration of the loop.
This is the original code
Private Sub SearchForDupes()
Me.Refresh()
Dim totalrecords As Integer = dvSortedSearchResults.Count
Label1.Text = "Searching for duplicates"
Label1.Refresh()
dvSortedSearchResults.Sort = DataSortOrder
For i = 0 To totalrecords - 6 Step 4
Dim TrackDifference As Integer
Dim originalTrack, originalArtist, trackToCompare, artistToCompare As String
If i / 10 = CInt(i / 10) Then
Label2.Text = i.ToString + " of " + totalrecords.ToString
Label2.Refresh()
End If
originalArtist = mp3record(i, "Artist")
originalTrack = mp3record(i, "Track")
Dim ii As Integer = i + 1
While ii < totalrecords - 2
artistToCompare = mp3record(ii, "Artist")
trackToCompare = mp3record(ii, "Track")
TrackDifference = Difference(originalTrack, trackToCompare)
dvSortedSearchResults(ii).Item("Difference") = TrackDifference
'dgvSearchResults.Rows(ii).Cells("Difference").Value = trackdiff
If Difference(originalArtist, artistToCompare) < 6 Then
TrackDifference = Difference(originalTrack, trackToCompare)
If TrackDifference < 4 Then
dvSortedSearchResults(i).Item("Difference") = 999
dvSortedSearchResults(ii).Item("Difference") = TrackDifference
dvSortedSearchResults(ii).Item("chkdupe") = True
End If
Else
Exit While
End If
ii = ii + 1
End While
Next
Label2.Text = ""
Label1.Text = ""
End Sub
This is the first attempt at multithreading - probably naive but hey - everyone's new at something
Private Sub SearchForDupes()
'Dim query = (From record In dvSortedSearchResults Where record.Artist = "Abba" Select record).ToList
Me.Refresh()
Dim totalrecords As Integer = dvSortedSearchResults.Count
Label1.Text = "Searching for duplicates"
Label1.Refresh()
dvSortedSearchResults.Sort = DataSortOrder
Dim params(2) As Integer
For i = 0 To totalrecords - 6 Step 4
params(2) = totalrecords
params(1) = i
thread1 = New System.Threading.Thread(Sub() checkFileDupe(params))
thread1.Start()
params(1) = i + 1
thread2 = New System.Threading.Thread(Sub() checkFileDupe(params))
thread2.Start()
params(1) = i + 2
thread3 = New System.Threading.Thread(Sub() checkFileDupe(params))
thread3.Start()
params(1) = i + 3
thread4 = New System.Threading.Thread(Sub() checkFileDupe(params))
Next
Label2.Text = ""
Label1.Text = ""
End Sub
Private Sub checkFileDupe(params As Array)
Dim i As Integer = params(1)
Dim totalrecords As Integer = params(2)
Dim TrackDifference As Integer
Dim originalTrack, originalArtist, trackToCompare, artistToCompare As String
If i / 10 = CInt(i / 10) Then
Label2.Text = i.ToString + " of " + totalrecords.ToString
Label2.Refresh()
End If
originalArtist = mp3record(i, "Artist")
originalTrack = mp3record(i, "Track")
Dim ii As Integer = i + 1
While ii < totalrecords - 2
artistToCompare = mp3record(ii, "Artist")
trackToCompare = mp3record(ii, "Track")
TrackDifference = Difference(originalTrack, trackToCompare)
dvSortedSearchResults(ii).Item("Difference") = TrackDifference
'dgvSearchResults.Rows(ii).Cells("Difference").Value = trackdiff
If Difference(originalArtist, artistToCompare) < 6 Then
TrackDifference = Difference(originalTrack, trackToCompare)
If TrackDifference < 4 Then
dvSortedSearchResults(i).Item("Difference") = 999
dvSortedSearchResults(ii).Item("Difference") = TrackDifference
dvSortedSearchResults(ii).Item("chkdupe") = True
End If
ii = ii + 1
End While
End Sub Else
Exit While
End If
Actually, what I might advise you to do is forget about the code you have now and use a BackgroundWorker control. Start with just creating one thread to do the work and get that up and running. The advantage is that the background worker allows you to report progress back to the main UI thread. There should be plenty of tutorials out there.
I can try to tackle/indicate some of the problems in your current code, but to be honest there is a lot wrong with it.
You have a problem where you use the same underlying object, params(2), for each thread you create, so when you modify params you thereby modify the value that all the threads see. What you need to do is create a new array for each time you want to pass an argument to a new thread.
It's also extra confusing because you are using closures Sub () checkFileDupe(params), rather than using a correct signature for checkFileDupe and using Thread.Start to pass the argument.
I'd advise you to create a Structure to hold the arguments to your thread:
Private Structure FileDupeArguments
Public StartIndex As Integer
Public TotalRecords As Integer
End Structure
Then you can create a new thread via:
Dim params As FileDupeArguments
...
thread1 = New System.Threading.Thread(AddressOf checkFileDupe)
params = New FileDupeArguments With {.StartIndex = i, .TotalRecords = totalrecords}
thread1.Start(params)
And then declaring checkFileDupe as:
Sub checkFileDupe(argObj as Object)
Dim args As FileDupeArguments = CType(argObj, FileDupeArguments)
Dim i As Integer = args.StartIndex
Dim totalRecords As Integer = args.TotalRecords
...
End Sub
The important part here is that you send a new copy of FileDupeArguments to each thread. Also, no closures are needed.
There is an issue with you accessing controls from the threads you created.
For instance,
Label2.Text = i.ToString + " of " + totalrecords.ToString
Label2.Refresh()
will not work on a background thread and will give you errors. I'd advise you to not do direct progress reports from your worker threads. Like I mentioned, a BackgroundWorker will allow you to report back progress using events.
All the code that accesses dvSortedSearchResults suffers from the same or similar problems. If you access something from multiple threads, you need to apply locks. This is already more advanced and beyond the scope of this answer to explain.
Related
Today i continue my work, Building a menu with a vb.net console application. I found more samples to build with Windows forms. Still i try to get Basic Knowledge with the console surface.I was not able to put the following marquee text in a scroll menu, the second Code past the marquee text.
Module Module1
Dim aTimer As New System.Timers.Timer
Const marqueeText As String = "The quick brown fox... "
Dim sb As New System.Text.StringBuilder
Dim direction As Boolean = False
Sub Main()
aTimer.AutoReset = True
aTimer.Interval = 100 '1/10 second
AddHandler aTimer.Elapsed, AddressOf tick
aTimer.Start()
Console.ReadKey()
End Sub
Private Sub tick(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs)
Console.Clear()
If sb.Length = 0 Then sb.Append(marqueeText)
If direction Then
sb.Insert(0, sb(sb.Length - 1))
sb.Remove(sb.Length - 1, 1)
Else
sb.Append(sb(0))
sb.Remove(0, 1)
End If
Console.CursorLeft = 10 'no visible change
Console.CursorTop = 10 'visible change
Console.Write("{0}{1}", vbCr, sb.ToString)
End Sub
End Module
The marquee text Output from above is not easy to manage with the console.cursorleft command. I have no clue how to move it to the right or to put the marquee Output in the following Code, a scroll menu, on the third line.
Module Module1
Dim MenuList As New List(Of String)
Sub PrintMenu(highlight As Integer, left As Integer, top As Integer)
Dim Nickvektor() As Integer = {1, 2, 3, 4, 5}
For I = 0 To MenuList.Count - 1
Console.CursorLeft = left
Console.CursorTop = top + I
If I = highlight Then
Console.Write("{0}", "[" & Nickvektor(I) & "]")
Else
Console.Write(MenuList(I))
End If
Next
End Sub
Sub Main()
Console.CursorVisible = False
Dim x As Integer = 0
Dim Nickvektor() As String = {" "}
For counter As Integer = 0 To 0
Do
For Each s In Nickvektor
MenuList.Add(s)
Next
x += 1
Loop Until x = 5
Next
Console.SetCursorPosition(10, 16)
Console.Write("[ ]")
Dim CurrentItem As Integer = 0
Dim CurrentKey As ConsoleKey
While CurrentKey <> ConsoleKey.Enter
PrintMenu(CurrentItem, 10, 10)
CurrentKey = Console.ReadKey(True).Key
Select Case CurrentKey
Case ConsoleKey.DownArrow
CurrentItem += 1
Case ConsoleKey.UpArrow
CurrentItem -= 1
End Select
CurrentItem = (CurrentItem + MenuList.Count) Mod MenuList.Count
End While
End Sub
End Module
The menu Frame for the above Code can be used with the up and down arrows on the Keyboard.
Maybe it is to much work but i have no clue how to continue.
The first Solution for the marquee Output is an easy change of the original code. The wrap, vbCr, was the main Problem to move the text output toward the right edge oft he screen. The following code can be used to change the cursorTop Positon and also the cursorLeft Position of the Text.
Console.CursorVisible = False
Console.CursorLeft = 30
Console.CursorTop = 10
Console.Write("{0}", sb.ToString)
The heavy part are the Menu code Lines. To answer my own question some additional help was necessary.
I posted my question on the MS developer Network written in german language. With the following link it can be viewed.
For the case the link should be broken or other cases i post the code on this site.
Module Module1
Dim MenuList As New List(Of String)
Dim aTimer As New System.Timers.Timer
Const marqueeText As String = "The quick brown fox... "
Dim sb As New System.Text.StringBuilder
Dim direction As Boolean = False
Sub PrintMenu(highlight As Integer, left As Integer, top As Integer)
Dim Nickvektor() As Integer = {1, 2, 3, 4, 5}
For I = 0 To MenuList.Count - 1
Console.CursorLeft = left
Console.CursorTop = top + I
If I = highlight Then
Console.Write("{0}", "[" & Nickvektor(I) & "]")
Else
Console.Write(MenuList(I))
End If
Next
End Sub
Sub Main()
Console.CursorVisible = False
aTimer.AutoReset = True
aTimer.Interval = 100 '1/10 second
AddHandler aTimer.Elapsed, AddressOf tick
Dim x As Integer = 0
Dim Nickvektor() As String = {" "}
For counter As Integer = 0 To 0
Do
For Each s In Nickvektor
MenuList.Add(s)
Next
x += 1
Loop Until x = 5
Next
Console.SetCursorPosition(10, 16)
Console.Write("[ ]")
Dim CurrentItem As Integer = 0
Dim CurrentKey As ConsoleKey
While CurrentKey <> ConsoleKey.Enter
If CurrentItem = 2 Then ' Zero can be used to show the marquee output prompt
aTimer.Start() ' With a change to two or four the timer can be stoped:
'Else
'If aTimer.Enabled Then
' aTimer.Stop()
'End If
End If
PrintMenu(CurrentItem, 10, 10)
CurrentKey = Console.ReadKey(True).Key
Select Case CurrentKey
Case ConsoleKey.DownArrow
CurrentItem += 1
Case ConsoleKey.UpArrow
CurrentItem -= 1
End Select
CurrentItem = (CurrentItem + MenuList.Count) Mod MenuList.Count
End While
End Sub
Private Sub tick(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs)
If sb.Length = 0 Then sb.Append(marqueeText)
If direction Then
sb.Insert(0, sb(sb.Length - 1))
sb.Remove(sb.Length - 1, 1)
Else
sb.Append(sb(0))
sb.Remove(0, 1)
End If
Console.CursorVisible = False
Console.CursorLeft = 20
Console.CursorTop = 12 ' For the first Element CursorTop=10, fort he third 12
Console.Write("{0}", sb.ToString)
End Sub
End Module
To learn an other language like English i have to search a lot. Visual Basic Code is mostly written with English key words for the commands. I think it is easier to look up the maintainable changes for your self. To search is not every day funny.
I'm new to threading concept in VB .NET and I have two nested for each loops and I want a new thread every time loop executes. What I'm doing here is that I'm calling a function every again and again with different parameters with the help of two nested loops. And what I want is every time I call that function that get executed as a new thread.
Here's my Code -
Dim threadCount As Integer = 1
Dim theradArray(100) As System.Threading.Thread
Dim copyProcessID As Integer = 0
For Each dest_path As String In destList
If Directory.Exists(dest_path) Then
'copy process
Dim copyProcessOBJ As copy
For index = 0 To sourceList.Count - 1
source = sourceList(index)
If source.isChecked = True Then
copyProcessID += 1
If cliRadioButton.Checked Then
cmdCopy(source.Path, dest_path)
Else
ProgressReports.Show()
copyProcessOBJ = New copy
threadCount += 1
theradArray(threadCount) = New _System.Threading.Thread(AddressOf copyProcessOBJ.guiCopy)
theradArray(threadCount).Start()
copyProcessOBJ.guiCopy(source.Path, dest_path, copyProcessID)
End If
End If
Next
Here I have a class named copy and a sub 'guiCopy' Inside that
I'm making new instance of that obj every time in loop. likewise that I want a new thread.
But I have a problem which says initializes new instance of Thread class.
I'm sorry I know it's my fault that I don't know how to implement it.
Just need Help
Dim threadCount As Integer = 1
Dim theradArray(100) As System.Threading.Thread
Dim copyProcessID As Integer = 0
Dim threads As List(Of System.Threading.Thread) = New List(Of System.Threading.Thread)
For Each dest_path As String In destList
If Directory.Exists(dest_path) Then
Dim thr As System.Threading.Thread = New System.Threading.Thread(AddressOf yourfunction)
threads.Add(thr)
threads.LastOrDefault().Start()
End If
Next
Private Sub yourfunction()
Dim copyProcessOBJ As copy
For index = 0 To sourceList.Count - 1
source = sourceList(index)
If source.isChecked = True Then
copyProcessID += 1
If cliRadioButton.Checked Then
cmdCopy(source.Path, dest_path)
Else
ProgressReports.Show()
copyProcessOBJ = New copy
threadCount += 1
theradArray(threadCount) = New _System.Threading.Thread(AddressOf copyProcessOBJ.guiCopy)
theradArray(threadCount).Start()
copyProcessOBJ.guiCopy(source.Path, dest_path, copyProcessID)
End If
End If
End Sub
Next
My teacher has instructed our class to create a basic word sorting program the 'old fashioned way' in visual basic. So comparing two array values, a and b, then if one is considered higher in the order than the other, swap them if not do nothing, continue until there are no more swaps. Here is the code I have so far:
Imports System.IO
Imports System
Public Class Form1
Public arrText As New ArrayList()
Private Sub btnImprt_Click(sender As Object, e As EventArgs) Handles btnImprt.Click
'Dim OpenAnswerFile As New OpenFileDialog
Dim objReader As New StreamReader("c:\Users\Adam\Desktop\unSortList.txt")
Dim sLine As String = ""
Dim arrText As New ArrayList()
Do
sLine = objReader.ReadLine()
If Not sLine Is Nothing Then
arrText.Add(sLine)
End If
Loop Until sLine Is Nothing
objReader.Close()
Dim i As Integer = 0
txtImport.Text = arrText(i)
End Sub
Private Sub btnSort_Click(sender As Object, e As EventArgs) Handles btnSort.Click
Dim i As Integer = 0
Dim a As Integer = i + 1
txtImport.Text = i
txtImport.Text = a
Dim Temp As String
Dim Change As Boolean = True
While Change = True
Change = False
For Each i In arrText(i) - 1
If String.Compare(arrText(i), arrText(i + 1)) = 1 Then
Change = True
Temp = arrText(i)
arrText(i) = arrText(i + 1)
arrText(i + 1) = Temp
End If
Next
i = 0
End While
txtSort.Text = arrText(39)
End Sub
My problem is that I am getting an Index error and I'm not sure where the error is located as the logic seems fine.
And yes I am aware of the sorting function built into Visual Basic. but as the teacher said. No cheating.
Your code has several flaws, which I'm ignoring and just concentrating on the sorting part, as your query is related to that. Replace your sort loop with the following and check again. The basic problem was that your loop should only iterate up to List.Count - 2 and not List.Count - 1 because you're comparing List(i) and List(i + 1) inside the loop:
Dim Temp As String
Dim Change As Boolean = True
While Change
Change = False
For i = 0 To arrText.Count() - 2
If String.Compare(arrText(i), arrText(i + 1)) = 1 Then
Change = True
Temp = arrText(i)
arrText(i) = arrText(i + 1)
arrText(i + 1) = Temp
End If
Next
End While
please examine my code below :
Public Class tier1
Dim rnd As New System.Random()
Function build1(ByVal dt As DataTable) As String
Try
For i = 0 To 4
For ix As Integer = 0 To till Step 4
lstrn.Add(rnd.Next(ix, ix + 4))
Next
Dim cntx As Integer = 0
For Each x As Integer In lstrn
If (i = 0) Then
If (article(x).Split(ChrW(10)).Length > 2) Then
If (article(x).Split(ChrW(10))(0).Length > 300) Then
first.Add(article(x).Split(ChrW(10))(0))
cntx = cntx + 1
If (cntx = 25) Then
Exit For
End If
End If
End If
End If
lstrn.Clear()
Next
Dim fi as String = "{"
For dx As Integer = 0 To first.Count - 2
fi = fi & w.spinl(first(dx), "light") & "|"
Next
fi = fi & "}"
Return fi
Catch ex As Exception
End Try
End Function
End Class
Now see my calling code :
Dim w As WaitCallback = New WaitCallback(AddressOf beginscn)
For var As Integer = 1 To NumericUpDown1.Value
Dim param(1) As Object
param(0) = lst
param(1) = var
ThreadPool.QueueUserWorkItem(w, param)
Next
sub
sub beginscn()
Dim scntxt As String = t1.buildtier1(dt)
end sub
Now understand what i give and what i want. Suppose i pass a datatable like this :
1,abcd,34,5
2,adfg,34,5
3,fhjrt,34,5
4,rtitk,34,5
What i want is {abcd|adfg|fhjrt|rtitk} and this sequence should be random everytime. Since i pass like 50-100 values and exit loop at 25 each output should have a different sequence of 25 strings in {|} format but it does not work like that. Everytime i get same sequence.
Can anyone explain why does it do like that and any possible solution for this problem?
Note : I have already tried shuffling datatable just before queuing it but still it does not work.
The random object is not thread safe. You could work around this by creating separate instances of the random object in each thread and use the thread ID to generate the
seed.
http://msdn.microsoft.com/en-us/library/ms683183%28VS.85%29.aspx
I'm very new to programming and vb.net, trying to self teach more so as a hobby, as I have an idea for a program that I would find useful, but I am having trouble getting past this issue and I believe it is to do with the timer.
I have a form of size.(600,600) with one button of size.(450,150) that is set location(100,50) on the form. When clicked I want to move down it's own height, then add a new button in it's place. The code included below works as desired for the first two clicks, but on the third click the button keeps moving and the autoscroll bar extends. I initially thought it was the autoscroll function or the location property, but realised that as the button keeps moving, the timer hasn't stopped. I am aware that the code is probably very clunky in terms of achieving the outcome, and that there are a few lines/variables that are currently skipped over by the compiler (these are from older attempts to figure this out).
I have looked around and can't find the cause of my problem. Any help would be greatly appreciated. Apologies if the code block looks messy - first go.
Public Class frmOpenScreen
Dim intWButtons, intCreateButtonY, intCreateButtonX 'intTimerTick As Integer
Dim arrWNames() As String
Dim ctrlWButtons As Control
Dim blnAddingW As Boolean
Private Sub btnCreateW_Click(sender As System.Object, e As System.EventArgs) Handles btnCreateW.Click
'Creates new Button details including handler
Dim strWName, strWShort As String
Dim intCreateButtonY2 As Integer
Static intNumW As Integer
Dim B As New Button
strWName = InputBox("Please enter the name name of the button you are creating. Please ensure the spelling is correct.", "Create W")
If strWName = "" Then
MsgBox("Nothing Entered.")
Exit Sub
End If
strWShort = strWName.Replace(" ", "")
B.Text = strWName
B.Width = 400
B.Height = 150
B.Font = New System.Drawing.Font("Arial Narrow", 21.75)
B.AutoSizeMode = Windows.Forms.AutoSizeMode.GrowAndShrink
B.Anchor = AnchorStyles.Top
B.Margin = New Windows.Forms.Padding(0, 0, 0, 0)
'Updates Crucial Data (w name array, number of w buttons inc Create New)
If intNumW = 0 Then
ReDim arrWNames(0)
Else
intNumW = UBound(arrWNames) + 1
ReDim Preserve arrWNames(intNumW)
End If
arrWNames(intNumW) = strWShort
intNumW = intNumW + 1
intWButtons = WButtonCount(intWButtons) + 1
'updates form with new button and rearranges existing buttons
intCreateButtonY = btnCreateW.Location.Y
intCreateButtonX = btnCreateW.Location.X
‘intTimerTick = 0
tmrButtonMove.Enabled = True
‘Do While intTimerTick < 16
‘ 'blank to do nothing
‘Loop
'btnCreateW.Location = New Point(intCreateButtonX, intCreateButtonY + 150)
B.Location = New Point(intCreateButtonX, intCreateButtonY)
Me.Controls.Add(B)
B.Name = "btn" & strWShort
intCreateButtonY2 = btnCreateW.Location.Y
If intCreateButtonY2 > Me.Location.Y Then
Me.AutoScroll = False
Me.AutoScroll = True
Else
Me.AutoScroll = False
End If
'MsgBox(intCreateButtonY)
End Sub
Function WButtonCount(ByRef buttoncount As Integer) As Integer
buttoncount = intWButtons
If buttoncount = 0 Then
Return 1
End If
Return buttoncount
End Function
Public Sub tmrButtonMove_Tick(sender As System.Object, e As System.EventArgs) Handles tmrButtonMove.Tick
Dim intTimerTick As Integer
If intTimerTick > 14 Then
intTimerTick = 0
End If
If btnCreateW.Location.Y <= intCreateButtonY + 150 Then
btnCreateW.Top = btnCreateW.Top + 10
End If
intTimerTick += 1
If intTimerTick = 15 Then
tmrButtonMove.Enabled = False
End If
End Sub
End Class
So my current understanding is that the tick event handler should be increasing the timertick variable every time it fires, and that once it has hits 15 it should diable the timer and stop the button moving, but it is not doing so.
Thanks in advance.
IntTimerTick is initialized to 0 at the beginning of every Tick event. This won't happen if you declare it to be static:
Static Dim intTimerTick As Integer