FreeBasic y RS232

Boas tardes, en los últimos tiempos he dedicado mi programación un poco en FreeBasic (http://www.freebasic.net) e, uno de los programas que hice fue enviar mensajes a través de un módem GSM (teléfono móvil, Palo de banda ancha, etc.), pero siempre había un problema, Si por casualidad el COM puerto el programa produjo error, y como en la mayoría de los casos utilizan los puertos virtuales, También suele ser un problema… Decidí tratar de resolver el problema y se hizo la luz 🙂 !

Entonces aqui vai el programa:


Dim compartido RS232_MUTEX como cualquier Ptr Dim compartido RS232_IN como cadena Dim compartido RS232_OUT como cadena Dim compartido RS232_COMM como cadena Dim compartido RS232_STATUS como UByte Dim compartido RS232_FILE como Integer Dim compartido RS232_IN_SUB como cualquier Ptr Dim compartido RS232_OUT_SUB como cualquier Ptr privado Dim compartido hecho como UByte Private Sub rs232insub Dim temp como cadena = ""
RS232_MUTEX = Mutexcreate sueño 20,1
Tiempo 1
Si RS232_STATUS = 0 Luego Exit Sub línea entrada #RS232_FILE, Temp si temp <> "" Entonces 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 hecho = 1
RS232_ERR_STR de función End Sub(err_n como UByte) Como cadena Select Case err_n caso 0
Retorno "Ningún error"
Caso 1
Retorno "No se puede abrir - Su abierta"
Caso 2
Retorno "Invalid COMM Port - No COMM"
Caso 3
Retorno "Invalid COMM Port - No se puede abrir"
Caso 4
Retorno "Nada de enviar"
Caso 5
Retorno "Enviar tiempo de espera"
Caso 5
Retorno "Tiempo de espera de recibir - Cadena específica"
Caso 6
Retorno "Recibir cadena específica encontrada"         

Caso más retorno "Error desconocido"
Extremo final seleccione función función RS232_OPEN como UByte If RS232_STATUS = 1 Luego regreso 1
Si RS232_COMM = "" Luego regreso 2  

RS232_FILE = Freefile Open Com (RS232_COMM)Para binario como #RS232_FILE si Err <> 0 Luego regreso 3

RS232_STATUS = 1

Rem iniciar entrada Sub RS232_IN_SUB = Threadcreate(@rs232insub)
Poner fin a la función Sub RS232_CLOSE RS232_STATUS = 0
Threadwait ( RS232_IN_SUB )
RS232_IN = ""
RS232_OUT = ""
RS232_COMM = ""
borrar delete RS232_IN_SUB RS232_OUT_SUB Mutexdestroy RS232_MUTEX End Sub función RS232_SEND (tiempo de espera como doble) Como UByte hecho = 0
Si RS232_STATUS = 0 Luego regreso 1
Si RS232_OUT = "" Luego regreso 4
RS232_OUT_SUB = Threadcreate(@rs232outsub)
Dim comenzar como doble = Timer dormir 10,1
Dormir 1, 1
Si de hecho = 1 Entonces Rem borrar RS232_OUT_SUB volver 0
End If Loop hasta (Temporizador - Inicio) > tiempo de espera eliminar RS232_OUT_SUB volver 5
Función función RS232_GET As String Dim temp como cadena Mutexlock RS232_MUTEX temp de final = RS232_IN RS232_IN = ""
Temp Mutexunlock RS232_MUTEX retorno final función función RS232_GET_STR(fSTR As String,tiempo de espera como doble) Como UByte If RS232_STATUS = 0 Luego regreso 1
Si RS232_OUT = "" Luego regreso 4
Dim comenzar como doble = Timer hacer si Instr(RS232_IN,fSTR) <> 0 Luego regreso 6
Dormir 50, 1
Bucle hasta (Temporizador - Inicio) > tiempo de espera de regreso 5
Final función función RS232_GET_STR2(fSTR As String,fSTR1 As String,tiempo de espera como doble) Como UByte If RS232_STATUS = 0 Luego regreso 1
Si RS232_OUT = "" Luego regreso 4
Dim comenzar como doble = Timer hacer si Instr(RS232_IN,fSTR) <> 0 Luego regreso 6
Si Instr(RS232_IN,fSTR1) <> 0 Luego regreso 6
Dormir 50, 1
Bucle hasta (Temporizador - Inicio) > tiempo de espera de regreso 5
End Function


E una parte de teste:

RS232_COMM = "COM11: 57600,N,8,1,BIN,GSS"
Imprimir "un abrir de tentar un com11"
Imprimir RS232_ERR_STR(RS232_OPEN)
RS232_OUT = "AT" + Chr(10,13)
Imprimir RS232_ERR_STR(RS232_SEND(20))
Imprimir RS232_ERR_STR(RS232_GET_STR("Vale",1))
Impresión hecho imprimir RS232_GET RS232_OUT = "ATZ0"  + Chr(13,10)
Imprimir RS232_ERR_STR(RS232_SEND(20))
Imprimir RS232_ERR_STR(RS232_GET_STR("Vale",1))
Print Print Print RS232_GET de hecho "desliga o usb"
Dormir RS232_OUT = "AT" + Chr(10,13)
Imprimir RS232_ERR_STR(RS232_SEND(20))
Imprimir RS232_ERR_STR(RS232_GET_STR("Vale",10))
Rs232_close dormir


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

E tanto trabaja em windows como em linux.

Cualquier pregunta no dude en preguntar 🙂

FreeBasic y RS232

2 pensamientos sobre "FreeBasic y RS232

Contesta

Vuelve al comienzo