Get File Size on FTP Server and put it on a Label - vb.net

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

Related

Unable to decode serial port data

I tried to receive data from medical 'Mindray bs 200' device through serial port. data received but is unreadable. Unable to find the kind of data encryption.
Here is the code that receives the data
Private Sub comPort_DataReceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles comPort.DataReceived
Dim str As String = ""
If e.EventType = SerialData.Chars Then
Do
Dim bytecount As Integer = comPort.BytesToRead
If bytecount = 0 Then
Exit Do
End If
Dim byteBuffer(bytecount) As Byte
comPort.Encoding = Encoding.GetEncoding(28591)
' comPort.Encoding = Encoding.GetEncoding(1252)
'comPort.Encoding = Encoding.GetEncoding("Windows-1252")
comPort.Read(byteBuffer, 0, bytecount)
str = str & System.Text.Encoding.ASCII.GetString(byteBuffer, 0, 1)
' The str looks like
Loop
End If
RaiseEvent ScanDataRecieved(str)
End Sub
Here is the data received
??????????????????????????????????????????????????????????????????????????????????????????????????????????????????X???????????????????
While not for this particular device, this document discusses a device that uses the same RS232 communication protocol and recommends the following SerialPort settings:
Baud rate: 115200
DataBits: 8
StopBits: 1
Parity: None
No flow control
Note: Minimum baud rate is 57600.
According to this document
2.1 Message Grammar:
Each HL7 message is composed of segments that end with <CR>
3 Communication Process and Message Example:
A message of HL7 protocol is the format of: <SB> ddddd <EB><CR>
ASCII value (HEX)
<SB> (start of message): 0B (VT - vertical tab)
<EB> (end of message): 1C (FS - file separator)
<CR> (carriage return) 0D (carriage return)
In the code below, I'll show how to use a buffer to collect data when "start of message" is received (HEX: 0B) and fill the buffer until "end of message" (HEX: 1C) followed by a carriage return (HEX: 0D) is received - at which point we'll raise an event and/or output the data.
For testing, we'll also write the data to a file in the Documents folder - this file is deleted each time the program starts so that only data from the current execution of the program is contained in the file. Each byte of data is output as a 2-digit hexadecimal value which allows us to see if a value is a control character.
The following may be helpful for interpreting the values:
ASCII Table
ASCII Code - The extended ASCII table
Create a class (name: HelperSerialPort.vb)
HelperSerialPort.vb
Note: The code in method Port_DataReceived (within the if-elseif statements) is untested - I don't have the particular device that you're using to be able to test it.
'(.NET Framework) - Add reference: Project => Add Reference => Assemblies => System.Management
'add using statement: Using System.Management;
'
'For >= .NET 5, install NuGet Package: System.IO.Ports and System.Management
'add Imports statements: Imports System.IO.Ports; Imports System.Management;
'
'
Imports System.Management
Imports System.IO.Ports
'specify valid baud rates
Public Enum PortBaudRate As Integer
Baud57600 = 57600
Baud76800 = 76800
Baud115200 = 115200
End Enum
Public Class HelperSerialPort
Implements IDisposable
Private Const BufferSize As Integer = 4096 'this value may need to be changed
Private Port As SerialPort = Nothing
Private BytesReadMessage As Integer = 0 'used to hold message bytes read
Private Buffer(BufferSize) As Byte 'used to hold data
Private Filename As String = Nothing
Private IsMessage As Boolean = False
'events that can be subscribed to
Public Event DataReceived(ByVal sender As Object, ByVal data As String)
Public Event ErrorReceived(ByVal sender As Object, ByVal errMsg As String)
Sub New()
'set value
'data will be written to this file for testing
Filename = System.IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments), "Mindray BS200.txt")
If Not String.IsNullOrEmpty(Filename) AndAlso System.IO.File.Exists(Filename) Then
'delete existing file
System.IO.File.Delete(Filename)
End If
System.Diagnostics.Debug.WriteLine("Filename: '" & Filename & "'")
End Sub
Public Function Connect(ByVal comPort As String, ByVal Optional baudRate As PortBaudRate = PortBaudRate.Baud115200) As String
Dim errMsg As String = String.Empty
Dim portName As String = String.Empty
Dim result As String = String.Empty
If String.IsNullOrEmpty(comPort) Then
errMsg = "COM port not selected"
Throw New Exception(errMsg)
End If
Try
If Port Is Nothing Then
'create new instance
Port = New SerialPort(comPort)
'subscribe to events (add event handlers)
AddHandler Port.DataReceived, AddressOf Port_DataReceived
AddHandler Port.ErrorReceived, AddressOf Port_ErrorReceived
End If
If Not Port.IsOpen Then
'set properties
Port.BaudRate = baudRate
Port.Handshake = Handshake.None
'if parity is even or odd, then set DataBits = 7
'if parity is none, set DataBits = 8
Port.Parity = Parity.None
Port.DataBits = 8
Port.StopBits = StopBits.One
'Port.ReadTimeout = 500 'this value may need to be adjusted
Port.WriteTimeout = 500 'this value may need to be adjusted
Port.DtrEnable = True 'enable Data Terminal Ready
'Port.RtsEnable = True 'enable Request to Send
'Port.DiscardNull = True
'Port.ReceivedBytesThreshold = 1 'number of bytes that causes 'DataReceived' event to be raised; default is 1
'open port
Port.Open()
result = "Status: Connected"
Else
result = "Status: Already Connected"
End If
Catch ex As System.IO.IOException
errMsg = "Error: " & ex.Message
result = errMsg 'set value
Debug.WriteLine(errMsg)
Dispose()
Catch ex As Exception
errMsg = "Error: " & ex.Message
result = errMsg 'set value
Debug.WriteLine(errMsg)
Throw ex
End Try
Debug.WriteLine(result)
Return result
End Function
Public Function Disconnect() As String
Dispose()
Return "Status: Disconnected"
End Function
Public Sub Dispose() Implements System.IDisposable.Dispose
If Port IsNot Nothing Then
'unsubscribe from events (remove event handlers)
RemoveHandler Port.DataReceived, AddressOf Port_DataReceived
RemoveHandler Port.ErrorReceived, AddressOf Port_ErrorReceived
Port.Dispose()
Port = Nothing
Else
Debug.WriteLine("Info: Port is null")
End If
End Sub
Public Function IsPortOpen() As Boolean
If Port IsNot Nothing Then
If Port.IsOpen Then
Return True
Else
Try
Port.Dispose()
Catch ex As Exception
'do nothing
Debug.WriteLine("Error (IsPortOpen): " & ex.Message)
End Try
End If
Port = Nothing
System.GC.Collect()
System.GC.Collect()
End If
Return False
End Function
Private Sub Port_DataReceived(ByVal sender As Object, ByVal e As SerialDataReceivedEventArgs)
'ToDo: add desired code
Dim bytesRead As Integer = 0
Dim bytesToRead As Integer = 1
Dim errMsg As String = String.Empty
'read SerialPort data
Do
'read 1 byte at a time
bytesRead = Port.Read(Buffer, BytesReadMessage, bytesToRead)
'when <SB> (HEX: 0B) is received, remove all existing data from buffer
'this will result in the buffer only containing our desired data.
'when <EB> (HEX: 1C) is received followed by <CR> (HEX: 0D),
'this is the end of the message, so we'll send the message and/or display it.
'Buffer(BytesReadMessage) contains the last byte of data that was read
'
If Buffer(BytesReadMessage) = &HB Then
'0x0B - VT (vertical tab); in the documentation this is '<SB>' - start of message
System.Diagnostics.Debug.WriteLine("<SB> (start of message)")
'remove existing data (get ready for new message)
Array.Clear(Buffer, 0, Buffer.Length)
're-initialize to -1. It's incremented below which will result in the value being 0
BytesReadMessage = -1
'set value - start saving data to the buffer
IsMessage = True
ElseIf IsMessage AndAlso Buffer(BytesReadMessage) = &HD AndAlso Buffer(BytesReadMessage - 1) = &H1C Then
'0x1C - FS (file separator); in the documentation this is '<EB>' - end of message
'0x0D - CR (carriage return); in the documentation this is '<CR>'
System.Diagnostics.Debug.WriteLine("<EB> (end of message)")
'raise event to send data
SendData(Buffer)
'set value - stop saving data to the buffer
IsMessage = False
ElseIf Not IsMessage Then
'for debugging/testing, display non-message data
System.Diagnostics.Debug.WriteLine("Non-message data: " & Buffer(BytesReadMessage).ToString("X2"))
End If
'set value
BytesReadMessage += bytesRead
Debug.WriteLine("Info: BytesReadMessage: " & BytesReadMessage.ToString() & " bytesRead: " & bytesRead.ToString() & " Port.BytesToRead: " & Port.BytesToRead.ToString())
Loop While (Port.BytesToRead > 0)
Debug.WriteLine(String.Format("{0}---------------------------{0}", System.Environment.NewLine))
End Sub
Private Sub Port_ErrorReceived(ByVal sender As Object, ByVal e As SerialErrorReceivedEventArgs)
'ToDo: add desired code
Dim errMsg As String = e.EventType.ToString()
Debug.WriteLine("Port_ErrorReceived: " & errMsg)
'raise event
RaiseEvent ErrorReceived(Me, errMsg)
End Sub
Public Sub SendData(buffer() As Byte)
'ToDo: modify the code below and/or add desired code
'convert to a string that's human-readable
Dim data As String = String.Empty
If buffer IsNot Nothing Then
For i As Integer = 0 To BytesReadMessage Step 1
If Not String.IsNullOrEmpty(data) Then
data += " " 'append space
End If
'for testing, convert to a 2-digit HEX value
data += buffer(i).ToString("X2")
Next
'add newline
data += System.Environment.NewLine
End If
System.Diagnostics.Debug.WriteLine("data: " & data)
'for testing save to file
If Not String.IsNullOrEmpty(Filename) Then
'append data to file
System.IO.File.AppendAllText(Filename, data)
End If
'raise event
RaiseEvent DataReceived(Me, data)
'Note: "When receiving the message, the LIS (Laboratory Information Management System) host first judges the legality and type of the message and then replies accordingly."
'ToDo: A response needs to be sent for each message received (see documentation for information on how to create the appropriate message - "3 Communication Process and Message Example")
End Sub
Public Sub WriteToSerialPort(ByVal data As String)
Dim errMsg As String = String.Empty
Try
If Port.IsOpen Then
'convert string to Byte array
Dim hexArr As Byte() = System.Text.Encoding.ASCII.GetBytes(data)
For Each hexVal As Byte In hexArr
'convert byte to byte array
Dim tempArr As Byte() = New Byte() {hexVal}
'write
Port.Write(tempArr, 0, 1)
'add 1 ms delay before writing next byte
System.Threading.Thread.Sleep(1)
Next
Else
errMsg = "Error: Port is not open. Please open the connection and try again."
Debug.WriteLine(errMsg)
Throw New Exception(errMsg)
End If
Catch ex As Exception
errMsg = "Error: " & ex.Message
Debug.WriteLine(errMsg)
Throw ex
End Try
End Sub
End Class
Below is an alternative version of method Port_DataReceived that uses ReadExisting() instead - however, it may not work in your situation.
Port_DataReceived (version that uses ReadExisting):
Private Sub Port_DataReceived(ByVal sender As Object, ByVal e As SerialDataReceivedEventArgs)
'ToDo: add desired code
'read SerialPort data
Dim data As String = String.Empty
data = Port.ReadExisting()
'data = Port.ReadLine
Debug.WriteLine("Port_DataReceived: " & data)
'raise event
RaiseEvent DataReceived(Me, data)
End Sub
Form1:
Add a Button (name: btnConnectDisconnect)
Double-click the button to add the event handler
Add a RichTextBox (name: RichTextBox1)
Form1.vb
Note: In the code below, you'll need to update helper.Connect("COM1") with the correct COM port.
Public Class Form1
Private helper As HelperSerialPort = New HelperSerialPort()
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
Private Sub Disconnect()
If helper IsNot Nothing Then
'unsubscribe from event(s)
RemoveHandler helper.DataReceived, AddressOf Helper_DataReceived
RemoveHandler helper.ErrorReceived, AddressOf Helper_ErrorReceived
helper.Dispose()
helper = Nothing
End If
End Sub
Private Sub btnConnectDisconnect_Click(sender As Object, e As EventArgs) Handles btnConnectDisconnect.Click
If helper Is Nothing Then
'create new instance
helper = New HelperSerialPort()
End If
If btnConnectDisconnect.Text = "Connect" Then
'clear existing data
RichTextBox1.Clear()
'ToDo: change to your desired COM port
helper.Connect("COM1")
'subscribe to event(s)
AddHandler helper.DataReceived, AddressOf Helper_DataReceived
AddHandler helper.ErrorReceived, AddressOf Helper_ErrorReceived
'set text
btnConnectDisconnect.Text = "Disconnect"
btnConnectDisconnect.Refresh()
Else
Disconnect()
'set text
btnConnectDisconnect.Text = "Connect"
btnConnectDisconnect.Refresh()
End If
End Sub
Private Sub Helper_DataReceived(ByVal sender As Object, ByVal data As String)
'ToDo: add desired code
System.Diagnostics.Debug.WriteLine(DateTime.Now.ToString("HH:mm:ss") & " - Helper_DataReceived: " & data)
'append data to RichTextBox
RichTextBox1.Invoke(New MethodInvoker(Sub()
RichTextBox1.AppendText(DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss.fff") & " - " & data)
End Sub))
End Sub
Private Sub Helper_ErrorReceived(ByVal sender As Object, ByVal errMsg As String)
'ToDo: add desired code
System.Diagnostics.Debug.WriteLine(DateTime.Now.ToString("HH:mm:ss") & " - Helper_ErrorReceived: " & errMsg)
'append error message to RichTextBox
RichTextBox1.Invoke(New MethodInvoker(Sub()
RichTextBox1.AppendText(errMsg)
End Sub))
End Sub
Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles MyBase.FormClosed
Disconnect()
End Sub
End Class
Resources:
Host Interface Manual
HL7 Version 2.3.1
Modem control signals

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

Insert string to <input> tag

I'm developing a client that connects to my server, and get access to download and upload files, and i seem to be stuck at uploading files. Here is my code on my VB.NET client:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click 'Upload button
WebBrowser1.Visible = True
'Style OpenFileDialog1
OpenFileDialog1.Title = "Select file to upload"
OpenFileDialog1.InitialDirectory = System.Environment.SpecialFolder.Desktop
OpenFileDialog1.ShowDialog()
End Sub
Private Sub OpenFileDialog1_FileOk(sender As Object, e As System.ComponentModel.CancelEventArgs) Handles OpenFileDialog1.FileOk
uploadFile = OpenFileDialog1.FileName.ToString()
If uploadFile = Nothing Then
MessageBox.Show("You just selected nothing.", "Information")
Else
WebBrowser1.Document.GetElementById("fileselect").SetAttribute("value", uploadFile)
WebBrowser1.Document.GetElementById("submit").InvokeMember("click")
End If
End Sub
And here is the HTML code:
<input type="file" id="fileselect" name="fileselect[]" multiple="multiple" />
<button type="submit" id="submit" class="uploadButton">Upload Files</button>
Also how do i make so that i can select multiple files? Via the web version you can select multiple files and it workes not not here?
So, as mentioned in the comments, input elements of type file do not allow for external modification, all interaction with them is done through the browser and is based on direct user interaction.
However, you could create an upload class that process the multiple file upload to your server, by creating a HttpWebRequest, which sends the data to the form. Provided there is no authentication, it can be done in the following way.
An interface that allows for some elementary actions for post data items
Public Interface IPostItem
ReadOnly Property Title As String
Property ElementName As String
Function GetPostData(inputNameElement As String) As String
End Interface
Some way to define the mime type of the file being sent
Public NotInheritable Class MimeTypeHandler
Private Shared ReadOnly images As String() = {"jpg", "gif", "bmp", "png", "jpeg"}
Public Shared Function GetMimeType(filename As String) As String
Dim extension As String = Path.GetExtension(filename).Replace(".", "")
If (images.Contains(extension)) Then
Return "image/" + extension
End If
Return "application/" + extension
End Function
End Class
Implement the IPostItem with an implementation that can post the file
Public Class FileQueueItem
Implements IPostItem
Public Property FileName As String
Public Property ElementName As String Implements IPostItem.ElementName
Public Function GetData() As Byte()
Dim result As Byte() = Nothing
Dim lengthRead As Integer = 0
Using stream As New FileStream(FileName, FileMode.Open, FileAccess.Read)
ReDim result(stream.Length)
lengthRead = stream.Read(result, 0, stream.Length)
End Using
Return result
End Function
Public ReadOnly Property ShortName As String Implements IPostItem.Title
Get
Return FileName.Substring(FileName.LastIndexOf("\") + 1)
End Get
End Property
Public ReadOnly Property MimeType As String
Get
Return MimeTypeHandler.GetMimeType(FileName)
End Get
End Property
Public Function GetPostData(inputNameElement As String) As String Implements IPostItem.GetPostData
Dim message As String = String.Empty
message += String.Format("Content-Disposition: form-data; name=""{0}""; filename=""{1}""{3}Content-Type: {2}{3}Content-Transfer-Encoding: base64{3}{3}", inputNameElement, ShortName, MimeType, Environment.NewLine)
message += Convert.ToBase64String(GetData())
Return message
End Function
Public Sub New(filename As String, elementName As String)
Me.FileName = filename
Me.ElementName = elementName
End Sub
End Class
Have a small controller class that runs the upload sequence using the BackgroundWorker class, it sends the files per 5 (can be set, is default value).
It requires a FormUrl, to say where the form is that is being posted to, in my case, i was running it on my localhost, so that you would see in the form code
Public Class FileUploader
Inherits BackgroundWorker
Private ReadOnly _listQueue As IList(Of IPostItem) = New List(Of IPostItem)
Public Property FormUrl As String
Public ReadOnly Property ListQueue As IList(Of IPostItem)
Get
Return _listQueue
End Get
End Property
Public Property MaxPerQueue As Integer
Protected Function HandleResponse(request As HttpWebRequest) As Boolean
Dim success As Boolean = False
Try
Using response As HttpWebResponse = CType(request.GetResponse(), HttpWebResponse)
success = response.StatusCode <> HttpStatusCode.OK
End Using
Catch ex As WebException
If ex.Response IsNot Nothing Then
ex.Response.Close()
End If
End Try
Return success
End Function
Protected Sub Run(sender As Object, e As DoWorkEventArgs)
If ListQueue.Count = 0 Then
' nothing to upload
Return
End If
' create the boundary string, used to split between the separate attachments
Dim boundary As String = String.Format("--------------------------{0}", DateTime.Now.Ticks)
Dim count As Integer = 0
Dim totalFiles As Integer = ListQueue.Count
Do
' create the request
Dim request As HttpWebRequest = CType(WebRequest.Create(Me.FormUrl), HttpWebRequest)
Dim fullPostMessage As String = String.Empty
request.AllowAutoRedirect = True
request.KeepAlive = True
request.Referer = Me.FormUrl
''// say that it has to post data
request.Method = WebRequestMethods.Http.Post
''// same style like a form
request.ContentType = "multipart/form-data;boundary=" + boundary
count = 0
Dim queueItem As IPostItem
While count < MaxPerQueue AndAlso ListQueue.Count > 0
''// get the item in the queue
queueItem = ListQueue(0)
''// report potential changes to gui
Report(queueItem.Title, count, totalFiles)
Dim postAsString As String = queueItem.GetPostData(queueItem.ElementName)
fullPostMessage &= String.Format("--{0}{1}{2}{1}", boundary, Environment.NewLine, postAsString)
''// remove the item from the queue
ListQueue.RemoveAt(0)
count += 1
End While
fullPostMessage &= "--" & boundary & "--"
Dim postData As Byte() = System.Text.Encoding.ASCII.GetBytes(fullPostMessage)
''// write data to the requestStream (post data)
request.ContentLength = postData.Length
Dim requestStream As Stream = request.GetRequestStream()
requestStream.Write(postData, 0, postData.Length)
requestStream.Close()
''// handle the response
HandleResponse(request)
requestStream.Dispose()
Loop While ListQueue.Count > 0
ListQueue.Clear()
Report("(Idle)", 0, 100)
End Sub
Protected Sub Report(filename As String, fileIndex As Integer, maxFiles As Integer)
Dim percentage As Integer = (fileIndex * 100) / maxFiles
ReportProgress(percentage, filename)
End Sub
Public Sub New()
Me.WorkerReportsProgress = True
AddHandler Me.DoWork, AddressOf Run
MaxPerQueue = 5
End Sub
End Class
Then you could create your form like this:
And then add the FileUploader class as a private member, so you can get notified when it has completed the upload stream, add the eventhandlers to get notified on the changes
Imports System.ComponentModel
Imports System.Net
Imports System.IO
Public Class Form1
Private fileUploadHandler As New FileUploader()
Private Sub btnUploadFiles_Click(sender As Object, e As EventArgs) Handles btnUploadFiles.Click
fileUploadHandler.FormUrl = "http://localhost:5555/Default.aspx"
Using openDialog As New OpenFileDialog
openDialog.Multiselect = True
openDialog.Title = "Select files to upload to the server"
If openDialog.ShowDialog() Then
' all files are selected
For Each fileName As String In openDialog.FileNames
Dim qItem As IPostItem = New FileQueueItem(fileName, "fileInfo[]")
fileUploadHandler.ListQueue.Add(qItem)
Next
btnUploadFiles.Enabled = False
fileUploadHandler.RunWorkerAsync()
End If
End Using
End Sub
Private Sub OnUploadCompleted(sender As Object, e As RunWorkerCompletedEventArgs)
btnUploadFiles.Enabled = True
End Sub
Private Sub OnReportProgress(sender As Object, e As ProgressChangedEventArgs)
pbUploadProgress.Value = e.ProgressPercentage
lblUploadProgress.Text = e.UserState
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
AddHandler fileUploadHandler.RunWorkerCompleted, AddressOf OnUploadCompleted
AddHandler fileUploadHandler.ProgressChanged, AddressOf OnReportProgress
End Sub
End Class
The files get then uploaded as soon as you click the Open button in the OpenFileDialog.
As to your second question, to allow for more than 1 file selected, you have to set the OpenFileDialog.Multiselect = True flag

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

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

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