Anwendungsprogrammen und RS232

27. April, 2010 von Miguel Ferreira | Veröffentlicht unter Anwendungsprogrammen.

Boas tardes, in der letzten Zeit habe ich mich ein wenig Programmierung in FreeBasic gewidmet (http://www.freebasic.net) e, eines der Programme, die ich tat war zum Senden von Nachrichten über ein GSM-modem (Handy, Breitband stick, etc.), aber es war immer ein problem, Wenn durch Zufall das COM, die Port verursachte das Programm Fehler, und wie in den meisten Fällen verwenden sie virtuelle ports, ist oft ein problem… Decidi então tentar resolver o problema e fez-se luz 🙂 !

Entà Aqui Vai o programa:


Dim Shared RS232_MUTEX als Any Ptr Dim Shared RS232_IN als String Dim Shared RS232_OUT als String Dim geteilt RS232_COMM als String Dim geteilt RS232_STATUS als UByte Dim Shared RS232_FILE als Integer Dim Shared RS232_IN_SUB als Any Ptr Dim Shared RS232_OUT_SUB als Any Ptr Private Dim Shared getan wie UByte Private Sub rs232insub Dim Temp als String = ""
RS232_MUTEX = Mutexcreate Schlaf 20,1
Weile 1
Wenn RS232_STATUS = 0 Und geben Sie Exit Sub Line #RS232_FILE, Wenn temp Temp <> "" Dann 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 getan = 1
End Sub-Funktion RS232_ERR_STR(Err_n als UByte) Als String Select Case Err_n Case 0
Rückkehr "Kein Fehler"
Fall 1
Rückkehr "Kann nicht geöffnet werden - Seine Open"
Fall 2
Rückkehr "Ungültige com-Port - Keine COMM"
Fall 3
Rückkehr "Ungültige com-Port - Kann nicht geöffnet werden"
Fall 4
Rückkehr "Nichts zu senden"
Fall 5
Rückkehr "Senden Sie Timeout"
Fall 5
Rückkehr "Timeout zu erhalten - Bestimmte Zeichenfolge"
Fall 6
Rückkehr "Erhalten bestimmte Zeichenfolge gefunden"         

Case Else Return "Unbekannter Fehler"
End Select End Function Funktion RS232_OPEN als UByte If RS232_STATUS = 1 Dann zurück 1
Wenn RS232_COMM = "" Dann zurück 2  

RS232_FILE = Freefile Open Com (RS232_COMM)Für binäre als #RS232_FILE wenn Err <> 0 Dann zurück 3

RS232_STATUS = 1

REM start Eingang 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 RS232_OUT_SUB Mutexdestroy RS232_MUTEX End Sub-Funktion RS232_SEND (Timeout As Double) Als UByte getan = 0
Wenn RS232_STATUS = 0 Dann zurück 1
Wenn RS232_OUT = "" Dann zurück 4
RS232_OUT_SUB = Threadcreate(@rs232outsub)
Dim starten als Doppelstart = Sleep Timer 10,1
Schlafen 1, 1
Wenn gemacht = 1 Rem löschen RS232_OUT_SUB zurück 0
Endif-Schleife bis (Timer - Start) > Timeout löschen RS232_OUT_SUB zurück 5
End Function Function RS232_GET As String Dim temp als 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) Als UByte If RS232_STATUS = 0 Dann zurück 1
Wenn RS232_OUT = "" Dann zurück 4
Dim starten als Doppelstart = Timer tun wenn Instr(RS232_IN,fSTR) <> 0 Dann zurück 6
Schlafen 50, 1
Bis-Schleife (Timer - Start) > Timeout Return 5
End Function Function RS232_GET_STR2(fSTR As String,fSTR1 As String,Timeout As Double) Als UByte If RS232_STATUS = 0 Dann zurück 1
Wenn RS232_OUT = "" Dann zurück 4
Dim starten als Doppelstart = Timer tun wenn Instr(RS232_IN,fSTR) <> 0 Dann zurück 6
Wenn Instr(RS232_IN,fSTR1) <> 0 Dann zurück 6
Schlafen 50, 1
Bis-Schleife (Timer - Start) > Timeout Return 5
EndFunction


E eine Parte de teste:

RS232_COMM = "COM11: 57600,N,8,1,BIN,DS0"
Drucken "ein Tentar Abrir ein com11"
Drucken RS232_ERR_STR(RS232_OPEN)
RS232_OUT = "AT" + Chr(10,13)
Drucken RS232_ERR_STR(RS232_SEND(20))
Drucken RS232_ERR_STR(RS232_GET_STR("Okay",1))
Drucken drucken RS232_GET RS232_OUT getan = "ATZ0"  + Chr(13,10)
Drucken RS232_ERR_STR(RS232_SEND(20))
Drucken RS232_ERR_STR(RS232_GET_STR("Okay",1))
Druck Print RS232_GET Print getan "Desliga o usb"
RS232_OUT schlafen = "AT" + Chr(10,13)
Drucken RS232_ERR_STR(RS232_SEND(20))
Drucken RS232_ERR_STR(RS232_GET_STR("Okay",10))
Rs232_close Schlaf


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 🙂

Schlagwörter: , , , , , , , ,