Vb.net using multithreading to go through each listviewitem - vb.net

I'm pretty new to multithreading, but I am trying to go through each listviewitem where subitem 1 is ".." (quequed).. The code I have right now goes through the first 2, but how can I make it continue with the rest? I am currently running two threads.
I have made this little example application to test out multithreading, which I can then apply to my other application once I get a hang of it.. I pretty much want it to go through each item where status is "..", and then it makes the time go up to 10000 until it continues with the other items, until there are none left.. Any help would be appreciated.
Public Class Form1
Dim i As Integer
Dim i2 As Integer
Dim thread As System.Threading.Thread
Dim thread2 As System.Threading.Thread
Public Class CParameters
Public Property LID As Integer
End Class
Private Sub startMe(ByVal param As Object)
Dim p As CParameters = CType(param, CParameters)
Do Until i = 10000
i = i + 1
ListView1.Items(p.LID).SubItems(1).Text = "Running"
ListView1.Items(p.LID).SubItems(2).Text = i
If i >= 10000 Then
ListView1.Items(p.LID).SubItems(1).Text = "OK"
End If
Loop
End Sub
Private Sub startMe2(ByVal param As Object)
Dim p As CParameters = CType(param, CParameters)
Do Until i = 10000
i = i + 1
ListView1.Items(p.LID).SubItems(1).Text = "Running"
ListView1.Items(p.LID).SubItems(2).Text = i
If i >= 10000 Then
ListView1.Items(p.LID).SubItems(1).Text = "OK"
End If
Loop
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
thread = New System.Threading.Thread(AddressOf startMe)
Dim parameters As New CParameters
parameters.LID = "0"
thread.Start(parameters)
'Thread 2
thread2 = New System.Threading.Thread(AddressOf startMe2)
parameters = New CParameters
parameters.LID = "1"
thread2.Start(parameters)
End Sub
End Class

If you're using .NET 4.5 I strongly recommend the Task based approach. This approach makes asynchronous programming so much easier. I recreated the form you described with a ListView. I added a 4th column for the counter.
Public Class CParameters
Public Property LID As Integer
End Class
Private Async Function startThreadsAsync() As Task
'WARNING: Await does not create a new thread. Task.run does.
Await crunchThreadAsync(New CParameters() With {.LID = 0}) 'Create first task
Await crunchThreadAsync(New CParameters() With {.LID = 1}) 'Create second task
Await crunchThreadAsync(New CParameters() With {.LID = 2}) 'Create third task
End Function
Private Sub UpdateListItem(ByVal pid As Integer, ByVal Status As String, ByVal Time As String, ByVal Count As String)
If Not ListView1.InvokeRequired Then 'If on the main ui thread update
Dim lp As ListViewItem = ListView1.Items(pid)
lp.SubItems(0).Text = pid.ToString
lp.SubItems(1).Text = Status
lp.SubItems(2).Text = Time & "ms"
lp.SubItems(3).Text = Count
Else 'If not on the main ui thread invoke the listviews original thread(ui thread)
ListView1.BeginInvoke(Sub()
Dim lp As ListViewItem = ListView1.Items(pid)
lp.SubItems(0).Text = pid.ToString
lp.SubItems(1).Text = Status
lp.SubItems(2).Text = Time & "ms"
lp.SubItems(3).Text = Count
End Sub)
End If
End Sub
Private Async Function crunchThreadAsync(ByVal param As CParameters) As Task(Of Boolean)
'Setting start text
UpdateListItem(param.LID, "Running", "", "0")
Dim cnt As Integer = 0
Dim p As CParameters = param
Dim l As New Stopwatch() 'For displaying total time spent crunching
l.Start()
'We're not leaving the UI thread.'
'Create new thread for crunching
Dim result As Boolean = Await Task.Run(Function()
Do Until cnt = 10000
cnt = cnt + 1
If cnt Mod 1000 = 0 Then
UpdateListItem(param.LID, "", "", cnt.ToString)
End If
Loop
Return True
End Function)
'We're back in the UI thread again.
l.Stop()
UpdateListItem(param.LID, "Finished", l.ElapsedMilliseconds.ToString, cnt.ToString)
End Function
Private Async Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
TextBox1.Text &= "Starting crunch." & Environment.NewLine
Await startThreadsAsync()
TextBox1.Text &= "Finished crunch." & Environment.NewLine
End Sub
I do not update the ui thread every tick of each counter for a few reasons: The amount of updates on the ui thread would lock up the ui. There is no way around this except to decide when it's necessary to actually update the Ui. In this case I do it every 1000 ticks.

Related

If statement not moving to the next item

I am working on a side project in VB, it is a network monitoring tool to pings a number of devices which should come back as successful or failed. I have extreme limits in programming so forgive me.
I am using buttons, a total of 34 for each device that I want to ping that returns a success or fail which will color code green(success) and red(failed) but I am sure there is a better way? Right now, my code is stuck on one button, I cant figure out how to step to the next one on the list. In my code, I have it commented out of the results I want produced which is where I am stuck on.
The text file contains all my IP addresses I want to ping separated by a comma.
Basically, when the form is running, it will display each button as green or red, depending on if the device is online or not. I want the code to loop every 2 minutes as well to keep the devices up to date. Literally a device monitoring tool. I was able to get it to work using 34 different End If statements but that is messy and a lot of work to maintain. Any assistance would be helpful.
Using MyReader As New Microsoft.VisualBasic.FileIO.TextFieldParser("\\txt file location\device.txt")
MyReader.TextFieldType = FileIO.FieldType.Delimited
MyReader.SetDelimiters(",")
Dim currentRow As String()
Dim MyLen() As String = {"Button1", "Button2", "Button3", "Button4", "Button5", "Button6", "Button7", "Button8", "Button9", "Button10", "Button11", "Button12", "Button13", "Button14", "Button15", "Button16", "Button17", "Button18", "Button19", "Button20", "Button21", "Button22", "Button23", "Button24", "Button25", "Button26", "Button27", "Button28", "Button29", "Button30", "Button31", "Button32", "Button33", "Button34"}
While Not MyReader.EndOfData
Try
currentRow = MyReader.ReadFields()
Dim currentField As String
For Each currentField In currentRow
If My.Computer.Network.Ping(currentField) Then
MsgBox(MyLen)
'MyLen = Color.LimeGreen
Else
MsgBox(MyLen)
'MyLen.Text = "Failed"
'MyLen.BackColor = Color.Red
End If
Next
Catch ex As Microsoft.VisualBasic.FileIO.MalformedLineException
MsgBox("Line " & ex.Message & "is not valid and will be skipped.")
End Try
End While
End Using
enter image description here
Here is some code that takes a different approach. To try it create a new Form app with only a FlowLayoutPanel and Timer on it. Use the default names. It might be above your skill level but using the debugger you might learn something. Or not.
Public Class Form1
Private MyButtons As New List(Of Button)
Private Sub Form1_Shown(sender As Object, e As EventArgs) Handles Me.Shown
Timer1.Enabled = False 'started later
Timer1.Interval = CInt(TimeSpan.FromMinutes(2).TotalMilliseconds) '<<<< Change >>>>
Dim path As String = "\\txt file location\device.txt"
Dim text As String = IO.File.ReadAllText(path) 'use this
''for testing >>>>>
'Dim text As String = "10.88.0.70, 10.88.0.122,192.168.0.15, 10.88.0.254, 1.2.3.4" ''for testing
''for testing <<<<<
Dim spltCHs() As Char = {","c, " "c, ControlChars.Tab, ControlChars.Cr, ControlChars.Lf}
Dim IPs() As String = text.Split(spltCHs, StringSplitOptions.RemoveEmptyEntries)
For Each addr As String In IPs
Dim b As New Button
Dim p As New MyPinger(addr)
p.MyButton = b
b.Tag = p 'set tag to the MyPinger for this address
b.AutoSize = True
b.Font = New Font("Lucida Console", 10, FontStyle.Bold)
b.BackColor = Drawing.Color.LightSkyBlue
'center text in button
Dim lAddr As String = p.Address
Dim t As String = New String(" "c, (16 - lAddr.Length) \ 2)
Dim txt As String = t & lAddr & t
b.Text = txt.PadRight(16, " "c)
b.Name = "btn" & lAddr.Replace("."c, "_"c)
AddHandler b.Click, AddressOf SomeButton_Click 'handler for button
MyButtons.Add(b) 'add button to list
Next
'sort by IP
MyButtons = (From b In MyButtons
Select b Order By DirectCast(b.Tag, MyPinger).Address(True)).ToList
For Each b As Button In MyButtons
FlowLayoutPanel1.Controls.Add(b) 'add button to panel
Next
FlowLayoutPanel1.Anchor = AnchorStyles.Bottom Or AnchorStyles.Left Or AnchorStyles.Right Or AnchorStyles.Top
Timer1.Enabled = True 'start the timer
End Sub
Private Sub SomeButton_Click(sender As Object, e As EventArgs)
'if button clicked ping it
Dim b As Button = DirectCast(sender, Button) 'which button
b.BackColor = MyPinger.UnknownColor
Dim myP As MyPinger = DirectCast(b.Tag, MyPinger) ''get the MyPinger for this
myP.DoPing() 'do the ping
End Sub
Private Async Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Timer1.Enabled = False
Dim myPs As New List(Of MyPinger)
For Each b As Button In MyButtons
b.BackColor = MyPinger.UnknownColor
Dim myP As MyPinger = DirectCast(b.Tag, MyPinger)
myPs.Add(myP)
Next
Dim t As Task
t = Task.Run(Sub()
Threading.Thread.Sleep(25)
For Each myP As MyPinger In myPs
myP.DoPing()
Next
End Sub)
Await t
Timer1.Enabled = True
End Sub
End Class
Public Class MyPinger
Public Shared ReadOnly UpColor As Drawing.Color = Drawing.Color.LightGreen
Public Shared ReadOnly DownColor As Drawing.Color = Drawing.Color.Red
Public Shared ReadOnly UnknownColor As Drawing.Color = Drawing.Color.Yellow
Private _ip As Net.IPAddress
Private _ping As Net.NetworkInformation.Ping
Public LastReply As Net.NetworkInformation.PingReply
Private Shared ReadOnly PingTMO As Integer = 2500
Private _waiter As New Threading.AutoResetEvent(True)
Public MyButton As Button
Public Sub New(IPAddr As String)
Me._ip = Net.IPAddress.Parse(IPAddr) 'will throw exception if IP invalid <<<<<
Me._ping = New Net.NetworkInformation.Ping 'create the ping
'do initial ping
Dim t As Task = Task.Run(Sub()
Threading.Thread.Sleep(25) 'so init has time
Me.DoPingAsync()
End Sub)
End Sub
Private Async Sub DoPingAsync()
If Me._waiter.WaitOne(0) Then 'only one at a time for this IP
Me.LastReply = Await Me._ping.SendPingAsync(Me._ip, PingTMO)
Dim c As Drawing.Color
Select Case Me.LastReply.Status
Case Net.NetworkInformation.IPStatus.Success
c = UpColor
Case Else
c = DownColor
End Select
Me.SetButColor(c)
Me._waiter.Set()
End If
End Sub
Public Sub DoPing()
Me.DoPingAsync()
End Sub
Private Sub SetButColor(c As Drawing.Color)
If Me.MyButton IsNot Nothing Then
If Me.MyButton.InvokeRequired Then
Me.MyButton.BeginInvoke(Sub()
Me.SetButColor(c)
End Sub)
Else
Me.MyButton.BackColor = c
End If
End If
End Sub
Public Function TheIP() As Net.IPAddress
Return Me._ip
End Function
Public Function Address(Optional LeadingZeros As Boolean = False) As String
Dim rv As String = ""
If LeadingZeros Then
Dim byts() As Byte = Me._ip.GetAddressBytes
For Each b As Byte In byts
rv &= b.ToString.PadLeft(3, "0"c)
rv &= "."
Next
Else
rv = Me._ip.ToString
End If
Return rv.Trim("."c)
End Function
End Class

Fire method on Main Thread from other Threads

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

Async and Await, why two return values

I'm trying to get my head around Async and Await. It's going well but one thing I would like clarification on is why there are two return statements in my method. I'm really looking for an explanation of what is actually happening behind the scenes.
I'll post the full code below as it only amounts to around 80 lines. I'm talking about the central method AllSubfolderFiles, which has both Return counter and Return dirsFraction. What's actually happening with these?
Basically, it is a WinForm application that iterates all the files of subfolders, updating a ProgressBar for each iterated subfolder.
Imports System.IO
Public Class frmAsyncProgress
Private Sub frmAsyncProgress_Load(sender As Object, e As EventArgs) Handles MyBase.Load
barFileProgress.Minimum = 0
barFileProgress.Maximum = 100
btnCancel.Enabled = False
End Sub
Private Async Sub btnStart_Click(sender As Object, e As EventArgs) Handles btnStart.Click
If String.IsNullOrWhiteSpace(txtPath.Text) Then
MessageBox.Show("Provide a location first.", "Location")
Exit Sub
End If
Dim sLocation As String = txtPath.Text.Trim()
If Not Directory.Exists(sLocation) Then
MessageBox.Show("Directory doesn't exist.", "Location")
Exit Sub
End If
Dim progressIndicator = New Progress(Of Integer)(AddressOf UpdateProgress)
btnStart.Enabled = False
btnCancel.Enabled = True
lblPercent.Text = "0%"
Dim allFiles As Integer = Await AllSubfolderFiles(sLocation, progressIndicator)
Debug.WriteLine(allFiles.ToString()) 'the number of subfolders iterated
btnStart.Enabled = True
btnCancel.Enabled = False
End Sub
Private Async Function AllSubfolderFiles(location As String, progress As IProgress(Of Integer)) As Task(Of Integer)
Dim dirsTotal As Integer = Directory.GetDirectories(location).Length
Dim dirsFraction As Integer = Await Task(Of Integer).Run(Function()
Dim counter As Integer = 0
For Each subDir As String In Directory.GetDirectories(location)
SubfolderFiles(subDir)
counter += 1
If progress IsNot Nothing Then
progress.Report(counter * 100 / dirsTotal)
End If
Next
Return counter
End Function)
Return dirsFraction
End Function
Private Sub UpdateProgress(value As Integer)
barFileProgress.Value = value
lblPercent.Text = (value / 100).ToString("#0.##%")
End Sub
Private Sub SubfolderFiles(location As String)
'source: http://stackoverflow.com/questions/16237291/visual-basic-2010-continue-on-error-unauthorizedaccessexception#answer-16237749
Dim paths = New Queue(Of String)()
Dim fileNames = New List(Of String)()
paths.Enqueue(location)
While paths.Count > 0
Dim sDir = paths.Dequeue()
Try
Dim files = Directory.GetFiles(sDir)
For Each file As String In Directory.GetFiles(sDir)
fileNames.Add(file)
Next
For Each subDir As String In Directory.GetDirectories(sDir)
paths.Enqueue(subDir)
Next
Catch ex As UnauthorizedAccessException
' log the exception or ignore it
Debug.WriteLine("Directory {0} could not be accessed!", sDir)
Catch ex As Exception
' log the exception or ...
Throw
End Try
End While
'could return fileNames collection
End Sub
End Class
My assessment is that counter is returned and then marshalled back onto the UI thread as dirsFraction, but I'm not convinced by my attempted explanation.
Inside your AllSubfolderFiles function you call Task.Run and pass in an anonymous function that returns with Return counter. AllSubfolderFiles awaits the result of that call and then returns with Return dirsFraction.
So, you have 2 returns in the same function because you have an anonymous function inside your original function. You can move that function out to its own named function which will make it clearer that there are 2 different functions here.

vb.net system.threading.thread ask the thread to cleanup and stop

I am new to vb.net multithreading, and I am facing a issue.
For threading I am using system.threading.thread function.
I know I can stop a thread using thread.abort call. But that's not a good choice (I have searched a bit and came to know that). This also will not work because my running threads needs some cleanup before cancellation.
So, I'm trying to do some kind of action that set a variable to UI thread like
dim bolStop as Boolean
So, if my UI thread set that Boolean value as true then all running thread can access/notice that change and can start cleanup process before stop/cancel the thread itself.
hope that makes sense...
best regards
Edit:1 (Source Is Pasted Here as Suggested By #DrunkenCodeMonkey
This is the code for Main Form (Form1.vb) (I think i need something here and also on the thread module (class) too) so, below i will paste module code too
Public Class Form1
Private objThreadList As ArrayList
Dim bolStop As Boolean
Private Sub cmd1_Click(sender As System.Object, e As System.EventArgs) Handles cmd1.Click
Dim intTLoop As Integer
sPrepareThreading()
For intTLoop = 1 To 5
sSendThread("", "Zakir", "Biplob")
Next
'sFinishThreading()
MessageBox.Show("Done!")
End Sub
Sub sPrepareThreading()
Dim intTLoop As Integer
objThreadList = New ArrayList
For intTLoop = 1 To 3
objThreadList.Add(Nothing)
Next intTLoop
End Sub
Sub sSendThread(strDraft As String, ByVal strTitle As String, ByVal strSubHeader As String)
Dim bolFalied As Boolean
Dim intTLoop As Integer
Dim objItem As System.Windows.Forms.ListViewItem
Dim objTData As objThreadCrossData
Dim objThreadClass As clsThread
Dim objNewThread As System.Threading.Thread
Zakir_RecheckThread:
My.Application.DoEvents()
If bolStop = True Then
Exit Sub
End If
bolFalied = True
For intTLoop = 1 To 3
bolFalied = True
If objThreadList(intTLoop - 1) Is Nothing Then
bolFalied = False
Else
If CType(objThreadList(intTLoop - 1), System.Threading.Thread).IsAlive = False Then
bolFalied = False
Else
bolFalied = True
End If
End If
If bolFalied = False Then
objTData = New objThreadCrossData
objTData.ID = ListView1.Items.Count
objTData.bolStop = False
objTData.strTime = DateTime.Now.ToString
objItem = ListView1.Items.Add(strTitle)
objItem.SubItems.Add(strSubHeader)
objItem = Nothing
objThreadClass = New clsThread(objTData, "", Me)
objNewThread = New System.Threading.Thread(AddressOf objThreadClass.StartThread)
objNewThread.IsBackground = True
objNewThread.Start()
objThreadList(intTLoop - 1) = objNewThread
Exit For
End If
Next
If bolFalied = True Then
GoTo Zakir_RecheckThread
Exit Sub
End If
End Sub
Public Sub ReceiveThreadMessage(ByVal objCrosData As Object)
Dim objTDataV1 As objThreadCrossData
objTDataV1 = CType(objCrosData, objThreadCrossData)
ListView1.Items(objTDataV1.ID).SubItems(1).Text = objTDataV1.strProgress
End Sub
Private Sub cmd2_Click(sender As System.Object, e As System.EventArgs) Handles cmd2.Click
REM This is where i like to stop the running thred either by setting bolStop = True and all running thead check that variable.
REM or by chate the thread (Thread Data Object Property naemd "bolStop" value"
REM please help me out...
End Sub
End Class
Code For Thread Module (clsThread.vb):
Public Class clsThread
Private m_Counter As Integer = 0
Private m_MainWindow As Form
Dim m_ThreadCrorssData As objThreadCrossData
Private Delegate Sub NotifyMainWindow(ByVal objCrosData As objThreadCrossData)
'We need an object of this deletegate
Private m_NotifyMainWindow As NotifyMainWindow
Public Sub New(ByVal objCrossData As Object, ByVal strXML As String, ByRef MainWindow As Form1)
m_MainWindow = MainWindow
m_ThreadCrorssData = CType(objCrossData, objThreadCrossData)
'We need to point our delegate to the Method, which we want to call from this thread
m_NotifyMainWindow = AddressOf MainWindow.ReceiveThreadMessage
End Sub
Public Sub StartThread()
While m_Counter < 100
m_Counter = m_Counter + 1
rem for example here i like to check for the value that whether user asked to stop
m_ThreadCrorssData.strProgress = CStr(m_Counter)
m_MainWindow.Invoke(m_NotifyMainWindow, m_ThreadCrorssData)
rem for example also here i like to check for the value that whether user asked to stop
'wait for some time before continuing loop
System.Threading.Thread.Sleep(1000)
End While
End Sub
End Class
Here is the Code For Module (Thread Object Data)
Module mdlCMM
Public Class objThreadCrossData
Property strProgress As String
Property bolStop As Boolean = False
Property strTime As String
Property ID As Integer
Property intStatusNum As Integer
Property strStatusValue As String
End Class
End Module

Multithreading A Function in VB.Net

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