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:
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
slave:
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
Lesezeichen