I have a downladed file from ssh but it takes 50 seconds to complete the download - vb.net

I am using vb.net to download a file and using Tamir.SharpSsh which works well except its slow it takes about 50 seconds to download a 3.5 kb file. My Question is How would I best put a wait function in for 2 mins to ensure the file is downloaded.
Public Function DownloadPricat() As Boolean
Dim retVal As Boolean
Dim PRICAT_CSV As String
Dim sfilename As String = ""
Dim ifilename As String
utils = New ThreeSoftware.Configuration.Utilities.utilConfigurationLoader("CONFIGURATION FILES\GEMINI RELATED\SkechersImport.ini")
Hostname = utils.GetIniSetting("SSH SECTION", "SSH_HOST", "")
username = utils.GetIniSetting("SSH SECTION", "SSH_USERNAME", "")
passsword = utils.GetIniSetting("SSH SECTION", "SSH_PASSWORD", "")
port = utils.GetIniSetting("SSH SECTION", "SSH_PORT", "")
HomeDirectoy = utils.GetIniSetting("SSH SECTION", "SSH_REMOTE_DIRECTORY", "")
transfer = New wcSFtp(Hostname, Integer.Parse(port), username, passsword)
PRICAT_CSV = utils.GetIniSetting("PATHS SECTION", "PRICAT_CSV", "")
sfilename = utils.GetIniSetting("PATHS SECTION", "PRICAT_FILENAME", "")
ifilename = PRICAT_CSV & "\" & sfilename
If transfer.getFile(HomeDirectoy & "Pricat.edi", ifilename) = True Then
MsgBox("Download Complete", vbInformation, "Import")
retVal = True
Else
retVal = False
End If
End Function
Get File is simply this
Public Function getFile(ByVal remotePath As String, ByVal localFile As String) As Boolean
Try
transfer = New Sftp(Me._hostname, Me._username, Me._password)
transfer.Connect(Me._port)
transfer.Get(remotePath, localFile)
transfer.Close()
Return True
Catch ex As Exception
Debug.Print("Error downloading file: " & ex.ToString)
Return False
End Try
End Function

Put the whole download into a backgroundworker's DoWork() function and add the Boolean result as the result-variable of the eventargs variable.
Then handle the RunWorkerCompleted() event of the backgroundworker and perform whatever task you want to happen after the download from there. That way you make sure the download is actually finished.
Public Class Form1
Private WithEvents LazyBGW As New System.ComponentModel.BackgroundWorker
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
'Initiate the backgroundworker. It runs in another thread.
LazyBGW.RunWorkerAsync()
End Sub
Private Sub LazyBGW_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles LazyBGW.DoWork
'This code runs in the BGW-Thread
'Perform the whole download task here or just call your
e.Result = DownloadPricat()
'Work is done, put results in the eventargs-variable for further processing
End Sub
Private Sub LazyBGW_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles LazyBGW.RunWorkerCompleted
'This code runs in the UI-Thread
Dim results As Boolean = CBool(e.Result)
MessageBox.Show("The worker is done and our result is: " & results.ToString)
End Sub
End Class
Edit:
In a console app you can use a Task:
Module Module1
Private Function DownloadPricat() As Boolean
Threading.Thread.Sleep(10000)
Return True
End Function
Sub Main()
Dim DLTask As New System.Threading.Tasks.Task(Of Boolean)(Function() DownloadPricat())
DLTask.Start()
Dim ThisTime As Date = Date.Now
Console.Write("Downloading")
While DLTask.IsCompleted = False AndAlso DLTask.IsCanceled = False AndAlso DLTask.IsFaulted = False
If (Date.Now - ThisTime).TotalSeconds > 1 Then
Console.Write(".")
ThisTime = Date.Now
End If
End While
Console.Write("Done.")
End Sub
End Module

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

System.Diagnostics.Process not properly closing after the application is closed

I have been trying to find a solution to why the ExitTool I am using is not properly closing out after I close the main application. What is happening is that when I close my application, the ExifTool stays running in the background and I have to manually kill it.
Here is the code snippet of the process startup.
Public Shared Sub ExecuteExifTool()
If ExifToolStarted Then Exit Sub
ExifToolStarted = True
Dim NowString As String = Date.Now.ToString("yyyyMMddHHmmss")
If Not IO.Directory.Exists(".\Runtime") Then IO.Directory.CreateDirectory(".\Runtime")
Dim GetDirectory As New IO.DirectoryInfo(".\Runtime")
If GetDirectory.GetFiles.Count > 0 Then
For Each i As IO.FileInfo In GetDirectory.GetFiles
If i.FullName.Contains("exif.Yv") AndAlso i.FullName.Contains("-cL") AndAlso i.FullName.Contains(".exe") Then : Try : i.Delete() : Catch : End Try : End If
Next
End If
HostName = ".\Runtime\exif.Yv" & NowString.Substring(0, 8) & "-cL" & NowString.Substring(8, 6) & ".exe"
IO.File.Copy(".\exiftool.exe", HostName)
Using ExifToolProcess As New Process
With ExifToolProcess
.StartInfo.RedirectStandardInput = True
.StartInfo.FileName = HostName
.StartInfo.UseShellExecute = False
.StartInfo.Arguments = "-stay_open" & " True -# " & "-"
.StartInfo.RedirectStandardOutput = True
.StartInfo.RedirectStandardError = True
.StartInfo.CreateNoWindow = True
.StartInfo.WindowStyle = ProcessWindowStyle.Hidden
.Start()
.BeginOutputReadLine()
.BeginErrorReadLine()
End With
End Using
End Sub
The latest attempt to solve this issue was to try and launch another executable application; which essentially, is another Windows.Forms.Form that waits for the main application to close and then it will attempt to kill the process immediately afterwards, then dispose of itself. Here is the snippet.
Public Class KillProcess
Private _ProcessName As String
Public Property ProcessName As String
Get
Return _ProcessName
End Get
Set(value As String)
_ProcessName = value
End Set
End Property
Private _MainApp As Form
Public Property MainApplication As Form
Get
Return _MainApp
End Get
Set(value As Form)
_MainApp = value
End Set
End Property
Private Sub KillProcess_Load(sender As Object, e As EventArgs) Handles MyBase.Load
CleanupProcess()
End Sub
Public Sub CleanupProcess()
While Not MainApplication.IsDisposed
Dim FilesToDelete As New List(Of String)
Dim ProcessesToKill As New List(Of Process)
For Each p As Process In Process.GetProcesses
If p.ProcessName = ProcessName Then
FilesToDelete.Add(p.MainModule.FileName)
ProcessesToKill.Add(p)
End If
Next
For Each p As Process In ProcessesToKill
Try
p.Kill()
p.WaitForExit(10000)
p.Close()
Catch winException As System.ComponentModel.Win32Exception
Catch invalidException As InvalidOperationException
End Try
Next
End While
Me.Dispose()
End Sub
End Class
And here is the code snippet of the startup.
Public Sub CleanupTask()
Dim Handler As New Custodian.KillProcess With {.ProcessName = ExifToolHooker.HostName, .MainApplication = Me}
Windows.Forms.Application.Run(Handler)
End Sub
Private Sub CloseApplication(sender As Object, e As FormClosingEventArgs) Handles Me.Closing
Dim TaskHandler As Thread = New Thread(AddressOf CleanupTask)
TaskHandler.SetApartmentState(ApartmentState.STA)
TaskHandler.Start()
...
End Sub

Get File Size on FTP Server and put it on a Label

I'm trying to get the size of a file that is hosted on a FTP Server and put it in a Label while the `BackgroundWorker works in the background.
I'm using "Try" to get the value, however the value is caught on the first attempt. After downloading, if I press to try to get it again then it works.
Note: The progress bar also does not work on the first try.
Image
What I have tried:
Private Sub BWorkerD_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BWorkerD.DoWork
Dim buffer(1023) As Byte
Dim bytesIn As Integer
Dim totalBytesIn As Integer
Dim output As IO.Stream
Dim flLength As Integer
''TRY TO GET FILE SIZE''
Try
Dim FTPRequest As FtpWebRequest = DirectCast(WebRequest.Create(txtFilePathD.Text), FtpWebRequest)
FTPRequest.Credentials = New NetworkCredential(txtFTPUsernameD.Text, txtFTPPasswordD.Text)
FTPRequest.Method = Net.WebRequestMethods.Ftp.GetFileSize
flLength = CInt(FTPRequest.GetResponse.ContentLength)
lblFileSizeD.Text = flLength & " bytes"
Catch ex As Exception
End Try
Try
Dim FTPRequest As FtpWebRequest = DirectCast(WebRequest.Create(txtFilePathD.Text), FtpWebRequest)
FTPRequest.Credentials = New NetworkCredential(txtFTPUsernameD.Text, txtFTPPasswordD.Text)
FTPRequest.Method = WebRequestMethods.Ftp.DownloadFile
Dim stream As IO.Stream = FTPRequest.GetResponse.GetResponseStream
Dim OutputFilePath As String = txtSavePathD.Text & "\" & IO.Path.GetFileName(txtFilePathD.Text)
output = IO.File.Create(OutputFilePath)
bytesIn = 1
Do Until bytesIn < 1
bytesIn = stream.Read(buffer, 0, 1024)
If bytesIn > 0 Then
output.Write(buffer, 0, bytesIn)
totalBytesIn += bytesIn
lblDownloadedBytesD.Text = totalBytesIn.ToString & " bytes"
If flLength > 0 Then
Dim perc As Integer = (totalBytesIn / flLength) * 100
BWorkerD.ReportProgress(perc)
End If
End If
Loop
output.Close()
stream.Close()
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
''UPDATE EVERY PROGRESS - DONT WORK ON FIRST TRY''
Private Sub BWorkerD_ProgressChanged(sender As Object, e As System.ComponentModel.ProgressChangedEventArgs) Handles BWorkerD.ProgressChanged
pBarD.Value = e.ProgressPercentage
lblPercentD.Text = e.ProgressPercentage & " %"
End Sub
The main problems (set Option Strict On to find more):
You can't access the UI objects from a thread different than the UI Thread.
The error you receive is:
Cross-thread operation not valid:Control lblFileSizeD accessed from
a thread other than the thread it was created on
Then, the same error for lblDownloadedBytesD.
Also, you are eating up your Error messages using an empty handler with:
Catch ex As Exception
End Try
This nullifies any handling, because there's none. You are simply letting the code run past it without taking any action. The handlers are there to, well, handle the errors, not to let them go unchecked.
When you need to access and update some UI component property, use the BackGroundWorker ReportProgress() method. This method has an overload that accepts a parameter of type Object. Meaning, you can feed it anything. This Object will be the e.UserState property in the ReportProgress ProgressChangedEventArgs class.
The .RunWorkerAsync() method also accepts an Object parameter. This Object will become the e.Argument property of the BackgroundWorker.DoWork Event. This gives some flexibility in relation to the parameters you can actually pass to your BackGroundWorker.
One more problem: the Ftp Download procedure does not support cancellation. When run, a user can't stop it.
Last problem: as reported in the documentation, you should never reference the BackGroundWorker object you instantiated in your UI thread (the Form) in its DoWork event. Use the sender object and cast it to the BackGroundWorker class.
In this example, all the UI references are delegated to a Class object that is passed to the DoWork event through the RunWorkerAsync(Object) method (using the e.Argument property).
The Class object is updated with progress details and then fed to the ReportProgress(Int32, Object) method, which runs in the original Synchronization Context (the UI thread, where the RunWorkerAsync method is called).
The UI can be updated safely. No cross-thread operations can occur.
A cancellation method is also implemented. This allows to abort the download procedure and to delete a partial downloaded file, if one is created.
The error handling is minimal, but this is something you need to integrate with your own tools.
(I've used the same names for the UI Controls, it should be easier to test.)
Imports System.ComponentModel
Imports System.Globalization
Imports System.IO
Imports System.Net
Imports System.Net.Security
Imports System.Security.Cryptography.X509Certificates
Public Class frmBGWorkerDownload
Friend WithEvents BWorkerD As BackgroundWorker
Public Sub New()
InitializeComponent()
BWorkerD = New BackgroundWorker()
BWorkerD.WorkerReportsProgress = True
BWorkerD.WorkerSupportsCancellation = True
AddHandler BWorkerD.DoWork, AddressOf BWorkerD_DoWork
AddHandler BWorkerD.ProgressChanged, AddressOf BWorkerD_ProgressChanged
AddHandler BWorkerD.RunWorkerCompleted, AddressOf BWorkerD_RunWorkerCompleted
BWorkerD.RunWorkerAsync(BGWorkerObj)
End Sub
Private Class BGWorkerObject
Public Property UserName As String
Public Property Password As String
Public Property ResourceURI As String
Public Property FilePath As String
Public Property FileLength As Long
Public Property DownloadedBytes As Long
Public Property BytesToDownload As Long
End Class
Private Sub btnDownload_Click(sender As Object, e As EventArgs) Handles btnDownload.Click
pBarD.Value = 0
Dim BGWorkerObj As BGWorkerObject = New BGWorkerObject With {
.ResourceURI = txtFilePathD.Text,
.FilePath = Path.Combine(txtSavePathD.Text, Path.GetFileName(txtFilePathD.Text)),
.UserName = txtFTPUsernameD.Text,
.Password = txtFTPPasswordD.Text
}
End Sub
Private Sub BWorkerD_DoWork(sender As Object, e As DoWorkEventArgs)
Dim BGW As BackgroundWorker = TryCast(sender, BackgroundWorker)
Dim BGWorkerObj As BGWorkerObject = TryCast(e.Argument, BGWorkerObject)
Dim FTPRequest As FtpWebRequest
Dim BufferSize As Integer = 131072
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
ServicePointManager.ServerCertificateValidationCallback =
Function(snd As Object, Cert As X509Certificate, Chain As X509Chain, Err As SslPolicyErrors)
Return True
End Function
FTPRequest = DirectCast(WebRequest.Create(BGWorkerObj.ResourceURI), FtpWebRequest)
FTPRequest.Credentials = New NetworkCredential(BGWorkerObj.UserName, BGWorkerObj.Password)
'FTPRequest.Method = WebRequestMethods.Ftp.GetFileSize
'----------------------- UPDATE ------------------------
FTPRequest.Method = WebRequestMethods.Ftp.ListDirectoryDetails
'--------------------- END UPDATE ------------------------
FTPRequest.EnableSsl = True
'----------------------- UPDATE ------------------------
Using FtpResponse As WebResponse = FTPRequest.GetResponse,
DirListStream As Stream = FtpResponse.GetResponseStream(),
listReader As StreamReader = New StreamReader(DirListStream)
While Not listReader.EndOfStream
Dim DirContent As String = listReader.ReadLine()
If DirContent.Contains(Path.GetFileNameWithoutExtension(BGWorkerObj.ResourceURI)) Then
BGWorkerObj.FileLength = Convert.ToInt64(DirContent.Split(New String() {" "}, StringSplitOptions.RemoveEmptyEntries)(4))
BGW.ReportProgress(0, BGWorkerObj)
Exit While
End If
End While
End Using
'----------------------- END UPDATE ------------------------
'Using FtpResponse As WebResponse = FTPRequest.GetResponse
' BGWorkerObj.FileLength = Convert.ToInt64(FtpResponse.ContentLength)
' BGW.ReportProgress(0, BGWorkerObj)
'End Using
If BGW.CancellationPending Then e.Cancel = True
Try
FTPRequest = CType(WebRequest.Create(BGWorkerObj.ResourceURI), FtpWebRequest)
FTPRequest.EnableSsl = True
FTPRequest.Credentials = New NetworkCredential(BGWorkerObj.UserName, BGWorkerObj.Password)
FTPRequest.Method = WebRequestMethods.Ftp.DownloadFile
Using Response As FtpWebResponse = DirectCast(FTPRequest.GetResponse, FtpWebResponse)
If Response.StatusCode > 299 Then
e.Result = 0
Throw New Exception("The Ftp Server rejected the request. StatusCode: " &
Response.StatusCode.ToString(),
New InvalidOperationException(Response.StatusCode.ToString()))
Exit Sub
End If
Using stream = Response.GetResponseStream(),
fileStream As FileStream = File.Create(BGWorkerObj.FilePath)
Dim read As Integer
Dim buffer As Byte() = New Byte(BufferSize - 1) {}
Do
read = stream.Read(buffer, 0, buffer.Length)
fileStream.Write(buffer, 0, read)
BGWorkerObj.DownloadedBytes += read
BGWorkerObj.BytesToDownload = BGWorkerObj.FileLength - BGWorkerObj.DownloadedBytes
If BGW.CancellationPending Then
e.Cancel = True
Exit Do
Else
BGW.ReportProgress(CInt((CSng(BGWorkerObj.DownloadedBytes) / BGWorkerObj.FileLength) * 100), BGWorkerObj)
End If
Loop While read > 0
End Using
End Using
Catch ex As Exception
If e.Cancel = False Then Throw
Finally
If e.Cancel = True Then
If File.Exists(BGWorkerObj.FilePath) Then
File.Delete(BGWorkerObj.FilePath)
End If
End If
End Try
End Sub
Private Sub BWorkerD_ProgressChanged(sender As Object, e As ProgressChangedEventArgs)
pBarD.Value = e.ProgressPercentage
lblPercentD.Text = e.ProgressPercentage.ToString() & " %"
If lblFileSizeD.Text.Length = 0 Then
lblFileSizeD.Text = CType(e.UserState, BGWorkerObject).FileLength.ToString("N0", CultureInfo.CurrentUICulture.NumberFormat)
End If
lblDownloadedBytesD.Text = CType(e.UserState, BGWorkerObject).DownloadedBytes.ToString("N0", CultureInfo.CurrentUICulture.NumberFormat)
If e.ProgressPercentage <= 15 Then
lblDownloadedBytesD.ForeColor = Color.Red
ElseIf e.ProgressPercentage <= 66 Then
lblDownloadedBytesD.ForeColor = Color.Orange
Else
lblDownloadedBytesD.ForeColor = Color.LightGreen
End If
End Sub
Private Sub BWorkerD_RunWorkerCompleted(sender As Object, e As RunWorkerCompletedEventArgs)
Dim DownloadAborted As Boolean = False
If e.Error IsNot Nothing Then
DownloadAborted = True
lblDownloadedBytesD.ForeColor = Color.Red
lblDownloadedBytesD.Text = "Error!"
ElseIf e.Cancelled Then
DownloadAborted = True
lblDownloadedBytesD.ForeColor = Color.Yellow
lblDownloadedBytesD.Text = "Cancelled!"
pBarD.Value = 0
lblPercentD.Text = "0%"
Else
lblDownloadedBytesD.ForeColor = Color.LightGreen
lblDownloadedBytesD.Text = "Download completed"
End If
End Sub
Private Sub btnAbortDownload_Click(sender As Object, e As EventArgs) Handles btnAbortDownload.Click
BWorkerD.CancelAsync()
End Sub
End Class
A visual result of the operation described:
A PasteBin of the Form's Designer + Code

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.

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