Unable to decode serial port data - vb.net

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

Related

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

Invoke part of mainform

I have an application with 8 threads. The main of the app is to display realtime information from 4 outputs and also write the information to a file.
Now, I do not know very much in the domain of multi-threading, but I have succeeded in creating the 4 threads,and if I do not log the info into the rich text boxes, they work ok, they write the info into the files.
My question is: Can I display real time info, from each output on the same form (MainForm)
Outputs work independent one to each other
Below is the code I use to log the info into the richtextbox:
Public Sub LogInBoxOutput2(ByVal [RichTextBox] As RichTextBox, textColor As Color, ByVal [text] As String, Optional logToFile As Boolean = False)
Dim textToWrite As String = "[" & Now.ToString("dd:MM:yyyy HH:mm:ss.fff") & "] - " & [text]
If logNodesValues Then
Me.InvokeIfRequired(Sub()
If textColor = Nothing Then
[RichTextBox].SelectionColor = Color.Black
Else
[RichTextBox].SelectionColor = textColor
End If
[RichTextBox].SelectedText = textToWrite
If scrollToBottom Then
[RichTextBox].Select([RichTextBox].Text.Length - 1, 0)
[RichTextBox].ScrollToCaret()
End If
[RichTextBox].AppendText(vbCrLf)
If logToFile Then
writeToFileQueue2.Enqueue(textToWrite & vbCrLf)
End If
End Sub)
Else
writeToFileQueue2.Enqueue(textToWrite & vbCrLf)
End If
End Sub
<Extension()>
Public Sub InvokeIfRequired(ByVal Control As Control, ByVal Method As Action)
If Control.InvokeRequired Then
Control.Invoke(Method)
Else
Method.Invoke()
End If
End Sub
Do you have any ideas, what could I do? Is there something like in ASP.NET where you could refresh only a frame/part of the page (meaning to invoke only a part of the mainform)?
thank you
Instead of invoking you should queue all the messages to be outputted to the UI as well in order to give the UI and your processor some rest. Then use a System.Windows.Forms.Timer with an Interval of 1 to empty that queue as often as possible (approximately every 50 ms) and write the messages into each RichTextBox.
You can define your own data type that holds the necessary information for each message:
Public Structure OutputMessage
Public Color As Color?
Public Text As String
Public [RichTextBox] As RichTextBox
Public ScrollToBottom As Boolean
Public Sub New(ByVal Text As String, ByVal Color As Color?, ByVal ScrollToBottom As Boolean, ByVal [RichTextBox] As RichTextBox)
Me.Text = Text
Me.Color = Color
Me.ScrollToBottom = ScrollToBottom
Me.RichTextBox = [RichTextBox]
End Sub
End Structure
Then in your form:
Private MessageQueue As New ConcurrentQueue(Of OutputMessage)
Dim WithEvents UpdateTimer As New Timer With {.Interval = 1, .Enabled = True}
Private Sub UpdateTimer_Tick(sender As Object, e As EventArgs) Handles UpdateTimer.Tick
Dim Message As OutputMessage
While MessageQueue.TryDequeue(Message)
PrintMessage(Message)
End While
End Sub
Private Sub PrintMessage(ByVal Message As OutputMessage)
If Not Message.Color.HasValue Then
Message.RichTextBox.SelectionColor = Color.Black
Else
Message.RichTextBox.SelectionColor = Message.Color.Value
End If
Message.RichTextBox.SelectedText = Message.Text
If Message.ScrollToBottom Then
Message.RichTextBox.Select(Message.RichTextBox.Text.Length - 1, 0)
Message.RichTextBox.ScrollToCaret()
End If
Message.RichTextBox.AppendText(vbCrLf)
End Sub
Finally, in your threads:
Public Sub LogInBoxOutput2(ByVal [RichTextBox] As RichTextBox, textColor As Color?, ByVal text As String, Optional logToFile As Boolean = False)
Dim textToWrite As String = "[" & Now.ToString("dd:MM:yyyy HH:mm:ss.fff") & "] - " & text
If logNodeValues Then
MessageQueue.Enqueue(New OutputMessage(textToWrite, textColor, scrollToBottom, [RichTextBox]))
End If
If logToFile Then
writeToFileQueue2.Enqueue(textToWrite & vbCrLf)
End If
End Sub

VB.Net Threading and Addhandler Troubles

Hello again StackOverflow community!
I am working on a class "SendLogfileClass". In this class I send a logfile via email to said email account. That part works as intended. What I am having problems with is trying to process the Async Completion Event. During said event a Addhandler fires and sets a StatusBar.StatusLabel on the main form.
Here are some relevant chunks of code:
#Region "Imports"
Imports System
Imports System.Net
Imports System.Net.Mail
Imports System.Net.Mime
Imports System.Threading
Imports System.ComponentModel
Imports System.IO
#End Region
Public Class Form1
#Region "Public"
Private SendmailThread As Thread
Private MailBody As String = Nothing
#End Region
#Region "Private"
Private mailSent As Boolean = False
#End Region
Public Function GetTimestamp() As String
Dim t As Date = Date.Now
Dim timestamp As String = Nothing
Try
timestamp = t.ToLongTimeString & " " & t.ToLongDateString
Catch ex As Exception
Return 1
End Try
Return timestamp
End Function
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Try
If LoggerClock.Enabled = True Then
OutputConsole.Text = "logger Started: " & GetTimestamp() & vbNewLine
OutputConsole.AppendText("Logfile Opened: " & GetTimestamp() & vbNewLine)
StatusLabel.Text = "Logger Status: Active"
StatusBar.Refresh()
Else
OutputConsole.Text = "logger Started: " & GetTimestamp() & vbNewLine
StatusLabel.Text = "Logger Status: Inactive"
StatusBar.Refresh()
End If
SendlogClock.Enabled = True
ToggleViewForm(1)
Catch ex As Exception
Exit Sub
End Try
End Sub
Public Function SetStatus(ByVal [status] As String) As Integer
Try
Thread.Sleep(1000)
StatusLabel.Text = [status]
StatusBar.Refresh()
Catch ex As Exception
Return 1
End Try
Return 0
End Function
Private Sub SendlogThreadTask()
Try
SendLogfile("user#gmail.com", "Logger Logfile", MailBody).ToString()
Catch ex As Exception
Exit Sub
End Try
End Sub
Private Sub SendlogClock_Tick(sender As Object, e As EventArgs) Handles SendlogClock.Tick
Try
OutputConsole.AppendText("Logfile Closed: " & GetTimestamp() & vbNewLine)
SendmailThread = New Thread(AddressOf SendlogThreadTask)
SendmailThread.IsBackground = True
SendmailThread.Start()
OutputConsole.ResetText()
OutputConsole.Text = "Logfile Opened: " & GetTimestamp() & vbNewLine
Catch ex As Exception
Exit Sub
End Try
End Sub
Public Sub SendCompletedCallback(ByVal sender As Object, ByVal e As AsyncCompletedEventArgs)
Try
' Get the unique identifier for this asynchronous operation.
Dim token As String = CStr(e.UserState)
If e.Cancelled Then
StatusLabel.Text = "Send Canceled... " & token
StatusBar.Refresh()
End If
If e.Error IsNot Nothing Then
StatusLabel.Text = "Error: " & token & " " & e.Error.ToString() & " "
StatusBar.Refresh()
Else
StatusLabel.Text = "Message Sent... "
StatusBar.Refresh()
End If
mailSent = True
Catch ex As Exception
Exit Sub
End Try
End Sub
Public Function SendLogfile(ByVal mailTo As String, ByVal mailSubject As String, ByVal mailBody As String, Optional ByVal doAttach As Boolean = False, Optional ByVal messageAttach As String = Nothing) As Integer
Try
' SMTP Server
Dim SmtpServer As String = "mail.domain.com"
' Command line argument must the the SMTP host.
Dim Cli As New SmtpClient(SmtpServer)
' Specify the e-mail sender.
' Create a mailing address that includes a UTF8 character
' in the display name.
Dim [from] As New MailAddress("logger#domain.com", "logger " & ChrW(&HD8) & " logs", System.Text.Encoding.UTF8)
' Set destinations for the e-mail message.
Dim [to] As New MailAddress(mailTo)
' Specify the message content.
Dim message As New MailMessage([from], [to])
message.Body = mailBody
' Include some non-ASCII characters in body and subject.
Dim someArrows As New String(New Char() {ChrW(&H2190), ChrW(&H2191), ChrW(&H2192), ChrW(&H2193)})
message.Body += Environment.NewLine & someArrows
message.BodyEncoding = System.Text.Encoding.UTF8
message.Subject = mailSubject & someArrows
message.SubjectEncoding = System.Text.Encoding.UTF8
' Put the mail attachment in a list of items
'Dim attachment As New Attachment(messageAttach)
' Attach file.
'If doAttach = True Then
'If File.Exists(messageAttach) Then
'message.Attachments.Add(attachment)
'End If
'End If
' Set the method that is called back when the send operation ends.
AddHandler Cli.SendCompleted, AddressOf SendCompletedCallback
' The userState can be any object that allows your callback
' method to identify this send operation.
' For this example, the userToken is a string constant.
Dim userState As String = "OK"
Cli.SendAsync(message, userState)
'MsgBox("Sending message... press c to cancel mail. Press any other key to exit.")
Dim answer As String = "OK" ' or CANCEL
' If the user canceled the send, and mail hasn't been sent yet,
' then cancel the pending operation.
If answer.StartsWith("C") AndAlso mailSent = False Then
Cli.SendAsyncCancel()
End If
' Clean up.
message.Dispose()
Catch ex As Exception
MsgBox("Encountered Error: " & vbNewLine & vbNewLine & ex.ToString())
Return 1
End Try
Return 0
End Function
End Class
Your event handler is executed on a secondary thread and in that event handler you are referring to the default instance of MainForm. Default instances are thread-specific so that is a different form object to the one you're looking at on-screen.
You can generally use the SynchronizationContext class to enable marshalling a method call to the UI thread but that's not possible in your case because you're actually creating the object on a secondary thread too. In that case, you'll have to pass a reference to the existing MainForm object into that mail sender and use that to marshal a method call to the UI thread using its InvokeRequired and Invoke/BeginInvoke members.

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