I am very new with Background worker control. I have an existing project that builds file but throughout my project while building files I get the deadlock error.
I am trying to solve it by creating another project that will only consist out of the background worker. I will then merge them.
My problem is I don't know where it will be more effective for my background worker to be implemented and also the main problem is how can I use the SaveDialog with my background worker? I need to send a parameter to my background worker project telling it when my file is being build en when it is done.
This is where my file is being build:
srOutputFile = New System.IO.StreamWriter(strFile, False) 'Create File
For iSeqNo = 0 To iPrintSeqNo
' Loop through al the record types
For Each oRecord As stFileRecord In pFileFormat
If dsFile.Tables.Contains(oRecord.strRecordName) Then
' Loop through al the records
For Each row As DataRow In dsFile.Tables(oRecord.strRecordName).Rows
' Check record id
If oRecord.strRecordId.Length = 0 Then
bMatched = True
Else
bMatched = (CInt(oRecord.strRecordId) = CInt(row.Item(1)))
End If
' Match records
If iSeqNo = CInt(row.Item(0)) And bMatched Then
strRecord = ""
' Loop through al the fields
For iLoop = 0 To UBound(oRecord.stField)
' Format field
If oRecord.stField(iLoop).iFieldLength = -1 Then
If strRecord.Length = 0 Then
strTmp = row.Item(iLoop + 1).ToString
Else
strTmp = strDelimiter & row.Item(iLoop + 1).ToString
End If
ElseIf oRecord.stField(iLoop).eFieldType = enumFieldType.TYPE_VALUE Or _
oRecord.stField(iLoop).eFieldType = enumFieldType.TYPE_AMOUNT_CENT Then
strTmp = row.Item(iLoop + 1).ToString.Replace(".", "").PadLeft(oRecord.stField(iLoop).iFieldLength, "0")
strTmp = strTmp.Substring(strTmp.Length - oRecord.stField(iLoop).iFieldLength)
Else
strTmp = row.Item(iLoop + 1).ToString.PadRight(oRecord.stField(iLoop).iFieldLength, " ").Substring(0, oRecord.stField(iLoop).iFieldLength)
End If
If oRecord.stField(iLoop).iFieldLength > -1 And (bForceDelimiter) And strRecord.Length > 0 Then
strTmp = strDelimiter & strTmp
End If
strRecord = strRecord & strTmp
Next
' Final delimiter
If (bForceDelimiter) Then
strRecord = strRecord & strDelimiter
End If
srOutputFile.WriteLine(strRecord)
End If
Next
End If
Next
Next
You could try this:
Private locker1 As ManualResetEvent = New System.Threading.ManualResetEvent(False)
Private locker2 As ManualResetEvent = New System.Threading.ManualResetEvent(False)
Dim bOpenFileOK As Boolean
Dim myOpenFile As OpenFileDialog = New OpenFileDialog()
Private Sub FileOpener()
While Not bTerminado
If myOpenFile.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
bOpenFileOK = True
Else
bOpenFileOK = False
End If
locker2.Set()
locker1.WaitOne()
End While
End Sub
' Detonator of the action
Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button1.Click
Dim tFileOp As Thread = New Thread(AddressOf FileOpener)
tFileOp.SetApartmentState(ApartmentState.STA)
tFileOp.Start()
' Start BackgroundWorker
BW1.RunWorkerAsync()
End Sub
Private Sub AsyncFunctionForBW(ByVal args As ArrayList)
'[...]
'Change options dinamically for the OpenFileDialog
myOpenFile.Filter = ""
myOpenFile.MultiSelect = True
'Calling the FileDialog
locker1.Set()
locker2.WaitOne()
locker1.Reset()
locker2.Reset()
If bOpenFileOK Then
myStream = myOpenFile.OpenFile()
'[...]
End If
End Sub
It's a little bit complicated but it works.
ManualResetEvents interrupt the execution of code (if they are told to stop) when reached until you use .Set(). If you use .WaitOne() you set it in stop mode, so it will stop again when reached.
This code defines two ManualResetEvents. When you click the Button1 starts the function FileOpener() in a new Thread, and then starts the BackgroundWorker. The FileOpener() function shows a FileOpenDialog and waits in the locker1 so when you use locker1.Set() the function shows the file dialog.
As the myOpenFile is a "global" variable (as well as bOpenFileOK), once the user select the file (or not) you could detect the dialog result (bOpenFileOK) and the selected file.
Related
Hi i have a app that takes a list of files and searches each file for all the images referenced within each file. When the list is finished I sort and remove duplicates from the list then copy each item/image to a new folder. It works, but barely. I takes hours for the copying to occur on as little as 500 files. Doing the copying in windows explorer if faster, and that defeats the purpose of the application.
I don't know how to streamline it better. Your inputs would be greatly appreciated.
'Remove Dupes takes the list of images found in each file and removes any duplicates
Private Sub RemoveDupes(ByRef Items As List(Of String), Optional ByVal NeedSorting As Boolean = False)
statusText = "Removing duplicates from list."
Dim Temp As New List(Of String)
Items.Sort()
'Remove Duplicates
For Each Item As String In Items
'Check if item is in Temp
If Not Temp.Contains(Item) Then
'Add item to list.
Temp.Add(Item)
File.AppendAllText(ListofGraphics, Item & vbNewLine)
End If
Next Item
'Send back new list.
Items = Temp
End Sub
'GetImages does the actual copying of files from the list RemoveDup creates
Public Sub GetImages()
Dim imgLocation = txtSearchICN.Text
' Get the list of file
Dim fileNames As String() = System.IO.Directory.GetFiles(imgLocation)
Dim i As Integer
statusText = "Copying image files."
i = 0
For Each name As String In GraphicList
i = i + 1
' See whether name appears in fileNames.
Dim found As Boolean = False
' Search name in fileNames.
For Each fileName As String In fileNames
' GraphicList consists of filename without extension, so we compare name
' with the filename without its extension.
If Path.GetFileNameWithoutExtension(fileName) = name Then
Dim FileNameOnly = Path.GetFileName(fileName)
' Debug.Print("FileNameOnly: " & FileNameOnly)
Dim copyTo As String
copyTo = createImgFldr & "\" & FileNameOnly
System.IO.File.Copy(fileName, copyTo)
File.AppendAllText(ListofFiles, name & vbNewLine)
'items to write to rich text box in BackgroundWorker1_ProgressChanged
imgFilename = (name) + vbCrLf
ImageCount1 = i
' Set found to True so we do not process name as missing, and exit For. \
found = True
Exit For
Else
File.AppendAllText(MissingFiles, name & vbNewLine)
End If
Next
status = "Copying Graphic Files"
BackgroundWorker1.ReportProgress(100 * i / GraphicList.Count())
Next
End Sub
'BackgroundWorker1_ProgressChanged. gets file counts and writes to labels and rich text box
Private Sub BackgroundWorker1_ProgressChanged(sender As Object, e As System.ComponentModel.ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
'' This event is fired when you call the ReportProgress method from inside your DoWork.
'' Any visual indicators about the progress should go here.
ProgressBar1.Value = e.ProgressPercentage
lblStatus.Text = CType(e.UserState, String)
lblStatus.Text = status & " " & e.ProgressPercentage.ToString & " % Complete "
RichTextBox1.Text &= (fileFilename)
RichTextBox1.Text &= (imgFilename)
txtImgCount.Text = ImageCount1
Label8.Text = statusText
fileCount.Text = fCount
End Sub
I would change something in your code to avoid the constant writing to a file at each loop and the necessity to have two loops nested.
This is a stripped down version of your GetFiles intended to highlight my points:
Public Sub GetImages()
' Two list to collect missing and found files
Dim foundFiles As List(Of String) = New List(Of String)()
Dim notfoundFiles As List(Of String) = New List(Of String)()
Dim fileNames As String() = System.IO.Directory.GetFiles(imgLocation)
' Loop over the filenames retrieved
For Each fileName As String In fileNames
' Check if the files is contained or not in the request list
If GraphicList.Contains(Path.GetFileNameWithoutExtension(fileName)) Then
Dim FileNameOnly = Path.GetFileName(fileName)
Dim copyTo As String
copyTo = createImgFldr & "\" & FileNameOnly
System.IO.File.Copy(fileName, copyTo)
' Do not write to file inside the loop, just add the fact to the list
foundFiles.Add(FileNameOnly)
Else
notfoundFiles.Add(FileNameOnly)
End If
Next
' Write everything outside the loop
File.WriteAllLines(listofFiles, foundFiles)
File.WriteAllLines(MissingFiles, notfoundFiles)
End Sub
i want to update a label while a foreach-loop.
The problem is: the program waits until the loop is done and then updates the label.
Is it possible to update the label during the foreach-loop?
Code:
Dim count as Integer = 0
For Each sFile as String in Files
'ftp-code here, works well
count = count+1
progressbar1.value = count
label1.text = "File " & count & " of 10 uploaded."
next
Thanks in advance
Label is not updated because UI thread is blocked while executing your foreach loop.
You can use async-await approach
Private Async Sub Button_Click(sender As Object, e As EventArgs)
Dim count as Integer = 0
For Each sFile as String in Files
'ftp-code here, works well
count = count+1
progressbar1.value = count
label1.text = "File " & count & " of 10 uploaded."
Await Task.Delay(100)
Next
End Sub
Because you will work with Ftp connections, which is perfect candidate for using async-await.
The Await line will release UI thread which will update label with new value, and continue from that line after 100 milliseconds.
If you will use asynchronous code for ftp connection , then you don't need Task.Delay
You've already accepted an answer but just as an alternative a BackgroundWorker can also be used for something like this. In my case the FTP to get the original files happens very quickly so this snippet from the DoWork event is for downloading those files to a printer.
Dim cnt As Integer = docs.Count
Dim i As Integer = 1
For Each d As String In docs
bgwTest.ReportProgress(BGW_State.S2_UpdStat, "Downloading file " & i.ToString & " of " & cnt.ToString)
Dim fs As New IO.FileStream(My.Application.Info.DirectoryPath & "\labels\" & d, IO.FileMode.Open)
Dim br As New IO.BinaryReader(fs)
Dim bytes() As Byte = br.ReadBytes(CInt(br.BaseStream.Length))
br.Close()
fs.Close()
For x = 0 To numPorts - 1
If Port(x).IsOpen = True Then
Port(x).Write(bytes, 0, bytes.Length)
End If
Next
If bytes.Length > 2400 Then
'these sleeps are because it is only 1-way comm to printer so I have no idea when printer is ready for next file
System.Threading.Thread.Sleep(20000)
Else
System.Threading.Thread.Sleep(5000)
End If
i = i + 1
Next
In the ReportProgress event... (of course, you need to set WorkerReportsProgress property to True)
Private Sub bgwTest_ProgressChanged(sender As Object, e As System.ComponentModel.ProgressChangedEventArgs) Handles bgwTest.ProgressChanged
Select Case e.ProgressPercentage
'BGW_State is just a simple enum for the state,
'which determines which UI controls I need to use.
'Clearly I copy/pasted from a program that had 15 "states" :)
Case BGW_State.S2_UpdStat
Dim s As String = CType(e.UserState, String)
lblStatus.Text = s
lblStatus.Refresh()
Case BGW_State.S15_ShowMessage
Dim s As String = CType(e.UserState, String)
MessageBox.Show(s)
End Select
End Sub
Is it not enough to use Application.DoEvents()? This clears the build up and you should be able to see the text fields being updated very quickly.
I am trying to make a small log ( string array of 10 ) of time stamps that on a event will move the newest event towards the first string in the array.
Here is a few attempts that I have tried. The only time the array will change is when it is in a timer.
What Iam looking to do is
on a bit change to copy arrayA(1) to array(0). witch will move the string from (1) to (0),(2) to (1),(3) to (2) and the rest of the array. So when the event happens it cascades the strings to make a list of last events (0) would be the 10th event that happened and the (9) would be the first or latest event
Attempt 1
Private Sub RcvTmr_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RcvTmr.Tick
dim SrvUpTimeStgArray(9) as string
If BtnBit = False And OneShot(5) = True Then
OneShot(5) = False
SrvUpTimeStgArray(9) = LAtimeSvrUp.TimeString
For I = 0 To 8
SrvUpTimeStgArray(I) = SrvUpTimeStgArray(I + 1)
Next
LAtimeSvrUp.StopTimer()
End If
ListBox1.DataSource = SrvUpTimeStgArray
End Sub
Then this code to
Private Sub RcvTmr_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RcvTmr.Tick
Dim StringArrayA(9) as string : Dim StringArrayB(9) as string
If OneShot(10) = False Then
OneShot(10) = True
StringArrayA(3) = "testst 33333"
StringArrayA(2) = "testst 22222"
StringArrayA(1) = "testst 11111"
StringArrayA(0) = "testst 00000"
End If
StringArrayA(0) = StringArrayA(1)
If Btn1TestBit Then
counter1 = counter1 + 1
BtnTest3.Text = "worked"
'Call ArrayCopy()
Btn1TestBit = False
StringArrayA(0) = StringArrayA(1)
' The below was alternated with the above line ans also did not work
' Array.Copy(StringArrayA, 1, StringArrayB, 0, 4)
End If
ListBox1.DataSource = StringArrayA
ListBox2.DataSource = StringArrayB
Lacount3.Text = counter1
End Sub
I am missing something so thanks..
Update but It has duplicate strings to the array
This is using the AddLog Sub
If ClientConnBit = False And OneShot(5) = True Then
OneShot(5) = False
AddLog(SrvUpTimeStgArray, "Stopped # " & DateTime.Now.ToString() & "* Up Time " & LAtimeSvrUp.TimeString)
LAtimeSvrUp.StopTimer()
For Each entry As String In SrvUpTimeStgArray
If Not String.IsNullOrEmpty(entry) Then
LBSvrUptimeLog.Items.Add(entry)
End If
Next
'LBSvrUptimeLog.DataSource = SrvUpTimeStgArray
My.Settings.UpTimeString.AddRange(SrvUpTimeStgArray)
My.Settings.Save()
End If
You need to copy the values backward, if you do it forward you'll end up copying the same value everywhere. I suggest you load how to use break point and watch.
This is how it would look like
Sub AddLog(ByVal logAsArray() As String, ByVal newEntry As String)
For index As Integer = logAsArray.Length - 1 To 1 Step -1
logAsArray(index) = logAsArray(index - 1)
Next
logAsArray(0) = newEntry
End Sub
You can also use list instead
Sub AddLog(ByVal logAsList As List(Of String), ByVal newEntry As String)
If logAsList.Count = logAsList.Capacity Then
logAsList.RemoveAt(logAsList.Capacity - 1)
End If
logAsList.Insert(0, newEntry)
End Sub
Here's an example on how to use these functions.
Sub Main()
Dim logAsArray(2) As String
AddLog(logAsArray, "a")
AddLog(logAsArray, "b")
AddLog(logAsArray, "c")
AddLog(logAsArray, DateTime.Now.ToString())
For Each entry As String In logAsArray
Console.WriteLine(entry)
Next
Dim logAsList As New List(Of String)(3)
AddLog(logAsList, "a")
AddLog(logAsList, "b")
AddLog(logAsList, "c")
AddLog(logAsList, DateTime.Now.ToString())
For Each entry As String In logAsList
Console.WriteLine(entry)
Next
Console.ReadLine()
End Sub
I created an app that will browse through my favorite game's pages to find an online person by reading the html code on their profile page. However I am having trouble coming up with a way for it to loop back if it finds "UserOfflineMessage". I inserted ((((Location I want it to loop back)))) where I wanted it to loop back. Any suggestions?
BTW: This is not for malicious purposes, this is just a project a few of us were working on.
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim Rlo As New IO.StreamReader(My.Resources.Preferences & "Preferences.txt")
Dim firstLine As String
'read first line
firstLine = Rlo.ReadLine()
'read secondline
TheText.Text = Rlo.ReadLine()
'read third line
Dim thirdLine As String = Rlo.ReadLine()
Dim Ro As New IO.StreamReader(My.Resources.Preferences & "sig.txt")
Dim first1Line As String
'read first line
first1Line = Ro.ReadLine()
'read secondline
The2Text.Text = Ro.ReadLine()
((((Location I want it to loop back))))
rndnumber = New Random
number = rndnumber.Next(firstLine, TheText.Text)
TextBox2.Text = ("http://www.roblox.com/User.aspx?ID=" & number.ToString)
WebBrowser2.Navigate(TextBox2.Text)
If WebBrowser2.DocumentText.Contains("[ Offline ]</span>") Then
check1 = 1
TextBox1.Text = ("http://www.roblox.com/My/NewMessage.aspx?recipientID=" & number.ToString)
WebBrowser1.Navigate(TextBox1.Text)
MsgBox(":R")
ElseIf WebBrowser1.DocumentText.Contains("UserOfflineMessage") Then
MsgBox(":D")
End If
End Sub
You could use a Do...While loop:
Dim tryAgain as Boolean
...
Do
'...your stuff here...
tryAgain = False
if BlahBlah Then
...
ElseIf CaseWhereYouWantToLoop Then
tryAgain = True
End If
Loop While tryAgain
Change your ((((Location I want it to loop back)))) with
BackHere :
And add here
ElseIf WebBrowser1.DocumentText.Contains("UserOfflineMessage") Then
MsgBox(":D")
Goto BackHere
This is my app, you can see 3 buttons, start button enabled, pause disabled and stop disabled.
The problem is I have a separated thread in my form to make a "process" (and to print the information in the black richtextbox), and my intention is to can pause it or stop it, but when I launch the thread, the pause button and stop button turns Enabled to disabled in a second.
I can tell the form to wait after launching the thread with a _WaitHandle_FirstThreadDone.WaitOne() and then i can see enabled the pause and the stop buttons, but then the problem is my app hangs until the "process" is done.. so I can't push any button.
Please, I need help to make this...
The important part of my form:
Public Class Form1
#Region "Append text function"
' Append Text
Public Sub AppendText(box As RichTextBox, color As Color, text As String)
Control.CheckForIllegalCrossThreadCalls = False
Dim start As Integer = box.TextLength
box.AppendText(text)
Dim [end] As Integer = box.TextLength
' Textbox may transform chars, so (end-start) != text.Length
box.[Select](start, [end] - start)
If True Then
box.SelectionColor = color
' could set box.SelectionBackColor, box.SelectionFont too.
End If
box.SelectionLength = 0
' clear
End Sub
#End Region
#Region "Thread"
Public _WaitHandle_FirstThreadDone As New System.Threading.AutoResetEvent(False)
Public Sub ThreadProc(ByVal aDir As DirectoryInfo)
Dim aFile As FileInfo
For Each aFile In aDir.GetFiles()
If accepted_extensions.ToLower.Contains(aFile.Extension.ToLower) Then
' print output
AppendText(consolebox, Color.Yellow, "Processing: ")
AppendText(consolebox, Color.White, aFile.ToString() + vbNewLine)
consolebox.ScrollToCaret()
processedfiles += 1
totalfiles_label.Text = "Processed " + processedfiles.ToString() + " of " + totalfiles.ToString() + " total video files"
' MEDIAINFO: (ac3, dts, wav and multitrack)
If ac3 = True Or dts = True Or wav = True Or multitrack = True Then
MI.Open(aFile.FullName)
Dim Pos As Integer = 0
To_Display = Nothing
While Pos < MI.Count_Get(StreamKind.Audio)
' AC-3
If ac3 = True Then
If MI.Get_(StreamKind.Audio, Pos, "Format").ToString() = "AC-3" Then
results_box.AppendText("AC3 Track: " + aFile.FullName.ToString() + vbNewLine)
results_box.SelectionStart = results_box.Text.Length
results_box.ScrollToCaret()
problems += 1
problems_label.Text = problems.ToString() + " problems found"
End If
End If
System.Math.Max(System.Threading.Interlocked.Increment(Pos), Pos - 1)
End While
End If
End If
Next
_WaitHandle_FirstThreadDone.Set()
End Sub
#End Region
#Region "Organize function"
Public Sub MediaInfo(Directory)
Dim MyDirectory As DirectoryInfo
MyDirectory = New DirectoryInfo(NameOfDirectory)
MediaInfoWorkWithDirectory(MyDirectory)
End Sub
Public Sub MediaInfoWorkWithDirectory(ByVal aDir As DirectoryInfo)
Dim nextDir As DirectoryInfo
Dim t As New Threading.Thread(AddressOf ThreadProc)
t.Start(aDir)
'
For Each nextDir In aDir.GetDirectories
If playlist = True Then
Using writer As StreamWriter = New StreamWriter(aDir.FullName & "\" & nextDir.Name & "\" & nextDir.Name & ".m3u", False, System.Text.Encoding.UTF8)
'overwrite existing playlist
End Using
End If
MediaInfoWorkWithDirectory(nextDir)
Next
End Sub
#End Region
#Region "Action buttons"
' start button
Public Sub Button2_Click(sender As Object, e As EventArgs) Handles start_button.Click
consolebox.Clear()
' pause / cancel button ON
start_button.Enabled = False
pause_button.Enabled = True
cancel_button.Enabled = True
' Organization process
NameOfDirectory = userSelectedFolderPath
MediaInfo(NameOfDirectory)
' _WaitHandle_FirstThreadDone.WaitOne()
consolebox.AppendText(vbNewLine + "[+] Organization finalized!" + vbNewLine)
consolebox.Refresh()
consolebox.SelectionStart = consolebox.Text.Length
consolebox.ScrollToCaret()
' pause / cancel button OFF
start_button.Enabled = True
pause_button.Enabled = False
cancel_button.Enabled = False
End Sub
#End Region
Private Sub pause_button_Click(sender As Object, e As EventArgs) Handles pause_button.Click
paused = True
End Sub
End Class
The reason the app hangs is the program is blasting through data sequentially. You should add an if statement inside the part that is looping to check for the pause condition in between processing. Its not a good idea to put the on/off controls inside the subroutine like you have because it can only enable the buttons after everything has completed.
I.E to stop the process
For i to 10 Do
If checkbox1.checked = True then Exit Sub 'check for stop condition
'process videos
Loop
To pause it you could implement a stop but make it remember where to start when resumed.
Also why do you have faces of death? That stuff kills braincells.