Option Explicit 'alle variabler skal defineres

Dim transfer As Integer 'holder værdi til portkommunikaton
Dim ctrl_register As Integer 'gemmer oprindelig control register for dataport 378 Hex
Dim ctrl_port As Integer 'gemmer oprindelig control port for dataport 378 Hex

Dim break As Integer
Dim read As Byte 'læst data fra dataport
Dim action As String 'gemmer hændelse
Dim actionID As Byte 'gemmer hændelses ID nummer
Dim personnummer As Byte 'gemmer personnummer
Dim loopcount As Long 'Bruges til måling af timeout
Const timeout = 200000

Private Sub cmd_reset_Click()
    Unload Me 'lukker program
End Sub

Private Sub cmd_viewlog_Click()
    frm_pass.Visible = True 'viser formen til at gennemse logfil
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Out &H77A, ctrl_register 'sætter control register til oprindelig værdi
    Out &H37A, ctrl_port 'sætter control port til oprindelig værdi
End Sub

Private Sub txt_log_change() 'aktiveres når der skrives i teksboksen
    If Len(txt_log.Text) > 2000 Then 'indeholder tekstfeltet mere end 2000 tegn?
        break = InStr(1, txt_log.Text, vbNewLine) 'finder det første linjeskift fra venstre
        txt_log.Text = Right(txt_log.Text, Len(txt_log.Text) - break - 1) 'sletter den først skrevne linje
    End If
    txt_log.SelStart = Len(txt_log.Text) 'sørger for at hovedvinduet automatisk scroller ned og viser sidste aktivitet
End Sub

Private Sub Form_Load()

    ctrl_register = Inp(&H77A) 'læser fra control register
    transfer = ctrl_register + 32 'lægger 32 (bit5) til, for at sætte bit 5 til 1. 001 på bit 7:5 er Byte Mode
    Out &H77A, transfer 'skriver til control register
    
    ctrl_port = Inp(&H37A) 'læser fra control port
    transfer = ctrl_port + 32 'lægger 32 til, for at sætte bit5 til høj
    Out &H37A, transfer 'skriver til control port
End Sub


Private Sub tmr_read_Timer() 'timeren kører med et interval på 80 ms
read = Inp(&H378) 'læser fra dataport
lbl_port.Caption = read 'skriver det læste til label
lbl_port.Refresh 'opdaterer label

If read = 1 Then 'startsignal fra PIC
    loopcount = 0 'loopen er kørt igennem 0 gange
    Do 'loopen kører indtil dataporten skifter eller loopen "timer out"
        read = Inp(&H378) 'læser fra dataport
        If read <> 1 Then 'der registreres en ændring i dataport
            Sleep (1) 'en pause på 1 ms sikrer at signalet har stabiliseret sig
            read = Inp(&H378) 'så læses porten igen
            If read > 6 Or read < 3 Then 'er det læste større end 6 eller mindre end 3 følger dataoverførslen ikke det fastlagte mønster
                txt_log.Text = txt_log.Text & "[" & Time & "] " & "Error: unexpected input" & vbNewLine 'fejlen skrives til log-vinduet
                Exit Sub 'transmissionen stoppes
            End If
            actionID = read - 2 'hvis der ikke er tale om et fejlsignal når programmet hertil og action ID er 2 mindre end selve signalet
            Exit Do 'programmet springer ud af do-loopen
        End If
        loopcount = loopcount + 1 'programmet har læst fra port endnu engang
        If loopcount > timeout Then 'har programmet læst for mange gange fra porten gives timeout
            txt_log.Text = txt_log.Text & "[" & Time & "] " & "Error: transmission timeout" & vbNewLine
            Exit Sub '...og afslutter aflæsingen
        End If
    Loop
        
    If actionID < 3 Then 'er det modtagede signal personbestemt?
        loopcount = 0
        Do
            read = Inp(&H378) 'læser fra port
            If read <> 3 And read <> 4 Then 'er signalet ændret?
                Sleep (1) 'stabiliseringstid
                read = Inp(&H378) 'ny læsning
                If read > 74 Or read < 10 Then 'er signalet > 74 eller < 10 er det tale om et fejlsignal
                    'fejlen rapporteres
                    txt_log.Text = txt_log.Text & "[" & Time & "] " & "Error: unexpected input" & vbNewLine
                    Exit Sub 'transmissionen afsluttes
                End If
                personnummer = read - 10 'ellers når programmet hertil, hvor personnummeret er 10 mindre end det læste
                Exit Do 'personnummer modtager og loopen kan afsluttes
            End If
            loopcount = loopcount + 1 'der erlæst endnu engang
            If loopcount > timeout Then 'timeout sikring
                txt_log.Text = txt_log.Text & "[" & Time & "] " & "Error: transmission timeout" & vbNewLine
                Exit Sub
            End If
        Loop
            
        If personnummer = 64 Then 'er personnummeret = 64 er der mulighed for, at man mangler at modtage 2. del af person ID
            loopcount = 0
            Do
                read = Inp(&H378) 'læses fra port i do loop...
                If read <> 74 Then '...indtil signalet ændres
                    Sleep (1) 'Der gives en stabiliseringstid på 1 ms...
                    read = Inp(&H378) '...hvorefter porten indlæses igen
                    If read = 2 Then 'er det læste = 2 har man modtaget hele personnummeret...
                        Exit Do '...og man kan springe ud af loopen
                    ElseIf read < 10 Or read > 74 Then 'er det læste < 10 er der fejl i protokollen
                        'og der gives en fejlmelding
                        txt_log.Text = txt_log.Text & "[" & Time & "] " & "Error: unexpected input" & vbNewLine
                        Exit Sub
                    End If
                    personnummer = read - 10 + personnummer 'personnummmeret er lig med det læste minus 10 + 1. del
                    Exit Do
                End If
                    
                loopcount = loopcount + 1
                If loopcount > timeout Then 'timeout sikring
                    txt_log.Text = txt_log.Text & "[" & Time & "] " & "Error: transmission timeout" & vbNewLine
                    Exit Sub
                End If
            Loop
        End If
    End If
   
    Select Case actionID 'skriver en hændelse (action) alt efter det modtagede action ID
        Case 1
            action = "[" & Time & "] " & "Person " & personnummer & ": Access granted"
        Case 2
            action = "[" & Time & "] " & "Person " & personnummer & ": Access denied"
        Case 3
            action = "[" & Time & "] " & "Door closed"
        Case 4
            action = "[" & Time & "] " & "Door opened from inside"
    End Select
        
    txt_log.Text = txt_log.Text & action & vbNewLine 'hændelsen skrives i tekstboksen
    
    Set db = OpenDatabase(App.Path & "\log.mdb", False, False, ";pwd=" & "RC1910") 'logdatabasen med koden RC1910 åbnes
    Set rs = db.OpenRecordset("tbl_log", dbOpenDynaset) 'databasens tabel åbnes
    With rs
        .AddNew 'et nyt recordset tilføjes
        !DateTime = Now 'tid og dato tilføjes
        !actionID = actionID 'actionID tilføjes
        If actionID < 3 Then
            !personID = personnummer 'personnummer tilføjes
        End If
        .Update 'gemmer rækken
    End With
End If
End Sub