' Endarbeit : Zutritskontrolle per Transponder
'
' 26_02_2010
'
' Mike Dupont
'
'*******************************************************************************
'
'
'
'*******************************************************************************
'
'
'
$regfile = "m32def.dat"
$crystal = 3686400 'Quarz: 3.6864 MHz
$baud = 9600 'Baudrate der UART: 9600
Ddrd = &HFE
Config Sda = Portc.1 '' I2C Bus konfigurieren
Config Scl = Portc.0
Const Ds1307w = &HD0 '' Addresse der Ds1307 Uhr
Const Ds1307r = &HD1
Config Lcdpin = Pin , Db4 = Portc.4 , Db5 = Portc.5 , Db6 = Portc.6 , Db7 = Portc.7 , E = Portc.3 , Rs = Portc.2
Config Lcd = 16 * 2
Cursor Off Noblink
Config Clock = User '' Interne Time/Date Routinen für Bascom konfigurieren
Config Date = Dmy , Separator = .
Ddrb.1 = 1
Cls 'Lösche LCD Anzeige
Dim Zahl As Byte , I As Byte 'Definiere Variable (Zahl,I) als Byte
Dim S As String * 11 'Definiere S als Textreihe
S = "" 'Inhalt der Textreihe (S) ist leer
Cls
Cursor Noblink
Cursor Off
Waitms 300 'LCD muss sich Inizialisieren
Do 'Endlosschleife
Portd.7 = 1 'nur zum test eine LED
Locate 1 , 8 : Lcd Date$
Locate 2 , 8 : Lcd Time$
Locate 2 , 1 'Setze LCD Cursor auf Position 2,1
Zahl = Inkey() '
If Zahl = 2 Then Goto Bilde Else Goto Raus 'Wenn Startbyte(2) gelesen wird gehe zu Bilde sonst zu Raus
Bilde: 'Schleife Bilde
While Zahl <> 4 'While schleife so lange wie Zahl verschieden von 4 ist
Zahl = Inkey() '
Lcd Zahl
If Zahl <> 4 Then S = S + Chr(zahl) 'Nachkontrolle <> 4,wenn ja dann erhält S ein weiteres Zeichen
Wend 'Ende der While schleife (endet wenn Zahl = 4)
Raus: 'Schleife
Portd.7 = 0 'nur zum test eine LED
If S = "R0A88A02DDB" Then 'Wenn die Zahlenreihe gleich "R0A88A02DDB" ist, dann
Cls 'Lösche LCD Anzeige
Locate 1 , 1 'Setze LCD Cursor auf Position 1,1
Lcd "Bill" 'Schreibe "Dupont" auf Lcd
Locate 2 , 1 'Setze LCD Cursor auf Position 2,1
Lcd S 'Schreibe den Inhalt von S auf Lcd
Wait 4 'Warte 4 Sekunden
Cls
End If 'Ende der If schleife
If S = "R029980AD46" Then 'Wenn die Zahlenreihe gleich "R029980AD46" ist, dann
Cls 'Lösche LCD Anzeige
Locate 1 , 1 'Setze LCD Cursor auf Position 1,1
Lcd "Vanessa" 'Schreibe "Person 1" auf Lcd
Locate 2 , 1 'Setze LCD Cursor auf Position 2,1
Lcd S 'Schreibe den Inhalt von S auf Lcd
Wait 4 'Warte 4 Sekunden
Cls
End If 'Ende der If schleife
If S = "R83D9A08DD5" Then 'wenn Die Zahlenreihe Gleich "R83D9A08DD5" ist, dann
Cls 'Lösche LCD Anzeige
Locate 1 , 1 'Setze LCD Cursor auf Position 1,1
Lcd "Cindy" 'Schreibe "Person 2" auf Lcd
Locate 2 , 1 'Setze LCD Cursor auf Position 2,1
Lcd S 'Schreibe den Inhalt von S auf Lcd
Wait 4 'Warte 4 Sekunden
Cls
End If
S = "" 'Inhalt der Textreihe (S) ist leer
Loop
'Unterprogramme Für Die Bascom Date / Time -funktionen
Dim Weekday As Byte
Getdatetime:
I2cstart
I2cwbyte Ds1307w
I2cwbyte 0
I2cstart
I2cwbyte Ds1307r
I2crbyte _sec , Ack
I2crbyte _min , Ack
I2crbyte _hour , Ack
I2crbyte Weekday , Ack
I2crbyte _day , Ack
I2crbyte _month , Ack
I2crbyte _year , Nack
I2cstop
_sec = Makedec(_sec) : _min = Makedec(_min) : _hour = Makedec(_hour)
_day = Makedec(_day) : _month = Makedec(_month) : _year = Makedec(_year)
Return
Setdate:
_day = Makebcd(_day) : _month = Makebcd(_month) : _year = Makebcd(_year)
I2cstart
I2cwbyte Ds1307w
I2cwbyte 4
I2cwbyte _day
I2cwbyte _month
I2cwbyte _year
I2cstop
Return
Settime:
_sec = Makebcd(_sec) : _min = Makebcd(_min) : _hour = Makebcd(_hour)
I2cstart
I2cwbyte Ds1307w
I2cwbyte 0
I2cwbyte _sec
I2cwbyte _min
I2cwbyte _hour
I2cstop
Return
End