Comport mit Thread und Callback
Verfasst: 26.01.2018 19:54
Es gibt immer wieder Problemen Ascii-Daten über Comport zu senden und zu empfangen.
Habe diese über Thread und Callback-Routinen mal gelöst.
Das Ende der Textdaten wird über Ende-Zeichen ausgewertet. z.B. #CRLF$. Dieses wird auch automatisch beim senden hinzugefügt.
Update v0.03
- Bugfix mehrfach EndOfText
Update v0.04
- Bugfix Speicherleck
Update v0.05
- Code optimiert
Habe diese über Thread und Callback-Routinen mal gelöst.
Das Ende der Textdaten wird über Ende-Zeichen ausgewertet. z.B. #CRLF$. Dieses wird auch automatisch beim senden hinzugefügt.
Update v0.03
- Bugfix mehrfach EndOfText
Update v0.04
- Bugfix Speicherleck
Update v0.05
- Code optimiert
Code: Alles auswählen
;-TOP
; Comment : Comport Manager Over Thread and Callback
; Author : mk-soft
; Version : v0.05
; Created : 26.01.2018
; Updated : 27.01.2018
; *****************************************************************************
CompilerIf #PB_Compiler_Thread = 0
CompilerError "Use Option Threadsafe!"
CompilerEndIf
Prototype ProtoReceiveCB(Text.s)
Prototype ProtoStatusCB(Status, *ComData)
Enumeration
#ComStatus_Nothing
#ComStatus_OpenPort
#ComStatus_ClosePort
#ComStatus_ErrorOpenPort
#ComStatus_ErrorSend
#ComStatus_ErrorReceive
#ComStatus_ErrorDataSize
EndEnumeration
Structure udtComData
; Header
ThreadID.i
Exit.i
Status.i
; Port Data
ComID.i
Port.s
Baud.i
Parity.i
DataBit.i
StopBit.i
Handshake.i
BufferSize.i
; End Of Text
EndOfText.s
; Send Data
SendSignal.i
SendCount.i
SendText.s
SendError.i
; Receive data
ReceiveCount.i
ReceiveText.s
ReceiveError.i
; Callback
*StatusCB.ProtoStatusCB
*ReceiveCB.ProtoReceiveCB
EndStructure
Procedure thComport(*ComData.udtComData)
Protected *Send, *Receive, SendText.s, SendLen, ReceiveText.s, ReceiveLen, Pos
With *ComData
; Startup
\Status = 1
\SendCount = 0
\ReceiveCount = 0
\ComID = OpenSerialPort(#PB_Any, \Port, \Baud, \Parity, \DataBit, \StopBit, \Handshake, \BufferSize, \BufferSize)
If \ComID
\Status = 2
Else
If \StatusCB
\StatusCB(#ComStatus_ErrorOpenPort, *ComData)
EndIf
\Status = 0
ProcedureReturn 0
EndIf
If \StatusCB
\StatusCB(#ComStatus_OpenPort, *ComData)
EndIf
*Send = AllocateMemory(\BufferSize)
*Receive = AllocateMemory(\BufferSize)
; Loop
Repeat
If \SendSignal
SendText = \SendText + \EndOfText
SendLen = StringByteLength(SendText, #PB_Ascii)
If SendLen <= \BufferSize
PokeS(*Send, SendText, SendLen, #PB_Ascii)
If WriteSerialPortData(\ComID, *Send, SendLen) = 0
\SendError = SerialPortError(\ComID)
If \StatusCB
\StatusCB(#ComStatus_ErrorSend, *ComData)
EndIf
Else
\SendError = 0
\SendCount + 1
EndIf
Else
If \StatusCB
\StatusCB(#ComStatus_ErrorDataSize, *ComData)
EndIf
EndIf
\SendSignal = 0
EndIf
ReceiveLen = AvailableSerialPortInput(\ComID)
If ReceiveLen
ReceiveLen = ReadSerialPortData(\ComID, *Receive, ReceiveLen)
If ReceiveLen = 0
\ReceiveError = SerialPortError(\ComID)
If \StatusCB
\StatusCB(#ComStatus_ErrorReceive, *ComData)
EndIf
Else
\ReceiveError = 0
EndIf
ReceiveText + PeekS(*Receive, ReceiveLen, #PB_Ascii)
Repeat
pos = FindString(ReceiveText, \EndOfText, 1, #PB_String_NoCase)
If pos
\ReceiveText = Left(ReceiveText, pos - 1)
ReceiveText = Mid(ReceiveText, pos + Len(\EndOfText))
\ReceiveCount + 1
If \ReceiveCB
\ReceiveCB(\ReceiveText)
EndIf
EndIf
Until pos = 0
EndIf
Delay(10)
Until \Exit
; Shutdown
CloseSerialPort(\ComID)
If \StatusCB
\StatusCB(#ComStatus_ClosePort, *ComData)
EndIf
FreeMemory(*Send)
FreeMemory(*Receive)
\Status = 0
\ComID = 0
\Exit = 0
ProcedureReturn 1
EndWith
EndProcedure
; *****************************************************************************
CompilerIf #PB_Compiler_IsMainFile
Global ComData.udtComData
Procedure ReceiveCB(Text.s)
AddGadgetItem(0, -1, Text) ; Nur unter Windows!
SetGadgetState(0, CountGadgetItems(0) - 1)
SetGadgetState(0, -1)
EndProcedure
Procedure StatusCB(Status, *ComData.udtComData)
Protected Text.s
Select Status
Case #ComStatus_OpenPort
Text = "ComStatus: Open Port " + *ComData\Port
Case #ComStatus_ClosePort
Text = "ComStatus: Close Port " + *ComData\Port
Case #ComStatus_ErrorOpenPort
Text = "ComError: Open Port " + *ComData\Port
Case #ComStatus_ErrorSend
Text = "ComError Send: Port " + *ComData\Port + " - ErrorCode " + *ComData\SendError
Case #ComStatus_ErrorReceive
Text = "ComError Receive: Port " + *ComData\Port + " - ErrorCode " + *ComData\ReceiveError
EndSelect
If Bool(Text)
StatusBarText(0, 0, Text) ; Nur unter Windows!
EndIf
EndProcedure
Procedure InitComport()
With ComData
If \Status
ProcedureReturn 2 ; Always running
EndIf
\Port = "COM1"
\Baud = 9000
\Parity = #PB_SerialPort_NoParity
\DataBit = 8
\StopBit = 1
\Handshake = #PB_SerialPort_NoHandshake
\BufferSize = 2048
\EndOfText = #CRLF$
\StatusCB = @StatusCB()
\ReceiveCB = @ReceiveCB()
\ThreadID = CreateThread(@thComport(), ComData)
If Not \ThreadID
StatusBarText(0, 0, "Comport " + \Port + ": Error Create Thread")
ProcedureReturn 0 ; Error create thread
Else
ProcedureReturn 1 ; ok
EndIf
EndWith
EndProcedure
Procedure Main()
Protected Event
If OpenWindow(0, #PB_Ignore, #PB_Ignore, 800, 600, " Test Comport", #PB_Window_SystemMenu)
CreateStatusBar(0, WindowID(0))
AddStatusBarField(#PB_Ignore)
ListViewGadget(0, 0, 0, 800, 540)
StringGadget(1, 5, 545, 590, 25, "")
ButtonGadget(2, 605, 545, 90, 25, "Send")
ButtonGadget(3, 695, 545, 90, 25, "On/Off")
AddKeyboardShortcut(0, #PB_Shortcut_Return, 1000)
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_CloseWindow
If ComData\Status
MessageRequester("Info", "Comport Is Open!", #PB_MessageRequester_Warning)
Else
Break
EndIf
Case #PB_Event_Gadget
Select EventGadget()
Case 2
If ComData\Status = 2 And ComData\SendSignal = 0
ComData\SendText = GetGadgetText(1)
ComData\SendSignal = 1
EndIf
Case 3
If ComData\Status
ComData\Exit = 1
Else
InitComport()
EndIf
EndSelect
Case #PB_Event_Menu
Select EventMenu()
Case 1000
If GetActiveGadget() = 1
PostEvent(#PB_Event_Gadget, 0, 2, #PB_EventType_LeftClick)
EndIf
EndSelect
EndSelect
ForEver
EndIf
EndProcedure : Main()
CompilerEndIf