FreeBasic e RS232

Boas tardes, nos últimos tempos dediquei-me um pouco a programar em FreeBasic (http://www.freebasic.net) e, um dos programas que fiz foi para envio de mensagens através de um modem GSM (telemóvel, pen de banda larga, etc), mas tinha sempre um problema, se por um acaso a porta COM desse algum erro o programa bloqueava, e como na maioria dos casos se usam portas virtuais, é um problema demasiado frequente… Decidi então tentar resolver o problema e fez-se luz 🙂 !

Então aqui vai o programa:

Dim Shared RS232_MUTEX As Any Ptr
Dim Shared RS232_IN As String
Dim Shared RS232_OUT As String
Dim Shared RS232_COMM As String
Dim Shared RS232_STATUS As UByte
Dim Shared RS232_FILE As Integer
Dim Shared RS232_IN_SUB As Any Ptr

Dim Shared RS232_OUT_SUB As Any Ptr

Private Dim Shared done As UByte

Private Sub rs232insub
Dim temp As String = ""
RS232_MUTEX = Mutexcreate
Sleep 20,1
While 1
If RS232_STATUS = 0 Then Exit Sub
Line Input  #RS232_FILE, temp
If temp <> "" Then
Mutexlock RS232_MUTEX
RS232_IN = RS232_IN + temp
Mutexunlock RS232_MUTEX
temp = ""
End If
Wend
End Sub

Private Sub rs232outsub
Print #RS232_FILE, RS232_OUT
done = 1
End Sub

Function RS232_ERR_STR(err_n As UByte) As String
Select Case err_n
Case 0
Return "No error"
Case 1
Return "Can't Open - Its Open"
Case 2
Return "Invalid COMM Port - No COMM"
Case 3
Return "Invalid COMM Port - Can't Open"
Case 4
Return "Nothing to send"
Case 5
Return "Send Time-OUT"
Case 5
Return "Receive Time-OUT - Specific String"
Case 6
Return "Receive Specific String Found"         

Case Else
Return "Unknown Error"
End Select
End Function            

Function RS232_OPEN As UByte
If RS232_STATUS = 1 Then Return 1
If RS232_COMM = "" Then Return 2  

RS232_FILE = Freefile
Open Com (RS232_COMM)For Binary As #RS232_FILE
If Err <> 0 Then Return 3

RS232_STATUS = 1

Rem start Input Sub
RS232_IN_SUB = Threadcreate(@rs232insub)
End Function

Sub RS232_CLOSE
RS232_STATUS = 0
Threadwait ( RS232_IN_SUB )
RS232_IN = ""
RS232_OUT = ""
RS232_COMM = ""
delete RS232_IN_SUB
delete RS232_OUT_SUB
Mutexdestroy RS232_MUTEX
End Sub                       

Function RS232_SEND (timeout As Double) As UByte
done = 0
If RS232_STATUS = 0 Then Return 1
If RS232_OUT = "" Then Return 4
RS232_OUT_SUB = Threadcreate(@rs232outsub)
Dim start As Double
start = Timer
Sleep 10,1
Do
Sleep 1, 1
If done = 1 Then
Rem delete RS232_OUT_SUB
Return 0
End If
Loop Until (Timer - Start) > timeout
delete RS232_OUT_SUB
Return 5
End Function

Function RS232_GET As String
Dim temp As String
Mutexlock RS232_MUTEX
temp = RS232_IN
RS232_IN = ""
Mutexunlock RS232_MUTEX
Return temp
End Function

Function RS232_GET_STR(fSTR As String,timeout As Double) As UByte
If RS232_STATUS = 0 Then Return 1
If RS232_OUT = "" Then Return 4
Dim start As Double
start = Timer
Do
If Instr(RS232_IN,fSTR) <> 0 Then Return 6
Sleep 50, 1
Loop Until (Timer - Start) > timeout

Return 5
End Function

Function RS232_GET_STR2(fSTR As String,fSTR1 As String,timeout As Double) As UByte
If RS232_STATUS = 0 Then Return 1
If RS232_OUT = "" Then Return 4
Dim start As Double
start = Timer
Do
If Instr(RS232_IN,fSTR) <> 0 Then Return 6
If Instr(RS232_IN,fSTR1) <> 0 Then Return 6
Sleep 50, 1
Loop Until (Timer - Start) > timeout

Return 5
End Function

E a parte de teste:

RS232_COMM = "COM11: 57600,N,8,1,BIN,DS0"
Print "a tentar abrir a com11"
Print RS232_ERR_STR(RS232_OPEN)
RS232_OUT = "AT" + Chr(10,13)
Print RS232_ERR_STR(RS232_SEND(20))
Print RS232_ERR_STR(RS232_GET_STR("OK",1))
Print done
Print RS232_GET

RS232_OUT = "ATZ0"  + Chr(13,10)
Print RS232_ERR_STR(RS232_SEND(20))
Print RS232_ERR_STR(RS232_GET_STR("OK",1))
Print done
Print RS232_GET
Print "desliga o usb"
Sleep
RS232_OUT = "AT" + Chr(10,13)
Print RS232_ERR_STR(RS232_SEND(20))
Print RS232_ERR_STR(RS232_GET_STR("OK",10))
Sleep
rs232_close
Sleep

Também está aqui: http://www.freebasic.net/forum/viewtopic.php?t=15449

E tanto trabalha em windows como em linux.

Alguma dúvida não hesites em perguntar 🙂