Der Code funktioniert, ist aber nicht komplett kommentiert und auch nicht aufgeräumt, da ich ihn nur schnell aus einem unfertigen projekt rauskopiert habe.
Aber als start sollte das reichen. Der Master ist auch "unbeffered".
Es wäre natürlich nett wenn wir auch wieder was von dem Hausautomationsprojekt hören oder quellcode bekommen.
Viel Spaß
Grüße Stefan
Master:
slave:Code:' *********** Snap *********************************** Dim Temp1 As Byte ' Temporäre Variable Dim Temp2 As Byte ' Temporäre Variable Dim Tmpw1 As Word Dim Tmpw2 As Word Dim Crc As Word ' CRC Word ' *********** Snap Ende ****************************** '############################################################################################ '################################### S.N.A.P. ############################################### '############################################################################################ ' -----[ Title ]------------------------------------------------------ ' ' File......: SNAP-IO.BAS ' Purpose...: Turns LEDs on and off ' Author....: Christer Johansson ' Version...: 1.01 ' Started...: 980503 ' Updated...: 980918 ' Modified..: 991229 by Claus Kuehnel ' -----[ Program Description ]---------------------------------------- ' ' This program shows how to implement the S.N.A.P protocol in ' BASCOM-AVR and is an simple example to turn LEDs ON or OFF. ' This example uses 16-bit CRC-CCITT as error detection method which ' gives secure data transfer. ' ' The packet structure is defined in the received packets first two ' bytes (HDB2 and HDB1). The following packet structure is used. ' ' DD=01 - 1 Byte destination address ' SS=01 - 1 Byte source address ' PP=00 - No protocol specific flags ' AA=01 - Acknowledge is required ' D=0 - No Command Mode ' EEE=100 - 16-bit CRC-CCITT ' NNNN=0010 - 2 Byte data ' ' Overview of header definition bytes (HDB2 and HDB1) ' ' HDB2 HDB1 ' +-----------------+-----------------+ ' | D D S S P P A A | D E E E N N N N | ' +-----------------+-----------------+ ' ' ' -----[ Initialization ]--------------------------------------------- Function Slave(command As Byte , Transfer As String , Adresse As Byte , Timeout As Byte)as String Const Crcpoly = &H1021 ' CRC-CCITT Const Preamble_x = &B01001101 ' Preamble byte Const Sbyte_x = &B01010100 ' Synchronisation byte Const Hdb2_x = &H52 '01010010 Const Hdb1_x = &H48 '10010000 Const Myaddress = 1 ' Node - Adresse Const Empfangen = 1 Const Senden = 0 Local Preamble As Byte ' Preamble byte Local Sbyte As Byte ' Sync byte Local Hdb1 As Byte ' Header Definition Byte 1 Local Hdb2 As Byte ' Header Definition Byte 2 Local Dab1 As Byte ' Für welche Node-ID ist das Paket Local Sab1 As Byte ' Wer sendet das Paket Local Db1 As Byte ' Paket Data Byte 1 Local Db2 As Byte ' Paket Data Byte 2 Local Db3 As Byte ' Paket Data Byte 3 Local Db4 As Byte ' Paket Data Byte 4 Local Db5 As Byte ' Paket Data Byte 5 Local Db6 As Byte ' Paket Data Byte 6 Local Db7 As Byte ' Paket Data Byte 7 Local Db8 As Byte ' Paket Data Byte 8 Local Crc2 As Byte ' Paket CRC Hi_Byte Local Crc1 As Byte ' Paket CRC Lo_Byte Local Received As Byte Local Dummy As String * 1 Adresse = 100 + Adresse Db1 = Command Dummy = Mid(transfer , 1 , 1) Db2 = Asc(dummy) Dummy = Mid(transfer , 2 , 1) Db3 = Asc(dummy) Dummy = Mid(transfer , 3 , 1) Db4 = Asc(dummy) Dummy = Mid(transfer , 4 , 1) Db5 = Asc(dummy) Dummy = Mid(transfer , 5 , 1) Db6 = Asc(dummy) Dummy = Mid(transfer , 6 , 1) Db7 = Asc(dummy) Dummy = Mid(transfer , 7 , 1) Db8 = Asc(dummy) Select Case Timeout Case 1: $timeout = 1000000 Case 2: $timeout = 2000000 Case 3: $timeout = 3000000 Case 4: $timeout = 4000000 Case Else $timeout = 5000000 End Select Preamble = Preamble_x Sbyte = Sbyte_x Sab1 = Myaddress Dab1 = Adresse Hdb1 = Hdb1_x Hdb2 = Hdb2_x Crc = 0 Temp1 = Hdb2 Gosub Calc_crc Temp1 = Hdb1 Gosub Calc_crc Temp1 = Dab1 Gosub Calc_crc Temp1 = Sab1 Gosub Calc_crc Temp1 = Db8 Gosub Calc_crc Temp1 = Db7 Gosub Calc_crc Temp1 = Db6 Gosub Calc_crc Temp1 = Db5 Gosub Calc_crc Temp1 = Db4 Gosub Calc_crc Temp1 = Db3 Gosub Calc_crc Temp1 = Db2 Gosub Calc_crc Temp1 = Db1 Gosub Calc_crc Crc2 = High(crc) ' Move calculated Hi_CRC value to outgoing packet Crc1 = Low(crc) ' Move calculated Lo_CRC value to outgoing packet Waitms 10 ' Send packet to master, including the preamble and SYNC byte Printbin #2 , Preamble ; Sbyte ; Hdb2 ; Hdb1 ; Dab1 ; Sab1 Printbin #2 , Db8 ; Db7 ; Db6 ; Db5 ; Db4 ; Db3 ; Db2 ; Db1 Printbin #2 , Crc2 ; Crc1 Do Received = Waitkey(#2) If Received = 0 Then Exit Function If Received = Sbyte_x Then Inputbin #2 , Hdb2 , Hdb1 , Dab1 , Sab1 , Db8 , Db7 , Db6 , Db5 , Db4 , Db3 , Db2 , Db1 , Crc2 , Crc1 ' Get packet in binary mode Goto Packet Else Preamble = Received End If Loop Packet: If Hdb2 <> Hdb2_x Then Locate 3 , 1 Lcd "hdb2 nicht ok" Exit Function End If If Hdb1 <> Hdb1_x Then Locate 3 , 1 Lcd "hdb1 nicht ok" Exit Function End If If Dab1 <> Myaddress Then Locate 3 , 1 Lcd "adresse nicht ok" Exit Function End If Locate 3 , 1 Lcd "crccheck" Crc = 0 Temp1 = Hdb2 Gosub Calc_crc Temp1 = Hdb1 Gosub Calc_crc Temp1 = Dab1 Gosub Calc_crc Temp1 = Sab1 Gosub Calc_crc Temp1 = Db8 Gosub Calc_crc Temp1 = Db7 Gosub Calc_crc Temp1 = Db6 Gosub Calc_crc Temp1 = Db5 Gosub Calc_crc Temp1 = Db4 Gosub Calc_crc Temp1 = Db3 Gosub Calc_crc Temp1 = Db2 Gosub Calc_crc Temp1 = Db1 Gosub Calc_crc Temp1 = Crc2 Gosub Calc_crc Temp1 = Crc1 Gosub Calc_crc If Crc <> 0 Then Locate 3 , 1 Lcd "crc nok" Exit Function ' Goto Nak ' Check if there was any CRC errors, if so send NAK End If '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Ack_: ' Send ACK (i.e tell master that packet was OK) Hdb2 = Hdb2 Or &B00000010 ' Set ACKs bit in HDB2 (xxxxxx10) Hdb2 = Hdb2 And &B11111110 Goto Send Nak: ' Send NAK (i.e tell master that packet was bad) Hdb2 = Hdb2 Or &B00000011 ' Set ACK bits in HDB2 (xxxxxx11) Goto Send Send: Waitms 50 ' Swap SAB1 <-> DAB1 address bytes Temp2 = Sab1 Sab1 = Dab1 Dab1 = Temp2 Check_crc , Senden Crc2 = High(crc) ' Move calculated Hi_CRC value to outgoing packet Crc1 = Low(crc) ' Move calculated Lo_CRC value to outgoing packet ' Send packet to master, including the preamble and SYNC byte Preamble = Preamble_x Printbin Preamble ; Sbyte ; Hdb2 ; Hdb1 ; Dab1 ; Sab1 Printbin Db8 ; Db7 ; Db6 ; Db5 ; Db4 ; Db3 ; Db2 ; Db1 Printbin Crc2 ; Crc1 ' Goto _start ' Done, go back to Start and wait for a new packet Slave = Chr(db1) + Chr(db2) + Chr(db3) + Chr(db4) + Chr(db5) + Chr(db6) + Chr(db7) + Chr(db8) End Function
Code:' -----[ Title ]------------------------------------------------------ ' ' File......: SNAP-IO.BAS ' Purpose...: Turns LEDs on and off ' Author....: Christer Johansson ' Version...: 1.01 ' Started...: 980503 ' Updated...: 980918 ' Modified..: 991229 by Claus Kuehnel ' -----[ Program Description ]---------------------------------------- ' ' This program shows how to implement the S.N.A.P protocol in ' BASCOM-AVR and is an simple example to turn LEDs ON or OFF. ' This example uses 16-bit CRC-CCITT as error detection method which ' gives secure data transfer. ' ' The packet structure is defined in the received packets first two ' bytes (HDB2 and HDB1). The following packet structure is used. ' ' DD=01 - 1 Byte destination address ' SS=01 - 1 Byte source address ' PP=00 - No protocol specific flags ' AA=01 - Acknowledge is required ' C=0 - No Command Mode ' EEE=100 - 16-bit CRC-CCITT ' NNNN=1000 - 8 Byte data ' ' Overview of header definition bytes (HDB2 and HDB1) ' ' HDB2 HDB1 ' +-----------------+-----------------+ ' | D D S S P P A A | C E E E N N N N | ' +-----------------+-----------------+ ' ' ' *********** SNAP ********************************** Const Preamble_x = &B01010011 ' Preamble byte Const Sbyte = &B01010100 ' Synchronisation byte Const Crcpoly = &H1021 ' CRC-CCITT Const Hdb2_x = &H52 '01010010 Const Hdb1_x = &H48 '01001000 Const Empfangen = 1 Const Senden = 0 ' *********** 1-Wire Sensoren ************************ Dim Temp_aussen As Integer ' *********** Ende 1-Wire Sensoren ******************* Dim A As Byte 'Zähler für For...Next und die Bus-Arrays Dim Bytearray(4) As Byte 'Bytearray für allgemeine Nutzung Dim Transfer As String * 8 '*********** SNAP ************************************ Dim Adresse As Byte ' Node - Adresse Dim Preamble As Byte ' Preamble byte Dim Lastbyte As Byte Dim Hdb1 As Byte ' Header Definition Byte 1 Dim Hdb2 As Byte ' Header Definition Byte 2 Dim Dab1 As Byte ' Für welche Node-ID ist das Paket Dim Sab1 As Byte ' Wer sendet das Paket Dim Db1 As Byte ' Paket Data Byte 1 Dim Db2 As Byte ' Paket Data Byte 2 Dim Db3 As Byte ' Paket Data Byte 3 Dim Db4 As Byte ' Paket Data Byte 4 Dim Db5 As Byte ' Paket Data Byte 5 Dim Db6 As Byte ' Paket Data Byte 6 Dim Db7 As Byte ' Paket Data Byte 7 Dim Db8 As Byte ' Paket Data Byte 8 Dim Crc2 As Byte ' Paket CRC Hi_Byte Dim Crc1 As Byte ' Paket CRC Lo_Byte Dim Received As Byte ' Temporäre Variable Dim Temp1 As Byte Dim Temp2 As Byte ' Temporäre Variable Dim Crc As Word ' CRC Word Dim Tmpw1 As Word Dim Tmpw2 As Word Dim I As Integer Dim Dummy As String * 1 Declare Sub Check_crc(byval Modus As Byte) '******************* Schnittstellen, LCD, usw ******** Config Com1 = Dummy , Synchrone = 0 , Parity = None , Stopbits = 1 , Databits = 8 , Clockpol = 0 ' MUST MATCH THE SLAVE Rs485dir Alias Portd.2 Config Print = Portd.2 , Mode = Set ' use portb.1 for the direction Config Rs485dir = Output Rs485dir = 0 ' go to receive mode Config Portc.0 = Input Config Portc.1 = Input Config Portc.2 = Input Portc.0 = 1 Portc.1 = 1 Portc.2 = 1 If Adresse = 0 Then Adresse = 100 If Pinc.0 = 0 Then Adresse = Adresse + 2 If Pinc.1 = 0 Then Adresse = Adresse + 4 If Pinc.2 = 0 Then Adresse = Adresse + 8 End If '------[ Program ]---------------------------------------------------- Print "node up" Do Received = Waitkey() If Received = Sbyte Then Inputbin Hdb2 , Hdb1 , Dab1 , Sab1 , Db8 , Db7 , Db6 , Db5 , Db4 , Db3 , Db2 , Db1 , Crc2 , Crc1 ' Get packet in binary mode Gosub Packet Else Preamble = Received End If Loop End Packet: If Hdb2 <> Hdb2_x Then Print "hdb2 nicht ok" Return End If If Hdb1 <> Hdb1_x Then Print "hdb1 nicht ok" Return End If If Dab1 <> Adresse Then Print "adresse nicht ok" Return End If Print "crccheck" Check_crc , Empfangen ' Check CRC for all the received bytes If Crc <> 0 Then Print "crc nok" Goto Nak ' Check if there was any CRC errors, if so send NAK End If ' No CRC errors in packet so check what to do. ' Associated Function (place it between +++ lines) '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Transfer = Chr(db2) + Chr(db3) + Chr(db4) + Chr(db5) + Chr(db6) + Chr(db7) + Chr(db8) Select Case Db1 Print "prepare data" Case 50: Goto $0c00 Case 10: #if Devel Print "Temperatur!!!" 'Gosub Temperatur Print "TWI:" ; Twi Print "Register:" ; Str(register) Print "twi_btw:" ; Str(twi_btw) #endif Gosub Temperatur ' Transfer = Temperatur$ Case Else Print "command: " ; Db1 End Select Dummy = Mid(transfer , 1 , 1) Db1 = Asc(dummy) Dummy = Mid(transfer , 2 , 1) Db2 = Asc(dummy) Dummy = Mid(transfer , 3 , 1) Db3 = Asc(dummy) Dummy = Mid(transfer , 4 , 1) Db4 = Asc(dummy) Dummy = Mid(transfer , 5 , 1) Db5 = Asc(dummy) Dummy = Mid(transfer , 6 , 1) Db6 = Asc(dummy) Dummy = Mid(transfer , 7 , 1) Db7 = Asc(dummy) Dummy = Mid(transfer , 8 , 1) Db8 = Asc(dummy) '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Ack_: ' Send ACK (i.e tell master that packet was OK) Hdb2 = Hdb2 Or &B00000010 ' Set ACKs bit in HDB2 (xxxxxx10) Hdb2 = Hdb2 And &B11111110 Goto Send Nak: ' Send NAK (i.e tell master that packet was bad) Hdb2 = Hdb2 Or &B00000011 ' Set ACK bits in HDB2 (xxxxxx11) Goto Send Send: Waitms 50 ' Swap SAB1 <-> DAB1 address bytes Temp2 = Sab1 Sab1 = Dab1 Dab1 = Temp2 Check_crc , Senden Crc2 = High(crc) ' Move calculated Hi_CRC value to outgoing packet Crc1 = Low(crc) ' Move calculated Lo_CRC value to outgoing packet ' Send packet to master, including the preamble and SYNC byte Preamble = Preamble_x Printbin Preamble ; Sbyte ; Hdb2 ; Hdb1 ; Dab1 ; Sab1 Printbin Db8 ; Db7 ; Db6 ; Db5 ; Db4 ; Db3 ; Db2 ; Db1 Printbin Crc2 ; Crc1 ' Goto _start ' Done, go back to Start and wait for a new packet Return ' -----[ Subroutines ]------------------------------------------------ ' 'Soubroutine for checking all received bytes in packet Sub Check_crc(modus As Byte) 'Const Empfangen = 1 'Const Senden = 0 Crc = 0 Temp1 = Hdb2 Gosub Calc_crc Temp1 = Hdb1 Gosub Calc_crc Temp1 = Dab1 Gosub Calc_crc Temp1 = Sab1 Gosub Calc_crc Temp1 = Db8 Gosub Calc_crc Temp1 = Db7 Gosub Calc_crc Temp1 = Db6 Gosub Calc_crc Temp1 = Db5 Gosub Calc_crc Temp1 = Db4 Gosub Calc_crc Temp1 = Db3 Gosub Calc_crc Temp1 = Db2 Gosub Calc_crc Temp1 = Db1 Gosub Calc_crc If Modus = Empfangen Then Temp1 = Crc2 Gosub Calc_crc Temp1 = Crc1 Gosub Calc_crc End If End Sub ' Subroutine for calculating CRC value in variable Tmp_Byte1 Calc_crc: Tmpw1 = Temp1 * 256 Crc = Tmpw1 Xor Crc For Temp2 = 0 To 7 If Crc.15 = 0 Then Goto Shift_only Tmpw2 = Crc * 2 Crc = Tmpw2 Xor Crcpoly Goto Nxt Shift_only: Crc = Crc * 2 Nxt: Next Return
Zitieren
Lesezeichen