VB.Net Threading and Addhandler Troubles - vb.net

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.

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

Need to Send a outlook email from form in VB.net [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 5 years ago.
Improve this question
Being a newbee i can only create a form in Microsoft visual studio. But my requirement is to send a out look mail while all the options should be filled in the form created in VB.net. For eg the to address will be a dropdown list in VB.net form.
Please help with this.
This is a small class that I wrote to do the exact same thing. I looked at examples online and found some very good and bad ones and made this small class. Some of the methods are setup especially for our needs, but you should be able to mould it to your needs.
Public Class Email : Implements IDisposable
Dim _e As String
Dim _item As _MailItem
ReadOnly _oApp = New Microsoft.Office.Interop.Outlook.Application
Sub New()
Try
'Dim oApp As Microsoft.Office.Interop.Outlook._Application
'If Me(Microsoft.Office.Interop.Outlook.Application)
_item = _oApp.CreateItem(OlItemType.olMailItem)
Catch ex As COMException
MessageBox.Show("There was a problem with outlook on this machine.", "No Access to Email", MessageBoxButtons.OK, MessageBoxIcon.Warning)
[Error] = True
End Try
End Sub
Private Property [Error] As Boolean = False
Private Property HasError As Boolean = False
Public Sub AddAttachement(path As String)
'Debug.Print(Path)
_item.Attachments.Add(path)
End Sub
Public Shared Function GetAccountForEmailAddress(ByVal application As Microsoft.Office.Interop.Outlook.Application, ByVal address As String) As Account
' Loop over the Accounts collection of the current Outlook session.
Dim account As Account
For Each account In application.Session.Accounts
' When the e-mail address matches, return the account.
Debug.Print(account.SmtpAddress.ToString)
If account.SmtpAddress = address.ToString Then
Return account
End If
Next
Dim message As String = $"No Account with Address: {address.ToString} exists!" & Environment.NewLine & Environment.NewLine & "Only:" & Environment.NewLine & String.Join(Environment.NewLine, GetAllEmailAccounts(application).ToArray) & Environment.NewLine & "exist on this computer."
Throw New System.Exception(message.ToString)
End Function
Public Shared Function GetAllEmailAccounts(ByVal application As Microsoft.Office.Interop.Outlook.Application) As ArrayList
' Loop over the Accounts collection of the current Outlook session.
Try
Dim acc As New ArrayList()
Dim account As Account
For Each account In application.Session.Accounts
acc.Add(account.SmtpAddress.ToString)
Next
Return acc
Catch ex As System.Exception
MyError(ex)
Return Nothing
End Try
End Function
Public Sub Send()
Try
If HasError = False Then
_item.Send()
If ShowNotification = True Then
MessageBox.Show("Email successfully sent to: " & Environment.NewLine & _e.ToString, "Success", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End If
Catch ex As System.Exception
MyError(ex)
Finally
End Try
End Sub
Public Sub SentTo(emailAddress As String)
For Each add In emailAddress.Split(";")
'Debug.Print(RemoveWhitespace(add))
_item.Recipients.Add(RemoveWhitespace(add))
Next
If Not _item.Recipients.ResolveAll Then
HasError = True
Throw New System.Exception("Could send email to the following addresses: " & Environment.NewLine & emailAddress.ToString)
Else
_e = emailAddress
End If
End Sub
Public Function SetupEmail(subject As String, htmlBody As String, sendUsing As String) As Boolean
'Dim defaultFolder As MAPIFolder = _oApp.Session.GetDefaultFolder(OlDefaultFolders.olFolderDrafts)
Dim html = "<html><div style="" font-size:" & FontSize & "px;font-family:" & FontFamily & ";"">"
html = html & htmlBody
Try
'item = DirectCast(Outlook.Application.CreateItem(OlItemType.olMailItem), Outlook.MailItem)
Dim account As Account = GetAccountForEmailAddress(_oApp, sendUsing)
'item = DirectCast(oApp.CreateItem(Outlook.OlItemType.olMailItem), Outlook.MailItem)
'item.Recipients.Add(EmailAddress)
_item.Subject = "--- Digital Certificate Attached ---"
_item.SendUsingAccount = account
_item.Subject = subject.ToString
_item.SendUsingAccount = account
_item.BodyFormat = OlBodyFormat.olFormatHTML
_item.HTMLBody = String.Empty
_item.HTMLBody = html
_item.BodyFormat = OlBodyFormat.olFormatHTML
Return True
Catch exception1 As System.Exception
HasError = True
MyError(exception1)
Return False
End Try
End Function
Public Property FontFamily As String = "Tahoma"
Public Property FontSize As Integer = 12
Public ReadOnly Property HasErrrors As Boolean
Get
Return HasError
End Get
End Property
Public Property ShowNotification As Boolean
Get
Return _ShowNotification
End Get
Set(value As Boolean)
_ShowNotification = value
End Set
End Property
Private Property _ShowNotification As Boolean = True
Private _disposedValue As Boolean ' To detect redundant calls
' IDisposable
Protected Overridable Sub Dispose(disposing As Boolean)
If Not _disposedValue Then
If disposing Then
' TODO: dispose managed state (managed objects).
If _oApp IsNot Nothing Then
'Debug.Print("oWord has value")
Marshal.ReleaseComObject(_oApp)
End If
If _item IsNot Nothing Then
'Debug.Print("oWord has value")
Marshal.ReleaseComObject(_item)
End If
End If
End If
_disposedValue = True
End Sub
Public Sub Dispose() Implements IDisposable.Dispose
' Do not change this code. Put cleanup code in Dispose(disposing As Boolean) above.
Dispose(True)
End Sub
End Class
I use it the following way:
Using myemail As New <ClassName>.Email
myemail.SentTo(emailaddress)
myemail.AddAttachement(attachment)
If myemail.SetupEmail(EmailBody, Subject, SendingEmail) = True Then
myemail.Send()
End If
End Using

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

Finding an error in a function in VB

I am trying to call a function in one class from another on a Timer.Elapsed. I can call test functions just fine, but when I call the actual function I want, I get no exceptions, but the function just doesn't run. I have tried adding in some error handling (Catch ex) and outputting frequent messages to a .txt file to see where it fails, but I am not getting any of these messages in my log when I know that the function I am using to write these messages to the log is working.
How can I find where my function contains an error if I have no access to error messages?
Adding my code below - this is my write to log function.
Public Shared Function Output_To_Log(ByVal message As String) As String
Dim strDate As String = Now.ToString("dd MMM yy HH:mm:ss ")
Dim strTodayDate As String = Now.ToString("yyyyMMMdd")
Dim file As New FileStream("C:\PHJones_Windows_Service\logs\Log" & strTodayDate & ".txt", FileMode.Append, FileAccess.Write)
Dim stream As New StreamWriter(file)
stream.WriteLine(message & " : " & strDate)
stream.Close()
Return ""
End Function
This is my Timer elapsed function.
Private Shared Sub Timer1_Elapsed(ByVal sender As System.Object, ByVal e As System.Timers.ElapsedEventArgs) Handles Timer1.Elapsed
Output_To_Log("Working")
PHJones.Start_Batch()
End Sub
This is my Start_Batch function, with references to my server blanked out with ****
Public Shared Function Start_Batch() As Integer
Try
Dim a As New running_check
a.check = 1
Dim files As String()
Dim File As String
Dim myProcess As New Diagnostics.Process()
Dim File_Name As String
Dim Running_FileName As String
RunTimer.Output_To_Log("Start_Batch starting")
Start:
RunTimer.Output_To_Log("Checking logs")
Dim log_check As Integer = check_logs()
RunTimer.Output_To_Log("Getting .DAT files.")
files = IO.Directory.GetFiles("****\phjones\to_phjones\", "*.DAT")
If files.Count > 0 Then
RunTimer.Output_To_Log("Counted " & files.Count & " files.")
Else
RunTimer.Output_To_Log("No files found.")
End If
For Each File In files
Try
RunTimer.Output_To_Log("Starting process for " & File)
Running_FileName = File & ".BAT"
RunTimer.Output_To_Log("Processing " & Running_FileName)
File_Name = File.Substring(26)
If System.IO.File.Exists("C:\PHJones_Windows_Service\Batch_Files\" & File_Name & ".BAT") Then
RunTimer.Output_To_Log("C:\PHJones_Windows_Service\Batch_Files\" & File_Name & ".BAT already exists")
Else
RunTimer.Output_To_Log("Copying " & Running_FileName & " to batch_files folder")
System.IO.File.Copy(Running_FileName, "C:\PHJones_Windows_Service\Batch_Files\" & File_Name & ".BAT", True)
End If
If (System.IO.File.Exists("C:\PHJones_Windows_Service\Batch_Files\" & File_Name & ".BAT")) Then
If (System.IO.File.Exists(Running_FileName)) Then
RunTimer.Output_To_Log("Deleting file " & Running_FileName)
System.IO.File.Delete(Running_FileName)
Else
RunTimer.Output_To_Log(File_Name & ".BAT does not exist in ****\phjones\to_phjones\processed")
End If
Else
RunTimer.Output_To_Log(File_Name & ".BAT failed to copy")
Throw New Exception(File_Name & ".BAT failed to copy to C:\PHJones_Windows_Service\Batch_Files")
End If
RunTimer.Output_To_Log("Executing batch file " & Running_FileName)
myProcess.StartInfo.UseShellExecute = True
myProcess.StartInfo.FileName = "C:\PHJones_Windows_Service\Batch_Files\" & File_Name & ".BAT"
myProcess.StartInfo.CreateNoWindow = False
myProcess.Start()
myProcess.WaitForExit()
If System.IO.File.Exists("****\phjones\to_phjones\" & File_Name) Then
RunTimer.Output_To_Log("****\phjones\to_phjones\" & File_Name & " already exists")
System.IO.File.Delete(File)
RunTimer.Output_To_Log(File & " has been deleted")
Else
RunTimer.Output_To_Log("Moving " & File)
System.IO.File.Move(File, "****\phjones\to_phjones\" & File_Name)
End If
Dim IWCnn = New OracleConnection(ConfigurationManager.ConnectionStrings("myConnectionString").ConnectionString)
Dim intRepair_Id As Integer = Mid(File_Name, 1, 7)
Dim intRepair_seq As Integer = Mid(File_Name, 8, 1)
RunTimer.Output_To_Log("Updating database for file " & File)
IWCnn.Open()
Dim StatusCmd As New OracleCommand("update works_orders " & _
"set wor_sco_code = 'ISS', wor_issued_datetime = sysdate" & _
" where wor_srq_no = " & intRepair_Id & _
" and wor_seqno = " & intRepair_seq, IWCnn)
StatusCmd.ExecuteNonQuery()
IWCnn.Close()
Catch ex As Exception
RunTimer.Timer1.Enabled = False
RunTimer.Output_To_Log("Exception thrown in PHJones 2010 - " & ex.Message)
Thread.Sleep(900000)
RunTimer.Timer1.Enabled = True
a.check = 0
Return 0
End Try
Next
a.check = 0
Catch ex As Exception
RunTimer.Output_To_Log("Exception thrown in PHJones 2010 - " & ex.Message)
End Try
Return 0
End Function
The entire RunTimer class.
Imports System.Configuration.ConfigurationSettings
Imports System.Data
Imports System.IO
Imports System.Diagnostics
Imports System
Imports System.Timers
Imports System.Threading
Imports System.ServiceProcess
Imports System.Configuration.Install
Public Class RunTimer
Inherits System.ServiceProcess.ServiceBase
Friend Shared WithEvents Timer1 As System.Timers.Timer
Public Counter As Integer = 0
Public Sub New()
MyBase.New()
InitializeComponents()
End Sub
Private Sub InitializeComponents()
Me.ServiceName = "RunTimer"
Me.AutoLog = True
Me.CanStop = True
Timer1 = New System.Timers.Timer()
Timer1.Interval = 15000
Timer1.Enabled = True
End Sub
' This method starts the service.
<MTAThread()> Shared Sub Main()
' To run more than one service you have to add them to the array
System.ServiceProcess.ServiceBase.Run(New System.ServiceProcess.ServiceBase() {New RunTimer})
End Sub
' Clean up any resources being used.
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
MyBase.Dispose(disposing)
' TODO: Add cleanup code here (if required)
End Sub
Protected Overrides Sub OnStart(ByVal args() As String)
' TODO: Add start code here (if required) to start your service.
Timer1.Enabled = True
End Sub
Protected Overrides Sub OnStop()
' TODO: Add tear-down code here (if required) to stop your service.
Timer1.Enabled = False
Output_To_Log("Ended")
End Sub
Private Sub InitializeComponent()
Timer1 = New System.Timers.Timer
CType(Timer1, System.ComponentModel.ISupportInitialize).BeginInit()
Timer1.Enabled = True
CType(Timer1, System.ComponentModel.ISupportInitialize).EndInit()
End Sub
Private Shared Sub Timer1_Elapsed(ByVal sender As System.Object, ByVal e As System.Timers.ElapsedEventArgs) Handles Timer1.Elapsed
Output_To_Log("Working")
PHJones.Start_Batch()
End Sub
Since you're running as a service, you won't see ordinary error messages. It's possible there is an error between Output_To_Log("Working") in the Timer event and RunTimer.Output_To_Log("Start_Batch starting") of Start_Batch(). For example, if an error could occur in the initialization of Dim a As New running_check, or in the call itself, PHJones.Start_Batch(). Either of these would cause what you're seeing.