我试图编写一个基于 VB.net 的设备驱动程序来接收 ASTM 协议中的数据。驱动程序必须进一步处理数据并将其发送到基于数据库的软件（“生物”）。事实上，当收到一小组数据时，我成功地完成了这两项任务。但是当接收到大量数据时，就会出现问题。将数据发送到我的驱动程序的软件没有收到 ACK 命令，并且会重新传输帧。我对多线程不太熟悉，但最近听说它可能会解决我的问题，因为它与同步和超时有关。请在下面找到我的代码的当前版本。如果您能建议和帮助我如何修改它以添加线程并以驱动程序将新数据插入队列并发送 ACK 命令的方式同步它们，我将非常感激，但将与发送并行执行从队列到数据库的数据。我想它应该以同步的方式进行...请帮助...
Imports System.Threading
Module MainModule
Const SAMPLE As String = "H|\^&|||BLA||||||||V1.0|20141030110328" & vbCrLf & _
"P|1" & vbCrLf & _
"O|1|2280||^^^PLUSANF^449353738032|R||20141030110156|||||||20141030110156" & vbCrLf & _
"R|1|^^^GND^449353738032|INST_ONGOING|||||P|||20141030110156|20141030111213|BACTECFX^93^5^2^D-C09" & vbCrLf & _
"L|1|N"
Const LOG_FILE As String = "\\srvfs1\general\groups\biologic\BD\log.txt"
Const STX As String = Chr(2)
Const ETX As String = Chr(3)
Const EOT As String = Chr(4)
Const ENQ As String = Chr(5)
Const NAK As String = Chr(25)
Const ETB As String = Chr(23)
Const ACKNOWLEDGE_MESSAGE As String = Chr(&H0) + Chr(&H6)
Private WithEvents _RS232 As Rs232
Dim messageDateTime, accessionNumber, testId, testSequence, collectedDateTime, receivedDateTime, resultFields() As String
Dim resultTypeCode, vialNumber, testStatus, preliminaryFinalStatus, entryDateTime, classificationDateTime As String
Dim instrumentFields(), instrumentType, mediaType, protocol, instrumentNumber, station As String
Dim classificationId As Integer
Dim resultReceived, orderReceived As Boolean
Dim frameNumber As String
Sub Main()
'updateBiologicDatabase("449381999474", "B-K08", "1480", 2, "20140603032419", "20140617090442", 93, 5, "7171")
'Dim test As Integer = getClassificationId("INST_NEGATIVE")
'If 1 = 1 Then
' closeConnections()
' Return
'End If
_RS232 = New Rs232()
Try
'// Setup parameters
With _RS232
.BaudRate = 9600
.DataBit = 8
.StopBit = Rs232.DataStopBit.StopBit_1
'.Parity = Rs232.DataParity.Parity_Even
.Parity = Rs232.DataParity.Parity_None
'.Timeout = Int32.Parse(txtTimeout.Text)
.Timeout = 20000
.UseXonXoff = False
End With
'// Initializes port
_RS232.Open()
'// Set state of RTS / DTS
'_RS232.Dtr = (chkDTR.CheckState = CheckState.Checked)
'_RS232.Rts = (chkRTS.CheckState = CheckState.Checked)
_RS232.Dtr = True
_RS232.Rts = True
If Not _RS232.IsOpen Then
UpdateLog("Port not opened")
End If
Console.WriteLine("Before read port")
'Console.ReadLine()
ReadFromPort()
'Button1_Click_1(Nothing, Nothing)
Catch Ex As Exception
UpdateLog(Ex.Message)
End Try
'closeConnections()
End Sub
Sub ReadFromPort()
'----------------------
Dim buffer As String = ""
Dim nextChar, checkSum, crlf As String
'// Clear Tx/Rx Buffers
_RS232.PurgeBuffer(Rs232.PurgeBuffers.TxClear Or Rs232.PurgeBuffers.RXClear)
_RS232.Write(ACKNOWLEDGE_MESSAGE)
UpdateLog("Before loop")
Do While True
Try
_RS232.Read(1)
nextChar = _RS232.InputStreamString
Select Case nextChar
Case STX
UpdateLog("STX received")
_RS232.Read(1)
nextChar = _RS232.InputStreamString
frameNumber = nextChar
Case ETX
UpdateLog("ETX received")
_RS232.Read(2)
checkSum = _RS232.InputStreamString()
_RS232.Read(2)
crlf = _RS232.InputStreamString()
HandleBuffer(buffer)
buffer = ""
_RS232.Write(ACKNOWLEDGE_MESSAGE + frameNumber)
UpdateLog("Sent: <ACK>" + frameNumber)
'Thread.Sleep(500)
'_RS232.Write(ACKNOWLEDGE_MESSAGE)
'Thread.Sleep(500)
'_RS232.Write(ACKNOWLEDGE_MESSAGE)
Case ETB
UpdateLog("ETB received")
_RS232.Read(2)
checkSum = _RS232.InputStreamString()
'UpdateLog("Checksum after ETB = " & checkSum)
_RS232.Read(2)
crlf = _RS232.InputStreamString()
_RS232.Write(ACKNOWLEDGE_MESSAGE + frameNumber)
UpdateLog("Sent: <ACK>" + frameNumber)
'Thread.Sleep(500)
'_RS232.Write(ACKNOWLEDGE_MESSAGE)
'Thread.Sleep(500)
'_RS232.Write(ACKNOWLEDGE_MESSAGE)
Case EOT
UpdateLog("EOT received")
HandleBuffer(buffer)
buffer = ""
_RS232.Write(ACKNOWLEDGE_MESSAGE + frameNumber)
UpdateLog("Sent: <ACK>" + frameNumber)
'Thread.Sleep(500)
'_RS232.Write(ACKNOWLEDGE_MESSAGE)
'Thread.Sleep(500)
'_RS232.Write(ACKNOWLEDGE_MESSAGE)
Case ENQ
UpdateLog("ENQ received")
_RS232.Write(ACKNOWLEDGE_MESSAGE + frameNumber)
UpdateLog("Sent: " + ACKNOWLEDGE_MESSAGE + frameNumber)
'Thread.Sleep(500)
'_RS232.Write(ACKNOWLEDGE_MESSAGE)
'Thread.Sleep(500)
'_RS232.Write(ACKNOWLEDGE_MESSAGE)
Case Else
'If Asc(nextChar) = 13 Then
' _RS232.Read(1)
' nextChar = _RS232.InputStreamString
' If Asc(nextChar) = 10 Then
' buffer += vbCrLf
' UpdateLog("CRLF after line")
' Else
' UpdateLog("0A did not appear after 0D")
' End If
'Else
'UpdateLog("Regular Character: " & nextChar & " - " & Asc(nextChar))
buffer += nextChar
'End If
End Select
Catch Ex As Exception
If String.IsNullOrEmpty(buffer) Then
Continue Do
End If
Console.WriteLine("Timeout")
Continue Do
End Try
Loop
End Sub
''' <summary>
''' Handle the buffer received from RS232
''' </summary>
''' <param name="aBuffer"></param>
''' <remarks></remarks>
Sub HandleBuffer(aBuffer As String)
' From BD
'H|\^&|||BLA||||||||V1.00|19981019184200
'Q|1|^Acc123|||R
'L|1|N
' Acknowledge
'H|\^&||||||||||||19981019184200
'P|1||PatId123||Doe^John^R^Jr.^Dr.||19651029|M||2 Main St.^Baltimore^ MD^21211^USA||(410) 316 - 4000|JSMITH||||||P\AM\AMX||||19981015120000||324|||||||ER|St. Josephs Hospital()
'O|1|Acc123^ ^ ^Seq123|| ^ ^ ^MGIT_960_GND|||19981019023300|||SJB^MMF|A|||19981019045200|Blood^Arm|MJones|410)555–1234^410)555–9876^(410)555–7777|||||19981020053400|62||O||Nos
'L|1|F
' Result
'H|\^&|||BLA|||||||| V1.00 |19981019184200
'P|1||PatId123
'O|1|Acc123||^^^MGIT_960_GND^430100065178
'R|1|^^^GND^430100065178|INST_POSITIVE^87|||||P|||19981019153400|19981020145000|MGIT960^^42^3^B/A12
'L|1|F
'Dim acknowledge As String
Dim lines() As String
Dim patientid As String = ""
Dim patientName As String = ""
Dim gender As String = ""
Dim birthDate As DateTime = "1900-01-01"
messageDateTime = ""
Try
' Divide the buffer to different lines
lines = aBuffer.Split(vbCrLf)
If lines.Count < 2 Then
Exit Sub
End If
For Each line In lines
HandleLine(line)
Next
' Update the Biologic database only when the 'R' (Result) line was received or the 'O' (Order) line was received
If resultReceived Or orderReceived Then
If String.IsNullOrEmpty(classificationDateTime) Then
classificationDateTime = entryDateTime
End If
updateBiologicDatabase(vialNumber, station, accessionNumber, classificationId, classificationDateTime, entryDateTime, mediaType, protocol, instrumentNumber)
resultReceived = False
orderReceived = False
End If
Catch ex As Exception
UpdateLog(ex.Message)
End Try
End Sub
''' <summary>
''' Habdle each line separately
''' </summary>
''' <param name="aLine"></param>
''' <remarks></remarks>
Sub HandleLine(aLine As String)
Const HEADER_PREFIX As String = "H"
'Const PATIENT_PREFIX As String = "P"
Const ORDER_PREFIX As String = "O"
Const RESULT_PREFIX As String = "R"
Const MESSAGE_DATE_TIME_POSITION As Integer = 13
Const ACCESSION_NUMBER_POSITION As Integer = 2
Const TEST_POSITION As Integer = 4
Const TEST_ID_POSITION As Integer = 3
Const TEST_SEQUENCE_POSITION As Integer = 4
Const COLLECTED_DATE_TIME_POSITION As Integer = 7
Const RECEIVED_DATE_TIME_POSITION As Integer = 14
Const RESULT_POSITION As Integer = 2
Const RESULT_TYPE_CODE_POSITION As Integer = 3
Const RESULT_TYPE_SEQUENCE_POSITION As Integer = 4
Const TEST_STATUS_POSITION As Integer = 3
Const PRELIMINARY_FINAL_STATUS_POSITION As Integer = 8
Const TEST_START_DATE_TIME_POSITION As Integer = 11
Const RESULT_STATUS_DATE_TIME_POSITION As Integer = 12
Const INSTRUMENT_POSITION As Integer = 13
Const INSTRUMENT_TYPE_POSITION = 0
Const MEDIA_TYPE_POSITION = 1
Const PROTOCOL_POSITION = 2
Const INSTRUMENT_NUMBER_POSITION = 3
Const INSTRUMENT_LOCATION_POSITION = 4
Dim fields(), tests() As String
Dim pos As Integer
Try
If String.IsNullOrEmpty(aLine) Then
Return
End If
If aLine.Length < 10 Then
Return
End If
fields = aLine.Split("|")
If Asc(fields(0)) = Asc(vbLf) Then
fields(0) = fields(0).Substring(1, 1)
End If
Catch ex As Exception
UpdateLog(ex.Message)
Return
End Try
Try
Select Case fields(0)
Case HEADER_PREFIX
UpdateLog(aLine)
If aLine.Length > 10 Then
messageDateTime = fields(MESSAGE_DATE_TIME_POSITION)
orderReceived = False
resultReceived = False
'UpdateLog("Message Date Time: " & messageDateTime)
End If
Case ORDER_PREFIX
UpdateLog(aLine)
accessionNumber = fields(ACCESSION_NUMBER_POSITION)
tests = fields(TEST_POSITION).Split("^")
testId = tests(TEST_ID_POSITION)
'UpdateLog("Test Id: " & testId)
vialNumber = tests(TEST_SEQUENCE_POSITION)
'UpdateLog("Test Sequence: " & testSequence)
collectedDateTime = fields(COLLECTED_DATE_TIME_POSITION)
'UpdateLog("Collected Date Time: " & collectedDateTime)
receivedDateTime = fields(RECEIVED_DATE_TIME_POSITION)
orderReceived = True
Case RESULT_PREFIX
UpdateLog(aLine)
resultFields = fields(RESULT_POSITION).Split("^")
resultTypeCode = resultFields(RESULT_TYPE_CODE_POSITION)
vialNumber = resultFields(RESULT_TYPE_SEQUENCE_POSITION)
'UpdateLog("Result Test Sequence: " & vialNumber)
testStatus = fields(TEST_STATUS_POSITION)
'UpdateLog("Test Status / Classification: " & testStatus)
classificationId = getClassificationId(testStatus)
If classificationId < 1 Then
UpdateLog("Unknown Classification: " & testStatus)
Return
End If
preliminaryFinalStatus = fields(PRELIMINARY_FINAL_STATUS_POSITION)
entryDateTime = fields(TEST_START_DATE_TIME_POSITION)
classificationDateTime = fields(RESULT_STATUS_DATE_TIME_POSITION)
pos = classificationDateTime.IndexOf("\")
If pos > 0 Then
classificationDateTime = classificationDateTime.Substring(0, pos)
End If
'R|1|^^^GND^449238953154|INST_REMOVED|||||P|||20141102164617|20141127125123|BACTECFX^92^5^2
instrumentFields = fields(INSTRUMENT_POSITION).Split("^")
instrumentType = instrumentFields(INSTRUMENT_TYPE_POSITION)
mediaType = instrumentFields(MEDIA_TYPE_POSITION)
protocol = instrumentFields(PROTOCOL_POSITION)
instrumentNumber = instrumentFields(INSTRUMENT_NUMBER_POSITION)
If instrumentFields.Length > 4 Then
station = instrumentFields(INSTRUMENT_LOCATION_POSITION)
Else
station = ""
End If
resultReceived = True
'UpdateLog("result Received: ")
End Select
Catch ex As Exception
UpdateLog(ex.Message)
End Try
End Sub
Sub UpdateLog(ByVal aMessage As String)
Try
Console.WriteLine(aMessage)
My.Computer.FileSystem.WriteAllText(LOG_FILE, Format(Now(), "dd-MM-yyyy hh:mm:ss") & ": " & aMessage & vbCrLf, True)
Catch ex As Exception
Console.WriteLine(ex.Message)
End Try
End Sub
Sub Dispose()
_RS232.Close()
End Sub
端模块