FreeBasic et RS232

Le 27 avril, 2010 par Miguel Ferreira | Posté par FreeBasic.

Boas tardes, Ces derniers temps j'ai consacré moi-même un peu de programmation en FreeBasic (http://www.freebasic.net) et, un des programmes que j'ai fait a été d'envoyer des messages au moyen d'un modem GSM (Téléphone mobile, Bâton à large bande, etc.), mais il avait toujours un problème, Si par hasard le COM port que le programme fait erreur, et comme dans la plupart des cas, ils utilisent les ports virtuels, est un problème trop souvent… J'ai décidé d'essayer de résoudre le problème et il y avait la lumière 🙂 !

Então aqui vai o programa:


Dim partagé RS232_MUTEX comme tout Ptr Dim partagé RS232_IN comme String Dim partagé RS232_OUT comme String Dim partagé RS232_COMM comme String Dim partagé RS232_STATUS comme UByte Dim partagé RS232_FILE comme entier Dim partagé RS232_IN_SUB comme tout Ptr Dim Shared RS232_OUT_SUB comme tout Ptr privé Dim Shared fait aussi UByte Private Sub rs232insub Dim temp comme String = ""
RS232_MUTEX = sommeil Mutexcreate 20,1
Certain temps 1
Si RS232_STATUS = 0 Puis l'entrée de sortie Sub Line #RS232_FILE, Temp si temp <> "" Puis Mutexlock RS232_MUTEX RS232_IN = RS232_IN + temp de Temp Mutexunlock RS232_MUTEX = ""
Fin si Wend End Sub Private Sub rs232outsub Print #RS232_FILE, RS232_OUT fait = 1
End Sub fonction RS232_ERR_STR(err_n As Byte) Comme la chaîne Select Case err_n Case 0
Retour "Aucune erreur"
Affaire 1
Retour "Impossible d'ouvrir - Son ouverture"
Affaire 2
Retour "Port COMM non valide - Aucun COMM"
Affaire 3
Retour "Port COMM non valide - Impossible d'ouvrir"
Affaire 4
Retour "Rien à envoyer"
Affaire 5
Retour "Envoyer le délai d'attente"
Affaire 5
Retour "Délai d'attente de réception - Chaîne spécifique"
Affaire 6
Retour "Recevoir la chaîne spécifique trouvé"         

Case Else Return "Erreur inconnue"
Fin choisir terminer fonction fonction RS232_OPEN comme UByte If RS232_STATUS = 1 Puis retour 1
Si RS232_COMM = "" Puis retour 2  

RS232_FILE = Freefile Open Com (RS232_COMM)Pour binaire comme #RS232_FILE Si Err <> 0 Puis retour 3

RS232_STATUS = 1

REM commencer entrée Sub RS232_IN_SUB = Threadcreate(@rs232insub)
Fin de fonction Sub RS232_CLOSE RS232_STATUS = 0
Threadwait ( RS232_IN_SUB )
RS232_IN = ""
RS232_OUT = ""
RS232_COMM = ""
Delete supprime RS232_IN_SUB RS232_OUT_SUB Mutexdestroy RS232_MUTEX End Sub fonction RS232_SEND (Timeout As Double) Comme UByte fait = 0
Si RS232_STATUS = 0 Puis retour 1
Si RS232_OUT = "" Puis retour 4
RS232_OUT_SUB = Threadcreate(@rs232outsub)
Dim commencer début As Double = Sleep Timer 10,1
Dormir 1, 1
Si fait = 1 Rem supprimez RS232_OUT_SUB retour 0
End If Loop jusqu'au (Minuterie - Début) > Timeout supprimer RS232_OUT_SUB retour 5
Fonction Function RS232_GET As String Dim temp de As String Mutexlock RS232_MUTEX temp fin = RS232_IN RS232_IN = ""
Temp Mutexunlock RS232_MUTEX Return End Function Function RS232_GET_STR(fSTR As String,Timeout As Double) Comme UByte If RS232_STATUS = 0 Puis retour 1
Si RS232_OUT = "" Puis retour 4
Dim commencer début As Double = Timer Do si Instr(RS232_IN,fSTR) <> 0 Puis retour 6
Sommeil 50, 1
Boucle jusqu'à (Minuterie - Début) > délai de retour 5
Fin fonction fonction RS232_GET_STR2(fSTR As String,fSTR1 As String,Timeout As Double) Comme UByte If RS232_STATUS = 0 Puis retour 1
Si RS232_OUT = "" Puis retour 4
Dim commencer début As Double = Timer Do si Instr(RS232_IN,fSTR) <> 0 Puis retour 6
Si Instr(RS232_IN,fSTR1) <> 0 Puis retour 6
Sommeil 50, 1
Boucle jusqu'à (Minuterie - Début) > délai de retour 5
End Function


E une parte de teste:

RS232_COMM = "COM11: 57600,N,8,1,BIN,GSS"
Imprimer "un tentar abrir un com11"
Impression RS232_ERR_STR(RS232_OPEN)
RS232_OUT = "AT" + Chr(10,13)
Impression RS232_ERR_STR(RS232_SEND(20))
Impression RS232_ERR_STR(RS232_GET_STR("Bien",1))
Impression faite imprimer RS232_GET RS232_OUT = "ATZ0"  + Chr(13,10)
Impression RS232_ERR_STR(RS232_SEND(20))
Impression RS232_ERR_STR(RS232_GET_STR("Bien",1))
Impression faite impression RS232_GET "desliga o usb"
Dormir RS232_OUT = "AT" + Chr(10,13)
Impression RS232_ERR_STR(RS232_SEND(20))
Impression RS232_ERR_STR(RS232_GET_STR("Bien",10))
Rs232_close sommeil


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

E tanto trabalha em windows como em linux.

Toutes les questions ne hésitez pas à demander 🙂

Balises: , , , , , , , ,