Code:
	'######################################################################
'DCFFunkuhr.bas
'
'Ein  Testprogramm für die Universalplatine RN-AVR UNIVERSAL
'
'Das Programm zeigt wie man per Funk die Uhrzeit ermittelt und verifiziert
'Dazu muss ein einfaches DCF Funkmodul an Pin PD3 angeschlossen werden
'
' (c) Frank Brall 2013
'Software und RN-AVR UNIVERSAL Bezug über www.robotikhardware.de DVD
'Weitere Beispiele auf DVD von robotikhardware.de
'oder im www.Roboternetz.de und rn-wissen.de
'
'Dieses Programm darf als Open Source frei verwendet werden, wenn
'das die oberen Copyright Zeilen vollständig in andere Projekt
'Dokumentationen und Sourcecode übernommen werden.
'
'######################################################################
'Portbelegung bzw. Modulverbindung
'DCF-Signal PD3 (Int1)
'LCD an folgenden PIns
'DB7   PC7
'DB6   PC6
'DB5   PC5
'DB4   PC4
'RS    PC3
'E     PC2
'Licht PD7
'Infos DCF  http://www.ptb.de/cms/fileadmin/inte...009_Heft_3.pdf
 
Declare Sub Funkuhraktivieren()
Declare Sub Funkuhrzeitauswerten()
Declare Sub Funkuhrzeitausgeben()
Declare Function Dcf_decodiere(byval Bitnr As Byte , Byval Bitanzahl As Byte , Byval Paritaet As Byte) As Integer
Declare Function Dcf_checkparitaet(byval Bitnr As Byte , Byval Bitanzahl As Byte) As Integer
$programmer = 12                                            'MCS USB  (Zeile weglassen wenn anderer Programmer)
$prog &HFF , &HFF , &HD9 , &HFE                             'Fusebits richtig programmieren (Quarz ein,Jtag aus)
$regfile = "m644def.dat"
$framesize = 32
$swstack = 32
$hwstack = 64
$crystal = 8000000                                          'QuarzFrequenzuenz
$baud = 9600
Baud = 9600
'******************************************* Definitionen  für Funkuhr ****************************************
Config Pind.3 = Input
Portd.3 = 1
Dcfsignal Alias Pind.3                                      'Pin an dem Funkuhr hängt
Dim I As Integer
Dim N As Integer
Dim Q As Integer                                            ' Zaehler der im Interrupt genutzt wird
Dim Timestamp As Long                                       'gerechnet ab aktivierung des geräetes
Dim Uhr_10ms As Integer
Dim Uhr_sek As Integer
Dim Uhr_min As Integer
Dim Uhr_std As Integer
Dim Datum_tag As Integer
Dim Datum_monat As Integer
Dim Datum_jahr As Integer
Dim Datum_wochentag As Integer
Dim Dcfuhrok As Byte
Uhr_min_ok Alias Dcfuhrok.0                                 'wird 1 wenn Wert verifiziert wurde
Uhr_std_ok Alias Dcfuhrok.1
Datum_tag_ok Alias Dcfuhrok.2
Datum_monat_ok Alias Dcfuhrok.3
Datum_jahr_ok Alias Dcfuhrok.4
Datum_wochentag_ok Alias Dcfuhrok.5
Bit6 Alias Dcfuhrok.6
Bit7 Alias Dcfuhrok.7
 
' Meine Timer
Dim Dcf_ms_time As Integer                                  'Zählt vergangenen ms
Dim Dcfsignal_ms As Integer                                 'ca. 100ms LOW Bit ca. 200ms High Bit
Dim Dcfmerkesignal_ms As Integer
Dim Dcfsignalabstand_ms As Integer
Dim Dcfflanke As Bit                                        '0 = fallend 1 = steigend
Dim Dcfsignalbit As Bit
Dim Dcfbits(61) As Byte                                     ' alle 60 empfangenen Bits
Dim Merkedcfbits(61) As Byte                                ' alle 60 empfangenen Bits
Dim Dcfbitsauswerten As Byte                                ' 1 wenn dcfbits vollständig in  Merkedcfbits kopiert wurden und noch nicht ausgewertet wurden
Dim Dcfnextbit As Integer                                   ' Nummer des nächsten Bits wenn 0 dann bit nicht notieren
Dim Dcfminutenanzahl As Byte                                'Gibt an wie oft eine vollständige DCF Signalrunde (1Min) geprueft wurde
Dim Dcffunkuhrstatus As Byte                                ' 0=Kein guter Empfang
                                                             ' 1=Warte auf Minutenbeginn
                                                             ' 2=Signalstart gefunden Minute wird nun aufgezeichnet
                                                             ' 3=Uhrzeit wird verifiziert
                                                             ' 4=Fertig - Uhrzeit korrekt erkannt
Dim Dcfempfangsqualitaet As Byte                            '0 = Schlecht 1 = Gut
 
Dim Dcfwert As Integer                                      'Wird bei dcf auswertung gebraucht
Dim Dcflong As Long                                         'Wird bei dcf auswertung gebraucht
'******************************************* ENDE Code für Funkuhr ****************************************
 
'LCD
Config Pind.7 = Output                                      'Spannung an LCD aktivieren
Lcdpower Alias Portd.7
Lcdpower = 1                                                'Licht an
Config Lcd = 20 * 4 , Chipset = Ks077
Config Lcdpin = Pin , Db4 = Portc.4 , Db5 = Portc.5 , Db6 = Portc.6 , Db7 = Portc.7 , E = Portc.2 , Rs = Portc.3
Config Lcdbus = 4
Initlcd
Cls
' ********* HAUPTPROGRAMM ************
Config Pind.6 = Output                                      'LED
Led1 Alias Portd.6
Led1 = 0                                                    'ein
Call Funkuhraktivieren
Do
   If Dcfbitsauswerten = 1 Then Funkuhrzeitauswerten        'Bits auswerten
 
  Funkuhrzeitausgeben
  Wait 1
Loop
 
 
 
'******************************************* Code für Funkuhr ****************************************
Sub Funkuhraktivieren()
 Dcffunkuhrstatus = 1
 Dcfempfangsqualitaet = 0
 Dcfminutenanzahl = 0
 Dcfnextbit = 0
 Dcfbitsauswerten = 0
 Dcfuhrok = 0
 Config Int1 = Falling
 On Int1 Int1_int
 Config Timer0 = Timer , Prescale = 1024
 On Timer0 Timer0_int
 Timer0 = 178
 Enable Int1
 Enable Timer0
 Enable Interrupts
End Sub
'ueberprueft die paritaet eine Bitfolge, das letzte Bit muss paritaetsbit sein
'ist paritaet ok dann ruckgabe 1 ansonsten -1
Function Dcf_checkparitaet(byval Bitnr , Byval Bitanzahl)
   Local T As Integer
   Local Anz_einsen As Byte
   Local Pari As Byte
   Incr Bitnr                                               'Um 1 herabsetzen da bei uebergabe 0 mitgezaehlt wird
   Anz_einsen = 0
   For T = 1 To Bitanzahl
       If Merkedcfbits(bitnr) > 0 Then Incr Anz_einsen
       Incr Bitnr
   Next T
   Pari = Anz_einsen.0                                      'Gerade=0 ungerade=1
   Dcf_checkparitaet = 1
   If Pari = 1 Then Dcf_checkparitaet = -1
End Function
'Uebernimmt an angebener Stelle die Bitinformation und wandelt in dezimal
'wenn paritaet=1 dann wird diese mit nachfolgendem Bit verglichen
'bei fehler wird -1 zurückgebenen
Function Dcf_decodiere(byval Bitnr , Byval Bitanzahl , Byval Paritaet)
   Local T As Integer
   Local Wert As Byte
   Local Summe As Byte
   Local Anz_einsen As Byte
   Local Pari As Byte
   Incr Bitnr                                               'Um 1 herabsetzen da bei uebergabe 0 mitgezaehlt wird
   Anz_einsen = 0
   Summe = 0
   Restore Bcdzahl
   For T = 1 To Bitanzahl
       Read Wert
       If Merkedcfbits(bitnr) > 0 Then
         Incr Anz_einsen
         Summe = Summe + Wert
       End If
       Incr Bitnr
   Next T
   Dcf_decodiere = Summe
   If Paritaet = 1 Then                                     'wenn parität geprüft werden soll
     If Merkedcfbits(bitnr) > 0 Then Incr Anz_einsen        'paritaetsbit hinzuzaehlen
     Pari = Anz_einsen.0                                    'Gerade=0 ungerade=1
     If Pari = 1 Then Dcf_decodiere = -1
   End If
End Function
'DCFBits auswerten
Sub Funkuhrzeitauswerten()
   Uhr_sek = 0
   If Uhr_min_ok = 0 Then
      Dcfwert = Dcf_decodiere(21 , 7 , 1)
      If Dcfwert <> -1 Then
          If Dcfwert = Uhr_min Then
            Uhr_min_ok = 1
          Else
            Uhr_min = Dcfwert
          End If
      End If
   End If
   If Uhr_std_ok = 0 Then
      Dcfwert = Dcf_decodiere(29 , 6 , 1)
      If Dcfwert <> -1 Then
          If Dcfwert = Uhr_std Then
            Uhr_std_ok = 1
          Else
            Uhr_std = Dcfwert
          End If
      End If
   End If
 
   Dcfwert = Dcf_checkparitaet(36 , 23)
   If Dcfwert = 1 Then
      If Datum_tag_ok = 0 Then
         Dcfwert = Dcf_decodiere(36 , 6 , 0)
         If Dcfwert <> -1 Then
             If Dcfwert = Datum_tag Then
               Datum_tag_ok = 1
             Else
               Datum_tag = Dcfwert
             End If
         End If
      End If
      If Datum_monat_ok = 0 Then
         Dcfwert = Dcf_decodiere(45 , 5 , 0)
         If Dcfwert <> -1 Then
             If Dcfwert = Datum_monat Then
               Datum_monat_ok = 1
             Else
               Datum_monat = Dcfwert
             End If
         End If
      End If
      If Datum_jahr_ok = 0 Then
         Dcfwert = Dcf_decodiere(50 , 8 , 0)
         If Dcfwert <> -1 Then
             If Dcfwert = Datum_jahr Then
               Datum_jahr_ok = 1
             Else
               Datum_jahr = Dcfwert
             End If
         End If
      End If
      If Datum_wochentag_ok = 0 Then
         Dcfwert = Dcf_decodiere(42 , 3 , 0)
         If Dcfwert <> -1 Then
             If Dcfwert = Datum_wochentag Then
               Datum_wochentag_ok = 1
             Else
               Datum_wochentag = Dcfwert
             End If
         End If
      End If
   End If
  Locate 1 , 1
  If Uhr_min_ok = 1 Then Lcd "Min_OK ";
  If Uhr_std_ok = 1 Then Lcd "Std_OK ";
 
  If Dcfuhrok = &B111111 Then
     Dcffunkuhrstatus = 4
     Locate 1 , 1
     Disable Int1                                           'Funkuhrinterrupt abstellen da zeit ja gelesen
     Lcd "Uhrzeit komplett ok"
  End If
  Dcfbitsauswerten = 0                                      'ausgewertet
End Sub
 
Sub Funkuhrzeitausgeben()
Local H As String * 2
Local M As String * 2
Local S As String * 2
Local D As String * 2
Local Mo As String * 2
Local Ya As String * 2
Local Tag As String * 10
 'Status ausgeben
  Locate 1 , 1
  Select Case Dcffunkuhrstatus
    Case 0 : Lcd "Noch kein Empfang";
    Case 1 : Lcd "Signalstart suchen";
    Case 2 : Lcd "Uhrzeit empfangen...";
    Case 3 : Lcd "Uhrzeit pruefen ...";
    Case 4 : Lcd "Uhrzeit korrekt!    ";
              Tag = Lookupstr(datum_wochentag , Datatage)
              Locate 4 , 1
              Lcd Tag
  End Select
  Locate 2 , 1
  Lcd "Signal:" ;
  If Dcfempfangsqualitaet = 1 Then
    Lcd "gut     ";
  Else
    Lcd "schlecht";
  End If
  Lcd " R:" ; Dcfminutenanzahl ; " ";
 H = Str(uhr_std)
 H = Format(h , "00")
 M = Str(uhr_min)
 M = Format(m , "00")
 S = Str(uhr_sek)
 S = Format(s , "00")
 D = Str(datum_tag)
 D = Format(d , "00")
 Mo = Str(datum_monat)
 Mo = Format(mo , "00")
 Ya = Str(datum_jahr)
 Ya = Format(ya , "00")
 Locate 3 , 1
 Lcd H ; ":" ; M ; ":" ; S ; "  " ; D ; "." ; Mo ; "." ; Ya
End Sub
 
' Wird bei DCF Flankenwechsel aufgerufen
Int1_int:
   If Dcfflanke = 1 Then
      Config Int1 = Falling
       Dcfsignal_ms = Dcf_ms_time
       Dcfmerkesignal_ms = Dcf_ms_time
       Dcfflanke = 0
       If Dcfsignal_ms < 80 Then
         Dcfempfangsqualitaet = 0                           'Stoerung kein guter Empfang
         Dcfnextbit = 0                                     'auf neuen Anfang warten, hat keinen zweck mit der aktuellen Folge
       Else
         Dcfempfangsqualitaet = 1                           'Könnte Signal sein Doch Empfang?
       End If
       If Dcfnextbit > 0 And Dcfnextbit < 62 Then
         If Dcfsignal_ms < 110 Then
            Dcfsignalbit = 0
         Else
            Dcfsignalbit = 1
         End If
         Dcfbits(dcfnextbit) = Dcfsignalbit
'         Print "nextbit" ; Nextbit
         Incr Dcfnextbit
       End If
   Else
      Config Int1 = Rising
      Dcfsignalabstand_ms = Dcf_ms_time
      Dcfflanke = 1
      If Dcfsignalabstand_ms > 1100 Then                    'Minutenanfang
         If Dcfnextbit = 0 Then
           If Dcfminutenanzahl = 0 Then Dcffunkuhrstatus = 2
           Dcfnextbit = 1                                   'Erste Aufzeichnung von vorne beginnt
         Else
            Q = Memcopy(dcfbits(1) , Merkedcfbits(1) , 61)  'merke gelesesene dcfbits
            Dcfbitsauswerten = 1
            Incr Dcfminutenanzahl
            Dcffunkuhrstatus = 3
            Dcfnextbit = 1
         End If
      End If
   End If
   Dcf_ms_time = 0
Return
 
 
   'Wird alle 10 ms aufgerufen udn dient der zeitmessung während dem
   'Funkuhr DCF-Signal
Timer0_int:
   Dcf_ms_time = Dcf_ms_time + 10
   Incr Uhr_10ms
   If Uhr_10ms > 99 Then
      Uhr_10ms = 0
      Incr Uhr_sek
      Incr Timestamp
   End If
   If Uhr_sek > 59 Then
      Uhr_sek = 0
      Incr Uhr_min
   End If
   If Uhr_min > 59 Then
      Uhr_min = 0
      Incr Uhr_std
   End If
   If Uhr_std > 23 Then
      Uhr_std = 0
   End If
   Timer0 = 178
Return
'******************************************* ENDE Interrupts für Funkuhr ****************************************
Bcdzahl:
Data 1 , 2 , 4 , 8 , 10 , 20 , 40 , 80
Datatage:
Data "noch unbekannt" , "Montag" , "Dienstag" , "Mittwoch" , "Donnerstag" , "Freitag" , "Samstag" , "Sonntag"
 
						
Lesezeichen