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