Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
' Werte definieren
Public StDatei$ ' Steuerdatei
Public woTA$ ' Wochentag
Public v_TA$ ' von Tag
Public v_MO$ ' von Monat
Public vSTU$ ' von Stunde
Public vMIN$ ' von Minute
Public b_TA$ ' bis Tag
Public b_MO$ ' bis Monat
Public bSTU$ ' bis Stunde
Public bMIN$ ' bis Minute
Public jetztWTG$ ' jetzt Wochentag
Public jetzt_TA$ ' jetzt Tag
Public jetzt_MO$ ' jetzt Monat
Public jetztSTU$ ' jetzt Stunde
Public jetztMIN$ ' jetzt Minute
Public jetztSEK$
' Wochentag
' 1 Sontag
' 2 Montag
' 3 Dienstag
' 4 Mittwoch
' 5 Donnerstag
' 6 Freitag
' 7 Samstag
' Ton bei ON
Function OP_ON()
Beep 1000, 50
Beep 1500, 50
End Function
' Ton bei OFF
Function OP_OFF()
Beep 500, 50
Beep 750, 50
Beep 1000, 50
End Function
Function DateiCheck()
Dim SI As Integer
StDatei = App.Path & "\crontab.txt"
SI = FreeFile
If Dir(StDatei) = "" Then
Open StDatei For Output As #SI
Print #SI, "#"
Print #SI, "# Datum-Zeit-Steuerung"
Print #SI, "#"
Print #SI, "* * * * * * * * *"
Close #SI
End If
Call WerteLesen
End Function
Function WerteLesen()
If Mid(Time, 7, 2) = "00" Then ' nachfolgene Optionen nur zur vollen Minute auslösen
Dim TXT As String
Dim SI As Integer
Dim Zeile() As String
Dim ZZ() As String
SI = FreeFile
' Text Zeilenweise einlesen
Open StDatei For Input As #SI
Do While Not EOF(SI)
Input #SI, TXT
Zeile = Split(TXT, vbNewLine)
' Zeilen mit # oder Leerezeilen inorieren
If Left(Zeile(SI - 1), 1) <> "#" And Left(Zeile(SI - 1), 1) <> "" Then
ZZ = Split(Zeile(SI - 1), " ")
woTA = ZZ(0)
v_TA = ZZ(1)
v_MO = ZZ(2)
vSTU = ZZ(3)
vMIN = ZZ(4)
b_TA = ZZ(5)
b_MO = ZZ(6)
bSTU = ZZ(7)
bMIN = ZZ(8)
Call DatumUhrzeitTimer
End If
DoEvents
Loop
Close #SI
End If
End Function
Function DatumUhrzeitTimer()
' aktuell Datum und Zeit ermitteln
jetztWTG = Weekday(Date)
jetzt_TA = Mid(Date, 1, 2)
jetzt_MO = Mid(Date, 4, 2)
jetztSTU = Mid(Time, 1, 2)
jetztMIN = Mid(Time, 4, 2)
' ausschalten
If bMIN = jetztMIN Or bMIN = "*" Then
If bSTU = jetztSTU Or bSTU = "*" Then
If woTA = jetztWTG Or woTA = "*" Then
If b_TA = jetzt_TA Or b_TA = "*" Then
If b_MO = jetzt_MO Or b_MO = "*" Then
DatumUhrzeitTimer = 0
Protokoll ("OFF"): OP_OFF ' Kontrolle
Timer.opAK.Value = 0 ' Kontrolle
End If
End If
End If
End If
End If
' einschalten
If vMIN = jetztMIN Or vMIN = "*" Then
If vSTU = jetztSTU Or vSTU = "*" Then
If woTA = jetztWTG Or woTA = "*" Then
If v_TA = jetzt_TA Or v_TA = "*" Then
If v_MO = jetzt_MO Or v_MO = "*" Then
DatumUhrzeitTimer = 1
Protokoll ("ON"): OP_ON ' Kontrolle
Timer.opAK.Value = 1 ' Kontrolle
End If
End If
End If
End If
End If
End Function
Function Protokoll(wert As String)
Dim SI As Integer
Dim TXT As String
TXT = App.Path & "\protokoll.txt"
SI = FreeFile
Open TXT For Append As #SI
Print #SI, Date & " - " & Time & " - " & wert
Close #SI
End Function
