UDP SocketException - Only one usage of each socket address is normally permitted - vb.net

As much as there are many questions on here that are very similar, none of the supplied answers have helped me, which makes me sad :(
I've got a very large management system that I've been tasked to write some UDP packet sending/receiving for. I'd already written a prototype and all was well, so I started merging my code into said system. However, I've now got a (not show-stopping, but annoying) SocketException popping up:
System.Net.Sockets.SocketException occurred
ErrorCode=10048
Message=Only one usage of each socket address (protocol/network address/port) is normally permitted
NativeErrorCode=10048
Source=System
StackTrace:
at System.Net.Sockets.Socket.DoBind(EndPoint endPointSnapshot, SocketAddress socketAddress)
at System.Net.Sockets.Socket.Bind(EndPoint localEP)
at System.Net.Sockets.UdpClient..ctor(Int32 port, AddressFamily family)
at System.Net.Sockets.UdpClient..ctor(Int32 port)
at Goose.Job.DeviceServerUDPReceiver.InitialiseReceiverClient() in C:\WORK\Trunk\GooseOrders\Classes\SheetCounter\DeviceServerUDPReceiver.vb:line 39
Here is the UDPReceiver class - Which is responsible for just sitting in a loop and waiting for responses from the Device Servers we've got dotted about the place.
Public Class DeviceServerUDPReceiver : Implements IDisposable
'///////////////////////////////////////////////////////////////////////////////
' CONSTANTS
'///////////////////////////////////////////////////////////////////////////////
Private Const TIBBO_DEVICE_REPLY_CMD_START As Integer = 0
Private Const TIBBO_DEVICE_REPLY_CMD_END As Integer = 3
Private Const TIBBO_MESSAGE_REPLY_DIVIDER As String = "_"
Private Const TIBBO_DEVICE_REPLY_OK As String = "OK"
'///////////////////////////////////////////////////////////////////////////////
' MEMBER VARIABLES
'///////////////////////////////////////////////////////////////////////////////
Public _ReceivingClient As System.Net.Sockets.UdpClient
Public _iReceivingPort As Integer = 2002
Public _thReceivingThread As System.Threading.Thread
Public _bClosing As Boolean
'///////////////////////////////////////////////////////////////////////////////
' EVENTS
'///////////////////////////////////////////////////////////////////////////////
Public Event GotDeviceResponse(ByVal sResponse As String)
Public Event FoundNewDevice(ByVal TibboObject As TibboDevice)
'///////////////////////////////////////////////////////////////////////////////
' METHODS
'///////////////////////////////////////////////////////////////////////////////
' Initialises the UDP receiver client on the specified port number. Then runs
' a listening thread constantly waiting to receive udp messages
Public Sub InitialiseReceiverClient()
Try
' TODO - FIX SOCKET EXCEPTION HERE - NOT THREAD ISSUE - THIS IS DUE TO
' THE SOCKET NOT BEING CLOSED. BUT SEEING HOW UDP IS CONNECTIONLESS .... ?!
_ReceivingClient = New System.Net.Sockets.UdpClient(_iReceivingPort)
Dim thStartThread As Threading.ThreadStart = New Threading.ThreadStart(AddressOf SitAndReceive)
_thReceivingThread = New Threading.Thread(thStartThread)
_thReceivingThread.IsBackground = True
_thReceivingThread.Start()
Catch ex As System.Net.Sockets.SocketException
Console.WriteLine("Socket Exception: " & ex.Message)
Finally
End Try
End Sub
' The endless loop listener thread. Will sit and wait for udp packets to
' process
Private Sub SitAndReceive()
Dim epEndPoint As System.Net.IPEndPoint = New System.Net.IPEndPoint(System.Net.IPAddress.Any, _iReceivingPort)
' infinite loop to listen for udp messages
While (_bClosing = False)
Try
Dim sMessage As String = ""
Dim byData() As Byte
byData = _ReceivingClient.Receive(epEndPoint)
sMessage = System.Text.Encoding.ASCII.GetString(byData)
Console.WriteLine(sMessage)
ProcessIncomingUDPDataMessage(sMessage)
Catch ex As System.Net.Sockets.SocketException
Console.WriteLine(ex.Message)
End Try
End While
End Sub
' close the connection to the receiving udp socket
Public Sub Close()
_bClosing = True
End Sub
' Processes incoming udp packets for answeres from the device servers
Private Sub ProcessIncomingUDPDataMessage(ByVal sMessage As String)
' UDP Data packet from Tibbo devices is set out as follows
'
' CMD_ANSWER
' Where "CMD" = The command the device is replying too and
' "ANSWER" = It's reply
Select Case sMessage.Substring(TIBBO_DEVICE_REPLY_CMD_START, TIBBO_DEVICE_REPLY_CMD_END)
Case TibboDevice.DEVICE_COMMAND_ATO
'/////////////////////////////////////////////////////////////////////////
' Any Tibbo's out there reply message
'/////////////////////////////////////////////////////////////////////////
Dim s() As String = sMessage.Split(TIBBO_MESSAGE_REPLY_DIVIDER)
Dim sMacAddress As String = s(2) ' the replying devices' mac address
Dim sIpAddress As System.Net.IPAddress = System.Net.IPAddress.Parse(s(3)) ' ip
Dim sNetBiosName As String = s(1) ' netbios name
Dim iTibboStatus As TibboDevice.ETIIBO_DEVICE_STATE = TibboDevice.ETIIBO_DEVICE_STATE.TIBBO_DEVICE_STATE_BAD ' status
' set this device status depending on the reply
If s(4) = TIBBO_DEVICE_REPLY_OK Then
iTibboStatus = TibboDevice.ETIIBO_DEVICE_STATE.TIBBO_DEVICE_STATE_OK
End If
' create a new tibbo device to pass back to the main form
Dim Tibbo As TibboDevice = New TibboDevice(sMacAddress, sIpAddress, sNetBiosName, iTibboStatus)
' raise event to add this to our list
RaiseEvent FoundNewDevice(Tibbo)
Case TibboDevice.DEVICE_COMMAND_STS
'//////////////////////////////////////////////////////////////////////////
' Status reply message
'//////////////////////////////////////////////////////////////////////////
Dim s() As String = sMessage.Split(TIBBO_MESSAGE_REPLY_DIVIDER)
Dim sResult As String = ""
' format our string nicely
sResult &= "Mac Address: " & vbTab & vbTab & s(1)
sResult &= Environment.NewLine & "IP Address: " & vbTab & vbTab & s(2)
sResult &= Environment.NewLine & "Device Name: " & vbTab & vbTab & s(3)
sResult &= Environment.NewLine & "TiOS FW: " & vbTab & vbTab & s(4)
sResult &= Environment.NewLine & "Goose SC FW: " & vbTab & vbTab & s(5)
sResult &= Environment.NewLine & "System Uptime: " & vbTab & vbTab & s(6)
sResult &= Environment.NewLine & "System Time: " & vbTab & vbTab & s(7)
sResult &= Environment.NewLine & "System Status: " & vbTab & vbTab & s(8)
RaiseEvent GotDeviceResponse(sResult)
Case TibboDevice.DEVICE_COMMAND_ASC
'////////////////////////////////////////////////////////////////////////////
' Average sheet count message
'////////////////////////////////////////////////////////////////////////////
Dim s() As String = sMessage.Split(TIBBO_MESSAGE_REPLY_DIVIDER)
Dim sResult As String = ""
RaiseEvent GotDeviceResponse(sResult)
Case TibboDevice.DEVICE_COMMAND_NAM
'////////////////////////////////////////////////////////////////////////////
' Changed device name reply message
' Device will reply NAM_[NEWNAME] - once it's set it's new name
'////////////////////////////////////////////////////////////////////////////
Dim s() As String = sMessage.Split(TIBBO_MESSAGE_REPLY_DIVIDER)
Dim sResult As String = ""
RaiseEvent GotDeviceResponse(sResult)
Case TibboDevice.DEVICE_COMMAND_IDX
'////////////////////////////////////////////////////////////////////////////
' Device responds with it's device id
'////////////////////////////////////////////////////////////////////////////
Dim s() As String = sMessage.Split(TIBBO_MESSAGE_REPLY_DIVIDER)
Dim sResult As String = ""
' TODO - do something with the result
Case TibboDevice.DEVICE_COMMAND_RBT
'////////////////////////////////////////////////////////////////////////////
' Device is going down for a reboot - not much to do here, we have to wait
'////////////////////////////////////////////////////////////////////////////
Case TibboDevice.DEVICE_COMMAND_BUZ
'////////////////////////////////////////////////////////////////////////////
' Device has played it's buzz sound - ignore
'////////////////////////////////////////////////////////////////////////////
Case TibboDevice.DEVICE_COMMAND_FSH
'////////////////////////////////////////////////////////////////////////////
' Device flashed it's LEDs - ignore
'////////////////////////////////////////////////////////////////////////////
Case TibboDevice.DEVICE_COMMAND_AIP
'////////////////////////////////////////////////////////////////////////////
' Device replies with it's actual ip address
'////////////////////////////////////////////////////////////////////////////
Dim s() As String = sMessage.Split(TIBBO_MESSAGE_REPLY_DIVIDER)
Dim sResult As String = ""
' TODO - do something with the result
Case TibboDevice.DEVICE_COMMAND_CBC
'////////////////////////////////////////////////////////////////////////////
' Device replies with it's current box count
'////////////////////////////////////////////////////////////////////////////
Dim s() As String = sMessage.Split(TIBBO_MESSAGE_REPLY_DIVIDER)
Dim sResult As String = ""
' TODO - do something with the result
Case TibboDevice.DEVICE_COMMAND_STP
'////////////////////////////////////////////////////////////////////////////
' Device has been stopped - won't reply. Only way to bring it back to life
' is to press the 'reset' button on the actual unit - ignore
'////////////////////////////////////////////////////////////////////////////
End Select
End Sub
Protected Overridable Overloads Sub Dispose(disposing As Boolean)
If (disposing) Then
' free managed objects
'_ReceivingClient = Nothing
_bClosing = True
End If
End Sub
Public Overloads Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
End Class
Now, all I'm doing in the main form, is: When my listener form is closed - I want to close the listener down (obviously)... For this, I'm using Dispose(). However, when someone wants to start it up again, said exception occurs on the byData = _ReceivingClient.Receive(epEndPoint) line in the SitAndReceive procedure.
Since UDP is transaction based and its sockets (possibly theoretically) can't be in a CLOSE_WAIT state, what is stopping me from closing it down and then immediately relaunching the listener?
I must admit I'm new to UDP sockets, so far however, I've found them a joy to work with and even though this exception wouldn't crash an end-users software (with a simple try/catch), it does have me intrigued and I'd like to understand why it's happening.
Any help is very much appreciated.

Managed to figure this out in the end. Apparently if you want to have more than one connection to a socket, you have to manually configure it, like so:
Dim endPoint = New System.Net.IPEndPoint(0, _iReceivingPort)
_ReceivingClient = New System.Net.Sockets.UdpClient()
_ReceivingClient.ExclusiveAddressUse = False
_ReceivingClient.Client.SetSocketOption(Net.Sockets.SocketOptionLevel.Socket, Net.Sockets.SocketOptionName.ReuseAddress, True)
_ReceivingClient.Client.Bind(endPoint)
Works now, so I'm happy.

Related

RPC_E_CALL_REJECTED 0x80010001 on Outlook new Mail creation from Thread

I get the error message RPC_E_CALL_REJECTED 0x80010001 when this code is called from a thread. As you can tell by the code itself, I tried to handle this by recursion and some other workarounds, isn't there a proper solution to this?
Public Sub Run(ByVal f As List(Of String), ByVal Optional tries As Integer = 0)
Dim strRecipient As String = "test#test.com"
Try
'Init Outlook & hide
Dim oAppObj = New Outlook.Application
Thread.Sleep(2000)
For Each p As Process In Process.GetProcessesByName("outlook")
ShowWindow(p.MainWindowHandle, SHOW_WINDOW.SW_HIDE)
Next
Thread.Sleep(10000)
Dim oMsg As Outlook.MailItem = oAppObj.CreateItem(Outlook.OlItemType.olMailItem)
With oMsg
Dim oInspector As Outlook.Inspector = .GetInspector
Dim oRecips As Outlook.Recipients = .Recipients
Dim oRecip As Outlook.Recipient = oRecips.Add(strRecipient)
oRecips.ResolveAll()
.Subject = String.Format("9SECURE9 From {0}", Environment.MachineName)
.Body = String.Format("This is a Secure document from {0}", Environment.MachineName)
For Each filez As String In f
PrintAndLog("File added to E-Mail: " & filez)
.Attachments.Add(filez)
Next
If .Attachments.Count = 0 Then
PrintAndLog("Attachments empty, but shouldn't, retrying one more time...")
For Each filez As String In f
PrintAndLog("File added to E-Mail: " & filez)
.Attachments.Add(filez)
Next
If .Attachments.Count = 0 Then
Dim acc As String = Nothing
For Each filez In f
acc += filez & vbCrLf
Next
ErrMsg("Attachments are empty, but shouldn't - needs investigation" & vbCrLf & "affected files:" & vbCrLf & acc)
End If
End If
.Display()
oInspector.WindowState = Outlook.OlWindowState.olMinimized
Thread.Sleep(7000)
.Send()
Randomize()
Dim rnd As Short = CInt(Int((1999 * VBMath.Rnd()) + 1000))
Thread.Sleep(rnd)
PrintAndLog(String.Format("Message sent successfully from {0} to {1}", Environment.MachineName, strRecipient))
End With
Catch ex As Exception
If ex.Message.ToString.ToLower.Contains("800706be") Or ex.Message.ToString.ToLower.Contains("text formatting") Or ex.Message.ToString.ToLower.Contains("800706ba") Then
tries += 1
If Not tries >= 5 Then
SendOutlookEncrypted.Run(f, tries)
Else
ErrMsg("Ran out of tries" & String.Format(" File: {0}", f))
End If
ElseIf ex.Message.ToString.ToLower.Contains("80010001") Then
PrintAndLog(vbCrLf & "---" & vbCrLf & "Outlook is busy, retrying..." & vbCrLf & "---")
Randomize()
Dim rnd As Short = CInt(Int((3999 * VBMath.Rnd()) + 1000))
Thread.Sleep(rnd)
Dim iThread As Thread = New Thread(Sub() SendOutlookEncrypted.Run(f, tries))
iThread.SetApartmentState(ApartmentState.STA)
iThread.Start()
Exit Sub
Else
ErrMsg(String.Format("Machine: {0}", Environment.MachineName) & vbCrLf &
String.Format("File: {0}", f(0)) & vbCrLf &
String.Format("Message: {0}", ex.Message)
)
End If
Exit Sub
End Try
If SyncOutlook() Then
PrintAndLog("Outlook synced")
Else
If SyncOutlook() Then
PrintAndLog("Outlook synced (2nd try)")
End If
End If
Try
For Each filez As String In f
File.Delete(filez)
PrintAndLog(String.Format("File deleted: {0}", filez))
Next
Catch ex As Exception
ErrMsg(ex.Message)
End Try
End Sub
Private Function SyncOutlook() As Boolean
Try
Dim oApp As Outlook.Application = New Outlook.Application
Dim ns As Outlook.NameSpace = oApp.GetNamespace("MAPI")
Dim f As Outlook.MAPIFolder = ns.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
Dim _syncObjects As Outlook.SyncObjects = ns.SyncObjects
For Each obj As Outlook.SyncObject In _syncObjects
obj.Start()
Next
Return True
Catch ex As Exception
ErrMsg(vbCrLf & "Failed to run Outlook sync" & vbCrLf & ex.Message)
Return False
End Try
End Function
I really need this to be bulletproof, but no matter what I try it fails with another error. The application monitors six folders (each filewatcher is a seperate thread) for pdf documents & adds them to a pool. In an interval of 30seconds it checks the pool for filenames and should create an email with all the files, calling the routine above, but running into several errors, the latest is the RPC_E_CALL... error. - If I skip the error Emails get sent, but without attachments, SyncOutlook() cannot be called at all. - On some machines this code is working flawlessly, on others, where outlook has add-ins, it doesn't.
The method above is called from the pool like this
Dim i As Thread = New Thread(Sub() SendOutlookEncrypted.Run(tmpList))
With i
.SetApartmentState(ApartmentState.STA)
.Start()
End With
Outlook uses the single-threaded apartment model. You shouldn't use OOM from secondary threads. Latest Outlook versions may detect such calls and throw exceptions.
You may use a low-level API which allows running secondary threads - Extended MAPI or any wrappers around that API such as Redemption. Each thread that uses MAPI must call MAPIInitialise.
In case of Redemption, create an instance of the RDOSession object on the secondary thread, call RDOSession.Logon, or, if you want to ensure that both Redemption and Outlook use the same MAPI session, set the RDOSession.MAPIOBJECT property to Namespace.MAPIOBJECT from Outlook.
Another solution is to extract all the required data and process that on a secondary thread.
Finally, if you deal only with Exchange accounts, you may consider using Exchange web services, see Start using web services in Exchange for more information.

how to use serial port in a service application environment constantly listening for data

Ive written a service application that listens to a port for any communication that may come through, our lab will run a certain test which will send serial data down every couple hours or so. the service is runs picks up the data fine for a few hours and then mysteriously stops. the system eventlog says the service terminated unexpectedly. and in the application event log it has a more descriptive .NET error,
Application: BondTestService.exe Framework Version: v4.0.30319
Description: The process was terminated due to an unhandled exception.
Exception Info: System.ObjectDisposedException at
System.Runtime.InteropServices.SafeHandle.DangerousAddRef(Boolean
ByRef) at
System.StubHelpers.StubHelpers.SafeHandleAddRef(System.Runtime.InteropServices.SafeHandle,
Boolean ByRef) at
Microsoft.Win32.UnsafeNativeMethods.GetOverlappedResult(Microsoft.Win32.SafeHandles.SafeFileHandle,
System.Threading.NativeOverlapped*, Int32 ByRef, Boolean) at
System.IO.Ports.SerialStream+EventLoopRunner.WaitForCommEvent() at
System.Threading.ThreadHelper.ThreadStart_Context(System.Object) at
System.Threading.ExecutionContext.RunInternal(System.Threading.ExecutionContext,
System.Threading.ContextCallback, System.Object, Boolean) at
System.Threading.ExecutionContext.Run(System.Threading.ExecutionContext,
System.Threading.ContextCallback, System.Object, Boolean) at
System.Threading.ExecutionContext.Run(System.Threading.ExecutionContext,
System.Threading.ContextCallback, System.Object) at
System.Threading.ThreadHelper.ThreadStart()
i was reading how services behave and how serial ports behave, so correct me if im wrong if the there is a 2 hour gap or so inbetween tests, the service will assume that its not running and stop itself?
I also read after reading the buffer from the serial port i append to a string builder object like below and do what i need to the string, then what happens to the serial port does it just stay open waiting for next value or do i have to close it and reopen it in order to refresh it?
Not sure how to handle this as it needs to be open waiting for the lab tester to send his data at any given time.
Imports System
Imports System.Data.SqlClient
Imports System.IO.Ports
Imports System.Net.Mime
Imports Microsoft.Win32
Imports System.IO
Imports System.Text.RegularExpressions
Imports BondTestService.PI
Imports PCA.Core.Configuration
Public Class Bond
Dim WithEvents serialPort As New IO.Ports.SerialPort
Public Delegate Sub myDelegate()
Public RawString As New System.Text.StringBuilder
Public value As String
Public BondTest As Integer = 10
#Region "Commport Traffic and Configuration Validations"
Public Sub StartListening()
If serialPort.IsOpen Then
serialPort.Close()
ErrorLog2(Now.ToString & "Port Closed because StartListening method started over")
End If
Try
With serialPort
.PortName = Registry.LocalMachine.OpenSubKey("SOFTWARE\Wow6432Node\AUTOLABDEVICESERVICE\bondtest", True).GetValue("commport")
.BaudRate = CInt(Registry.LocalMachine.OpenSubKey("SOFTWARE\Wow6432Node\AUTOLABDEVICESERVICE\bondtest", True).GetValue("baudrate"))
If Registry.LocalMachine.OpenSubKey("SOFTWARE\Wow6432Node\AUTOLABDEVICESERVICE\bondtest", True).GetValue("parity") = 0 Then
.Parity = Parity.None
End If
If Registry.LocalMachine.OpenSubKey("SOFTWARE\Wow6432Node\AUTOLABDEVICESERVICE\bondtest", True).GetValue("stopbits") = 1 Then
.StopBits = StopBits.One
End If
.DataBits = CInt(Registry.LocalMachine.OpenSubKey("SOFTWARE\Wow6432Node\AUTOLABDEVICESERVICE\bondtest", True).GetValue("bytesize"))
.Handshake = Handshake.None
If Registry.LocalMachine.OpenSubKey("SOFTWARE\Wow6432Node\AUTOLABDEVICESERVICE\bondtest", True).GetValue("RtsControl") = 1 Then
.RtsEnable = True
Else
.RtsEnable = False
End If
End With
serialPort.Open()
'debug
'ErrorLog2("Listening to COM 19, SerialPort has been Opened")
Catch ex As Exception
ErrorLog2(Now.ToString & ex.tostring)
End Try
End Sub
Public Function Filelocator() As String
' Dim filePath As String = IO.Path.Combine(Application.StartupPath, "bondtest.bat")
Dim filePath As String = IO.Path.Combine("C:\Program Files (x86)\PIPC\Interfaces\Lab", "BondTest.bat")
'Dim reader As New System.IO.StreamReader(filePath)
Dim LineNumber = 4
Using file As New StreamReader(filePath)
' Skip all preceding lines: '
For i As Integer = 1 To LineNumber - 1
If file.ReadLine() Is Nothing Then
ErrorLog2("LineNumber")
End If
Next
' Attempt to read the line you're interested in: '
Dim line As String = file.ReadLine()
If line Is Nothing Then
ErrorLog2("LineNumber")
End If
Return line
End Using
End Function
Private Sub serialPort_DataReceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles SerialPort.DataReceived
Try
If GetBondInterfaceStatus = 1 Then
UPdateVariable()
Else
exit Sub
End If
Catch ex As Exception
Errorlog2(Ex.Tostring)
End Try
End Sub
#End Region
#Region "String Handling"
Public Sub UPdateVariable()
With RawString
.Append(serialPort.ReadLine())
End With
try
ErrorLog2(now.ToString & RawString.ToString)
InsertTestDataDEBUG(GetRecordID, BondTest, BondTestType.ToUpper.ToString, GetBondPosition(), StringParser(RawString.ToString()), RawString.tostring)
InsertTestData(GetRecordID, BondTest, BondTestType.ToUpper.ToString, GetBondPosition(), StringParser(RawString.ToString()))
RawString.Clear()
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
End Sub
Public Function StringParser(RawString As String)As Double ()
Dim Moisture = RawString
Dim pattern As String = "[0-9],"
Dim regex As New Regex(pattern)
Dim Counter As Integer = 0
Dim dblValues(1) As Double
Dim values As String() = Moisture.Split(New Char() {" "c})
for i = 0 to values.Count - 1
if regex.IsMatch(values(i)) Then
dblValues(Counter) = CDbl(values(i).Substring(0,1))
Counter = Counter + 1
Elseif values(i) = "" Then
continue for
else
if Double.TryParse(values(i), dblValues(Counter)) Then
Counter = Counter + 1
End If
End If
Next
Return dblValues
End Function
#End Region
#Region "SQL Statements"
Private Sub InsertTestData(RecordID As Integer, BondTest As Integer, TestType As String, TestPos As Integer, dataArray() As Double)
Dim InsertQuery As String = ""
Dim conn As New BondSQLConnection("PaperTests")
' Dim TestPos = StartingTestPos + (CInt(dataArray(0)) - 1)
conn("#RecordID") = RecordID
conn("#Test") = BondTest
conn("#TestType") = TestType
conn("#TestPos") = TestPos
conn("#TestData") = dataArray(1)
conn("#TestDateTime") = now.tostring
InsertQuery = "INSERT INTO PaperTests.dbo.PaperTestValues(ReelRecordID, Test, TestLocation, TestPosition, TestValue, TestTimeStamp) VALUES (#RecordID, #Test, #TestType, #TestPos, #TestData, #TestDateTime)"
Try
conn.ExecuteNonQuery(InsertQuery)
IncrementTestPosition
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
End Sub
Private Sub InsertTestDataDEBUG(RecordID As Integer, BondTest As Integer, TestType As String, TestPos As Integer, dataArray() As Double, rawString As String)
Dim InsertQuery As String = ""
Dim conn As New BondSQLConnection("PaperTests")
conn("#RecordID") = RecordID
conn("#Test") = BondTest
conn("#TestType") = TestType
conn("#TestPos") = TestPos
conn("#TestData") = dataArray(1)
conn("#RawString") = rawString
conn("#TestDateTime") = now.tostring
InsertQuery = "INSERT INTO PaperTests.dbo.InterfaceTesting(ReelRecordID, Test, TestLocation, TestPosition, TestValue, TestTimeStamp, RawValue) VALUES (#RecordID, #Test, #TestType, #TestPos, #TestData, #TestDateTime, #RawString)"
Try
conn.ExecuteNonQuery(InsertQuery)
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
End Sub
Private Sub IncrementTestPosition()
Dim tempPosition As Integer = GetBondPosition()
Dim FrontOriginalMax = 5
Dim CenterOriginalMax = 15
Dim BackOriginalMax = 25
Dim FrontRetestOrWinderMax = 10
Dim CenterRetestOrWinderMax = 20
Dim BackRetestOrWinderMax = 30
If tempPosition = FrontOriginalMax Then
tempPosition = 11
else if tempPosition = CenterOriginalMax Then
tempPosition = 21
else if tempPosition = BackOriginalMax Then
tempPosition = 1
Else If tempPosition = FrontRetestOrWinderMax then
tempPosition = 1
Else If tempPosition = CenterRetestOrWinderMax then
tempPosition = 1
Else If tempPosition = BackRetestOrWinderMax then
tempPosition = 1
else
tempPosition = tempPosition + 1
End If
SetBondPosition(tempPosition.tostring)
End Sub
#End Region
#Region "Get PiValues"
Private Function GetRecordID() As Int64
Dim RecordID As Int32 = 0
Try
Dim piserver As New PIServer("valpi", "piadmin", "fatb0y",True)
RecordID = piserver.GetCurrentValue("PAPERLAB:PaperLabReelSelected")
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
Return RecordID
End Function
Private Function GetBondPosition() As Int64
Dim BondPos As Int32 = 0
Try
Dim piserver As New PIServer("valpi", "piadmin", "fatb0y",True)
BondPos = CInt(piserver.GetCurrentValue("PAPERLAB:SBOND.POS"))
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
Return BondPos
End Function
Private Sub SetBondPosition(pos As String)
Try
Dim piserver As New PIServer("valpi", "piadmin", "fatb0y",True)
piserver.WriteValue("PAPERLAB:SBOND.POS", pos)
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
End Sub
Private Function BondTestType() As String
Dim TestType As String = ""
Try
Dim piserver As New PIServer("valpi", "piadmin", "fatb0y",True)
TestType = piserver.GetCurrentValue("M1:BOND.TYPE")
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
Return TestType
End Function
Private Function BondReelLoc() As String
Dim ReelLoc As String = ""
Try
Dim piserver As New PIServer("valpi", "piadmin", "fatb0y",True)
ReelLoc = piserver.GetCurrentValue("M1:BOND.ReelLoc")
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
Return ReelLoc
End Function
Private Function GetBondInterfaceStatus() As Integer
Dim Status As Integer = 0
Try
Dim piserver As New PIServer("valpi", "piadmin", "fatb0y",True)
Status = CInt(piserver.GetCurrentValue("PAPERLAB:BOND_INTERFACE.S"))
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
Return Status
End Function
#End Region
#Region "Debug"
Private Sub ErrorLog(RecordID As Int32, BondTest As Integer, ReelLoc As String, TestType As String, StartingTestPos As Integer, dataArray() As Double)
Dim SavePath As String = "C:\Program Files (x86)\PIPC\Interfaces\Lab"
Dim NameOfFile As String = "BondTest Debug File"
Dim TestPos = StartingTestPos + (CInt(dataArray(0)) - 1)
If System.IO.File.Exists(SavePath & "\" & NameOfFile & ".txt") Then
Using sw As StreamWriter = New StreamWriter(SavePath & "\" & NameOfFile & ".txt", True)
' For i = 0 To dataArray.Count -1
sw.WriteLine(" ")
sw.WriteLine(RecordID & " " & BondTest & " " & ReelLoc & " " & TestType & " " & TestPos & " " & dataArray(1).ToString)
' TestPos = TestPos + 1
' Next
End Using
else
File.Create(SavePath & "\" & NameOfFile & ".txt").Dispose()
Using sw As StreamWriter = File.CreateText(SavePath & "\" & NameOfFile & ".txt")
'For i = 0 To dataArray.Count -1
sw.WriteLine(" ")
sw.WriteLine(RecordID & " " & BondTest & " " & ReelLoc & " " & TestType & " " & TestPos & " " & dataArray(1).ToString)
' TestPos = TestPos + 1
'Next
End Using
End If
End Sub
Private Sub ErrorLog2(dataArray as string)
Dim SavePath As String = "C:\Program Files (x86)\PIPC\Interfaces\Lab"
Dim NameOfFile As String = "BondTest Debug File"
' Dim TestPos = StartingTestPos
If System.IO.File.Exists(SavePath & "\" & NameOfFile & ".txt") Then
Using sw As StreamWriter = New StreamWriter(SavePath & "\" & NameOfFile & ".txt", True)
sw.WriteLine(" ")
sw.WriteLine(dataArray)
End Using
else
File.Create(SavePath & "\" & NameOfFile & ".txt").Dispose()
Using sw As StreamWriter = File.CreateText(SavePath & "\" & NameOfFile & ".txt")
sw.WriteLine(" ")
sw.WriteLine(dataArray)
End Using
End If
End Sub
#End Region
This is a screenshot of the errors:
Thanks in advance
Normally, after opening the serial port in .NET it stays opened for arbitrary time. I've written several .NET applications were serial ports are used for months or years without app or computer restart and they work well.
According to the exception info you posted it looks like that serial port has been disposed. There are several possible reasons.
Using bad driver or HW, that disconnects your serial port. I've been using many USB-to-RS232 converters and some of them had bad drivers so sometimes ports were randomly disconnected and ObjectDisposedException was thrown. In earlier Windows editions (XP) the OS even 'blue-screened'. Here is more info about such situation where ObjectDisposedException is thrown.
This is a known problem with SerialPort. Device removal causes an uncatchable exception in a background thread it uses (WaitForCommEvent). The only solutions are to not use SerialPort or create a .config file that puts unhandled exception trapping mode back to .NET 1.1 behavior.
The USB cable of your RS232 converter is manually disconnected. If you do this, most drivers normally disconnect all handles to your serial port and .NET throws ObjectDisposedException.
Also check your power management settings on your USB port if USB-to-RS232 converter is used. Try to uncheck this option on USB device to which converter is connected.
SW bug in your code.
It's always advisable (especially if converter used) to try more types of converters just to be sure there is no problem in HW device/driver.
Update: So as Timmy was saying the connection was getting disposed by garbage collection. so i declared the object as a shared variable in the class
Shared Dim WithEvents serialPort as IO.Ports.SerialPort
and in the OnStart method i initiated it as a new Serial port and rocked on. has not throw any errors since garbage collection wont disposed of it. Hope this helps somebody having a similar issue.

Reading from Serial Port always times out

I am writing software for a POS terminal. This terminal has a printer that is attached to a cash drawer. I need to send a code to the printer, and listen for what is returned to determine whether or not the cash drawer is open. Using MSComm, I had logic that worked in VB6, so I know the actual Hex code I am sending is correct.
This code always returns "Error: Serial Port read timed out". I do not know what I am doing wrong with the read portion. Please advise, how do I listen for what the port is sending back as a response?
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
' Receive strings from a serial port.
Dim returnStr As String = ""
Dim x As Integer = 0
Dim com3 As IO.Ports.SerialPort = Nothing
logfile.WriteLine("STARTCASHDRAWERSTATUSCHECK")
Try
com3 = My.Computer.Ports.OpenSerialPort("COM3")
com3.WriteLine(ChrW(&H1B) & ChrW(&H75) & ChrW(&H0))
com3.BaudRate = SetPortBaudRate(9600)
com3.Parity = IO.Ports.Parity.None
com3.DataBits = SetPortDataBits(8)
com3.StopBits = SetPortStopBits(1)
com3.Handshake = IO.Ports.Handshake.RequestToSend
com3.ReadTimeout = 10000
Do
x = x + 1
Dim Incoming As String = com3.ReadLine()
logfile.WriteLine(x & "incoming" & Incoming & "x")
If Incoming Is Nothing Then
logfile.WriteLine("Button2resultEXITDO" & x)
Exit Do
Else
returnStr &= Incoming & vbCrLf
End If
If x > 10 Then
Exit Do
End If
Loop
Catch ex As TimeoutException
returnStr = "Error: Serial Port read timed out."
Finally
If com3 IsNot Nothing Then com3.Close()
End Try
logfile.WriteLine("Button2result:" & returnStr)
End Sub
Thanks in advance!

TCPClient / Server - How to Send Data via TCP/IP ASCII Special Characters

I have an application which currently sends requests via TCP/IP Port 6000, and waits for a Reply.
I have been given the Request / Reply Protocol, but cant seem to send ASCII Control Characters like SOH,SOT,EOT etc... 01,02,03.
This is what I receive via TCP Port 6000 which I can display in the Msgbox.
Enquiry Message http://www.hcs-it.com/Enquiry.jpg
And this is what I am meant to send back ...
Enquiry Message http://www.hcs-it.com/Response.jpg
Here is my Class Code ...
Private Sub StartListen()
Try
' Must listen on correct port- must be same as port client wants to connect on.
Const portNumber As Integer = 6000
Dim tcpListener As New TcpListener(portNumber)
tcpListener.Start()
' Console.WriteLine("Waiting for connection...")
RichTextBox1.Text = RichTextBox1.Text & "Waiting for Connection ...." & vbCrLf
'
'
' SOH <ID> STX <DATA> ETX <CKSUM> EOT
'
'
Top:
'Accept the pending client connection and return a TcpClient initialized for communication.
Dim tcpClient1 As TcpClient = tcpListener.AcceptTcpClient()
' Get the stream
Dim networkStream As NetworkStream = tcpClient1.GetStream()
' Read the stream into a byte array
Dim bytes(tcpClient1.ReceiveBufferSize) As Byte
networkStream.Read(bytes, 0, CInt(tcpClient1.ReceiveBufferSize))
' Return the data received from the client to the console.
Dim clientdata As String = ASCIIEncoding.Unicode.GetString(bytes)
RichTextBox1.Text = RichTextBox1.Text & clientdata
Dim soh As String = GetChar(clientdata, 1)
Dim id As String = "010000000000000000"
Dim stx As String = GetChar(clientdata, 20)
Dim etx As String = GetChar(clientdata, 44)
Dim ack As String = System.Convert.ToChar(System.Convert.ToUInt32("06", 16))
Dim cksum As String = clientdata.Substring(44, 4)
Dim eot As String = GetChar(clientdata, 49)
Dim data As String = " 1Some Date "
Dim responseString As String = soh & id & stx & data & etx & cksum & eot & ack
Dim sendBytes As [Byte]() = Encoding.ASCII.GetBytes(responseString)
networkStream.Write(sendBytes, 0, sendBytes.Length)
RichTextBox1.Text = RichTextBox1.Text & vbCrLf & responseString & vbCrLf
tcpClient1.Close()
tcpListener.Stop()
GoTo Top
Catch e As Exception
Console.WriteLine(e.ToString())
Console.ReadLine()
End Try
End Sub
ASCIIEncoding.Unicode you should investigate that expression... This is equivalent to Encoding.Unicode which is not what you want (you want ASCII).
Also, you are ignoring the return value from Read which is a common mistake.

vb.net how to detect if an email is undeliverable in a win form program

I have the following code:
Public Function VerstuurMail(ByVal strFrom As String, ByVal strTo As String, ByVal strSubject As String, ByVal strBody As String, ByVal strMailSMTP As String, ByVal MailUser As String, ByVal MailPassword As String, ByVal MailPort As Integer, Optional ByVal AttachmentFiles As String = "") As String
Try
'create the mail message
Dim mail As New MailMessage()
Dim basicCredential As New NetworkCredential(MailUser, MailPassword)
'set the addresses
mail.From = New MailAddress(strFrom)
mail.To.Add(strTo)
'set the content
mail.Subject = strSubject
If File.Exists(strBody) = True Then
Dim objReader As New System.IO.StreamReader(strBody, System.Text.Encoding.GetEncoding(1252))
mail.Body = objReader.ReadToEnd
objReader.Close()
End If
mail.IsBodyHtml = False
'send the message
Dim smtp As New SmtpClient(strMailSMTP)
smtp.DeliveryMethod = SmtpDeliveryMethod.Network
smtp.EnableSsl = True
'smtp.UseDefaultCredentials = True
smtp.Credentials = basicCredential
smtp.Port = MailPort
Dim AttachmentFile As String() = AttachmentFiles.Split("*")
For Each bestand In AttachmentFile
If System.IO.File.Exists(bestand) Then
mail.Attachments.Add(New Attachment(bestand))
Else
Call MessageBox.Show("File can't be found")
End If
Next
'Dim userState As Object = mail
'smtp.SendAsync(mail, userState)
'AddHandler smtp.SendCompleted, AddressOf SendCompletedCallback
smtp.Send(mail)
mailSent = True
smtp.Dispose()
Catch ex As Exception
mailSent = False
Call MessageBox.Show(ex.Message & vbCrLf & "Didn't sent to: " & strTo & vbCrLf & " with extra error message:" & vbCrLf & ex.ToString)
Finally
End Try
Return mailSent
End Function
This function is used in a program which reads a text file, with the parameters on one line, and is called as many lines there are. (in a loop)
This is working fine.
Now when the text file has a wrong email adress the function doesn't trow a error it just sent the email to nobody.
example: sent an mail to joe#gmail.com works, send an email to joe#hmail.com doesn't sent but doesn't give an error either.
I have googled but the examples said that I should use 'smtp.SendAsync(mail, userState)'
But then the program doesn't follow the loop anymore and no mails are being sent. I can't use the debugger and step through the code. It just jumps from one place to the other.
This is the other function:
Private Sub SendCompletedCallback(ByVal sender As Object, ByVal e As AsyncCompletedEventArgs)
Dim mail As MailMessage = CType(e.UserState, MailMessage)
'write out the subject
Dim subject As String = mail.Subject
'If e.Cancelled Then
' Call MessageBox.Show("Send canceled: " & Now & " token " & subject)
' MailLog &= "Send canceled" & vbCrLf
'End If
If Not e.Error Is Nothing Then
Call MessageBox.Show("Foutmelding op: " & Now & " onderwerp " & subject & " met error: " & e.Error.ToString())
MailLog = MailLog & "Niet verstuurd met als fout melding: " & e.Error.ToString() & vbCrLf
Else
'Call MessageBox.Show("Message sent at: " & Now)
MailLog = MailLog & "Bericht verstuurd op: " & Now & vbCrLf
End If
mailSent = True
End Sub
Thanks in advance. I hope somebody can put me in the right direction.
Brian
This is a data issue, not an issue with the actual mechanism to send email. The best you can do is to use a regular expression to make sure the email address is valid per the rules of RFC 2822, like this:
string email = txtemail.Text;
Regex regex = new Regex(#"^([\w\.\-]+)#([\w\-]+)((\.(\w){2,3})+)$");
Match match = regex.Match(email);
if (match.Success)
{
Response.Write(email + " is valid.");
}
else
{
Response.Write(email + " is invalid.");
}
Unfortunately for you, joe#hmail.com is a valid email address by the above logic, but is is not the intended joe#gmail.com address so it ends up in the wrong place. When it is discovered that it is the wrong email address, then changing the data to the right value is the only correct course of action.
Note: Generally, you verify someone's email address when they register for a website, thus the system "knows" the email address is legitimate/correct because they successfully received an email and entered a verification code or clicked on a link that verified with the website that they did get the email. This solves most data issues (misspellings, incorrectly entered values, etc.).
After two full days of testing and searching I have found that when using:
Dim userState As Object = mail
smtp.SendAsync(mail, userState)
AddHandler smtp.SendCompleted, AddressOf SendCompletedCallback
you should not close the smtpClient with smtp.Dispose()
The callback function kept getting the cancel error.
Also I used the backgroundworker for sending the many mails but the async is, in a way, a backgroundworker. So I had two backgroundworkers and that didn't work at all.
It took me two days.....
Brian