http://dieseyer.de • all rights reserved • © 2011 v11.4
'*** v10.1 *** www.dieseyer.de *****************************
'
' Datei: terminemelden.vbs
' Autor: W. Schmelz
' Auf: www.dieseyer.de
'
'***********************************************************
'**************************************************************
' *
' Datei: " TermineMelden.vbs " *
' *
' Die neue Version verwendet keine komplizierten Objekte und *
' läuft darum in allen Win-Versionen ! Beim allerersten Start *
' wird die Datei nach "C:\Programme\Schmelz.W\TermineMelden" *
' kopiert, ein Link in den Desktop und in Autostart gesetzt! *
' Der "Link" im Autostart wird aber nur aktiv, wenn Meldungen *
' noch gespeichert sind und auszuführen oder zu löschen sind. *
' In "Programme\Schmelz.W" werden Protokolle der Aufträge ge- *
' speichert, die nach der Meldung gelöscht werden. Falls aber *
' " Leichen " durch Abschaltung oder Absturz verbleiben, kön- *
' nen diese auf Wunsch aus dem Programm her gelöscht werden ! *
' Wenn schon Meldungen laufen, so werden sie anfangs gezeigt! *
' Beim 1. Mal startet die "Suchschleife". Sie bleibt, solange *
' Meldungen da sind, in der Lauer, ob Datum und Zeit für eine *
' Meldung eingetreten sind. Die Melde- Aufträge werden danach *
' gelöscht ! Wegen der Bauweise kann man Datum, Zeit und Mel- *
' dung noch ändern - oder sie löschen! - Keinerlei Gewähr für *
' das korrekte Laufen des Programmes, d.h. verpasste Termine! *
' *
'**************************************************************
' CopyRight: W. Schmelz, 28.12.2009
'Objekte u.a. für das Programm bereit stellen:
'*********************************************
Set Wss=WScript.CreateObject("WScript.Shell")
Set Fso=WScript.CreateObject("Scripting.FileSystemObject")
WinDir=Wss.ExpandEnvironmentStrings("%WinDir%")
Dat0="C:\Programme\Schmelz.W\TermineMelden\"
Dat1="C:\Dokumente und Einstellungen\All Users"
DatX=Dat0&"TermineMelden.vbs"
Datei0=Dat0&"Termine\Meldung."&"h"&"t"&"a"
Datei01=Dat0&"Termine\Info."&"h"&"t"&"a"
DatSuch=Dat0&"Termine\SuchSchleife.txt"
AktVerz=Replace(WScript.ScriptFullName,WScript.ScriptName,"")
Titel=" Hier kommt der Wecker ! ! !"
UV=VbCR&VbCR
Dim Meldng, Zeile(), Zeil(), Datei0, DateiX, Meldg(), Schalt
Dim Multi, Numr, Melden, Korr, Produkt, Datei01, Zahl, Such
Dim Dat0, Dat1, DatX, AktVerz, XYZ, Lauf, Menge
'Die Ordner für das Programm anlegen:
'************************************
If not Fso.FolderExists("C:\Programme\Schmelz.W") then _
Fso.CreateFolder "C:\Programme\Schmelz.W", true
'" true " soll evtl. Schreibschutz aushebeln!
If not Fso.FolderExists("C:\Programme\Schmelz.W\TermineMelden") _
then Fso.CreateFolder "C:\Programme\Schmelz.W\TermineMelden"
If not Fso.FolderExists("C:\Programme\Schmelz.W\TermineMelden\Termine") _
then Fso.CreateFolder "C:\Programme\Schmelz.W\TermineMelden\Termine"
If not Fso.FolderExists ("C:\Programme\Schmelz.W\TermineMelden") then
MsgBox UV&UV&"Die Programmordner konnten nicht angelegt werden !"&_
" "&UV&UV,VbCritical,Titel:WScript.Quit
End If
'*************************************************************
' *
' Bei dem allerersten Start dieses "TermineMelden"-Programms *
' Datei nach C:\Programme\Schmelz.W\TermineMelden kopieren, *
' in den Autostart wird der Start dieses Programmes verlegt *
' und einen Link des Programmes in den " Desktop " gesetzt : *
' *
'*************************************************************
If not Fso.FileExists(DatX) then
'Nachfrage, ob Programm zu installieren ist:
'*******************************************
Txt=UV&UV&"Soll das Termin-Melde-Programm installiert werden ? "&_
UV&"Es kommt nach ""C:\Programme\Schmelz.W"", ein Link "&_
UV&"dazu auf den ""Desktop"" und einer in den ""Autostart"","&_
UV&"der bei noch bestehenden Meldungen tätig wird !"&UV&UV
Ask = MsgBox(Txt,VbOkCancel+VbDefaultButton1+VbQuestion,Titel )
Txt=UV&VbCR&VbTab&"Na gut , . . . dann halt nicht ! "&UV
If Ask=VbCancel then MsgBox Txt&VbCR,,Titel:WScript.Quit
'Autostart für Win98/ME und XP festlegen:
'****************************************
If not Fso.FolderExists(Dat1) then _
Autostart=WinDir&"\Startmenü\Programme\Autostart"
If Fso.FolderExists(Dat1) then _
Autostart=Wss.SpecialFolders("AllUsersStartup")
Start=Autostart&"\Termine.vbs"
Fso.CopyFile(WScript.ScriptFullName),(DatX)
WScript.Sleep 500
'Falls Datei nicht installiert werden kann:
'******************************************
If not Fso.FileExists(DatX) then WScript.Quit
'Datei für den "Autostart" schreiben:
'************************************
Set F=Fso.CreateTextFile(Start,true)
F.WriteLine(" ")
F.WriteLine(" Set Fso=WScript.CreateObject(""Scripting.FileSystemObject"") ")
F.WriteLine(" Set Wss=CreateObject(""Wscript.Shell"") ")
F.WriteLine(" ")
F.WriteLine(" WScript.Sleep 150000 ")
F.WriteLine(" ")
F.WriteLine(" Dat0=""C:\Programme\Schmelz.W\TermineMelden\"" ")
F.WriteLine(" DatX=Dat0&""TermineMelden.""&""v""&""b""&""s"" ")
F.WriteLine(" DatSuch=Dat0&""Termine\SuchSchleife.txt"" ")
F.WriteLine(" If Fso.FileExists(DatSuch) then Fso.DeleteFile(DatSuch) ")
F.WriteLine(" ")
F.WriteLine(" Set Ort=Fso.GetFolder(Dat0&""Termine"").Files ")
F.WriteLine(" For each File in Ort ")
F.WriteLine(" If Left(Fso.GetFileName(File),4)=""Weck"" then ")
F.WriteLine(" Kontrl=Dat0&""Termine\Start.txt"" ")
F.WriteLine(" Fso.CopyFile(File),(Kontrl) ")
F.WriteLine(" Wss.Run DatX ")
F.WriteLine(" WScript.Sleep 500 ")
F.WriteLine(" WScript.Quit ")
F.WriteLine(" End If ")
F.WriteLine(" Next ")
F.WriteLine(" ")
F.Close
Set F=Nothing
'Link in den Desktop setzen:
'***************************
Path=Wss.SpecialFolders("Desktop")
Set Lnk=Wss.CreateShortcut(Path&"\TermineMelden.lnk")
Lnk.TargetPath=Wss.ExpandEnvironmentStrings(DatX)
Lnk.Save
End If
'Wenn von anderer Stelle gestartet, übergehen in richtigen
'Ordner in Programme. Es wird von dort weiter gearbeitet !
'*********************************************************
If Fso.FileExists(DatX) then
If not AktVerz="C:\Programme\Schmelz.W\TermineMelden\" then
Wss.Run DatX
WScript.Sleep 500
WScript.Quit '"Falsche" Startdatei schließen!
End If
End If
'Wenn keine Meldungen, Suchdatei schließen:
'******************************************
Menge="0" 'Kontrolle, ob Meldungen laufen
For i=1 to 50
If Fso.FileExists(Dat0&"Termine\Wecker"&i&".txt") then Menge=1+Menge
Next
If Menge="0" then
If Fso. FileExists(DatSuch) then Fso.DeleteFile(DatSuch)
End If
'*****************************************************************
' *
' Falls die Datei "Meldung.h-t-a" noch nicht existiert: *
If not Fso.FileExists(Datei0) then '*
' ************************************ *
' Beim Start die folgenden H-t-a-Dateien erst schreiben und dann *
' laufen lassen. Die 1. zeigt Meldungen in "Programme\Schmelz.W" *
' Dieser Abschnitt endet bei etwa 80 % dieser Datei! ("###..##") *
' *
'*****************************************************************
'Welche Meldungen liegen schon vor?
'**********************************
Zahl="0"
i=1
Do until i>50
ReDim Preserve Meldg(i)
If Fso.FileExists(Dat0&"Termine\Wecker"&i&".txt") then
Zahl=1+Zahl 'Laufende Meldungen zählen
Set Data=Fso.OpenTextFile(Dat0&"Termine"&"\Wecker"&i&".txt")
k=1
Do until Data.AtEndOfStream
ReDim Preserve Zeile(k)
Zeile(k)=Data.ReadLine
k=k+1
Loop
Data.Close
Set Data=Nothing
'Meldungen lesen, Nr. für´s Sortieren zunächst nach hinten!
'**********************************************************
If Len(i)="1" then Ende="0"&i 'i ist Nr von Wecker*.txt
Txt=Right(Zeile(4),Len(Zeile(4)) - 28)
Meldg(Zahl)=Right(Zeile(3),6)&_
" um "&Mid(Zeile(4),4,9)&":"&Txt&" "&Ende
' Problem bei 1 Meldung, s. Sortieren
If Zahl="1" then Melden=Meldg(1)
End If
i=i+1
Loop
If Zahl>"1" then
'Meldg(i) alphabetisch sortieren:
'********************************
For a=1 to Zahl
For b=a+1 to Zahl
If Meldg(a)>Meldg(b) then
klm=Meldg(a)
Meldg(a)=Meldg(b)
Meldg(b)=klm
End if
Next
Next
'Nrn. nach vorne stellen, Liste erstellen:
'*****************************************
i=1
Do until i>Zahl
Meldg(i)=Right(Meldg(i),2)&": "&_
Left(Meldg(i),Len(Meldg(i))-2)
Text=Text&VbCR&Meldg(i)
i=i+1
Loop
End If
'Als Sonderfälle nötig : eine oder keine Meldung:
'************************************************
If Zahl="1" then
Melden=Right(Melden,2)&": "&Left(Melden,Len(Melden)-2)
Text=VbCR&Melden
End If
If Zahl="0" then Text=UV&_
" Keine Meldungen ! ! !"&VbCR
'Heutiges Datum, Wochentag ermitteln:
'************************************
Tag=Weekday(Date) 'Wochentag suchen!
Select Case Tag
Case "1" Tg="Sonntag"
Case "2" Tg="Montag"
Case "3" Tg="Dienstag"
Case "4" Tg="Mittwoch"
Case "5" Tg="Donnerstag"
Case "6" Tg="Freitag"
Case "7" Tg="Samstag"
End Select
'Immer gleiche Länge schaffen:
Lang=11-Len(Tg)
For i=1 to Lang
Tg=" "&Tg
Next
'Prüfen, ob Suchschleife läuft:
'******************************
If Fso.FileExists(DatSuch) then
Schalt="0"
else
Schalt="1"
End If
'************************************************************
' *
' 1. H-t-a-Datei für Informationen über Zeit und Meldungen: *
' *
'************************************************************
Datei01=Dat0&"Termine\Info."&"h"&"t"&"a"
Set F=Fso.CreateTextFile(Datei01,true)
F.WriteLine(" ")
F.WriteLine(" <Html> ")
F.WriteLine(" <Head> ")
F.WriteLine(" ")
F.Write(" <Hta:Application Id=""OHTA"" ")
F.WriteLine(" Border=""Yes"" InnerBorder=""Yes"" Scroll=""No""> ")
F.Write(" <Title> . . . . . . . . . . . . ")
F.Write(" Termin - Melde - Programm . . . </Title> ")
F.WriteLine(" <Style Type=""Text/Css""> ")
F.WriteLine(" ")
F.Write(" TD {Font-size:13Pt;color:Black; ")
F.WriteLine(" Font-style:bold;font-family:Verdana} ")
F.Write(" Input{Font-size:13pt;color:Black; ")
F.WriteLine(" Font-style:bold;font-family:Verdana} ")
F.Write(" H2 {Font-size:16pt;color:DarkRed; ")
F.WriteLine(" Font-style:bold;font-family:Verdana} ")
F.WriteLine(" ")
F.WriteLine(" </Style> ")
F.WriteLine(" </Head> ")
F.WriteLine(" ")
F.WriteLine(" <Script Language=""VBScript""> ")
F.WriteLine(" Set Wss=CreateObject(""Wscript.Shell"") ")
F.WriteLine(" Set Fso=CreateObject(""Scripting.FileSystemObject"") ")
F.WriteLine(" ")
F.WriteLine(" Dat0=""C:\Programme\Schmelz.W\TermineMelden\"" ")
F.WriteLine(" UV=VbCR&VbCR ")
F.WriteLine(" Dim Dat0, UV ")
F.WriteLine(" ")
' Window.ResizeTo: Fenster hoch, breit
F.WriteLine(" Window.ResizeTo 660,500 ")
' Window.MoveTo: Fenster von oben links nach rechts unten schieben!
F.WriteLine(" Window.MoveTo 250,100 ")
If Zahl > 3 then 'Falls mehr Meldungen, Fenster weiter vergrößern!
F.WriteLine(" Window.ResizeTo 660,660 ")
F.WriteLine(" Window.MoveTo 250,50 ")
End If
F.WriteLine(" ")
F.WriteLine(" '************************************")
F.WriteLine(" ")
F.WriteLine(" Sub Schluss ")
F.WriteLine(" Datei0=Dat0&""Termine\Meldung.""&""h""&""t""&""a"" ")
F.WriteLine(" Datei01=Dat0&""Termine\Info.""&""h""&""t""&""a"" ")
F.WriteLine(" If Fso.FileExists(Datei0) then Fso.DeleteFile(Datei0) ")
F.WriteLine(" If Fso.FileExists(Datei01) then Fso.DeleteFile(Datei01) ")
F.WriteLine(" Self.Close ")
F.WriteLine(" WScript.Quit ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '************************************")
F.WriteLine(" ")
F.WriteLine(" Sub Weiter ")
F.WriteLine(" Datei01=Dat0&""Termine\Info.""&""h""&""t""&""a"" ")
F.WriteLine(" If Fso.FileExists(Datei01) then Fso.DeleteFile(Datei01) ")
F.WriteLine(" Wss.Run Dat0&""Termine\Meldung.""&""h""&""t""&""a"" ")
F.WriteLine(" Self.Close ")
F.WriteLine(" WScript.Quit ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '************************************")
F.WriteLine(" ")
F.WriteLine(" </Script> ")
F.WriteLine(" </Head> ")
F.WriteLine(" ")
F.WriteLine(" <Body OnLoad="""" bgcolor=""#f0e68c""> ")
F.WriteLine(" <Form> ")
F.WriteLine(" ")
F.WriteLine(" <BR> ")
F.WriteLine(" <H2 Align=""Center""> Es liegen folgende Meldungen vor : ")
F.WriteLine(" <BR> ")
'Über proz. Breite und Höhe das Innenfenster an Außenfenster anpassen:
F.Write(" <Table Border=""6"" Cellspacing=""10px"" ")
F.WriteLine(" Width=""90%"" Height=""85%""> ")
F.WriteLine(" <Tr> ")
F.WriteLine(" <Td bgcolor=#90ee90> ")
F.WriteLine(" ")
F.WriteLine(" <BR> ")
XYZ = " "
DatZeit = "Heute ist "&Tg&", der "&Date&", um "&Left(Time,5)&" Uhr ! "
F.WriteLine( XYZ&DatZeit )
F.WriteLine(" <BR><BR> ")
If Zahl>1 then
i=1
Do until i>Zahl
F.WriteLine(XYZ&Meldg(i)&"<BR> ")
i=i+1
Loop
else
F.WriteLine(XYZ&Melden&"<BR> ")
End If
If Zahl>=1 then
If Schalt="1" then 'Die Suchschleife ist zu starten !
F.Write(" <BR> ")
F.WriteLine(" Noch läuft keine ""Suchschleife"", bitte sie gleich starten:")
F.Write(" <BR> ")
F.WriteLine(" Neue Termine speichern- oder nur Suchschleife starten! ")
End If
End If
If Zahl="0" then
F.WriteLine(XYZ&XYZ&XYZ&XYZ&XYZ&" Es liegen keine Meldungen vor! ")
F.WriteLine(" <BR><BR><BR><BR> ")
End If
F.WriteLine(" ")
F.WriteLine(" <Center> ")
F.WriteLine(" <BR> <BR> ")
F.Write(" <Input Type=""Button"" Name=""Start"" ")
F.WriteLine(" Value="" Weiter !"" OnClick=""Weiter""> ")
F.WriteLine(" ")
F.Write(" <Input Type=""Button"" Name=""Ende"" ")
F.WriteLine(" Value=""Abbruch"" OnClick=""Schluss""> ")
F.WriteLine(" <BR><BR> ")
F.WriteLine(" </Center> ")
F.WriteLine(" ")
F.WriteLine(" </Td> ")
F.WriteLine(" </Tr> ")
F.WriteLine(" </Table> ")
F.WriteLine(" </Form> ")
F.WriteLine(" </Body> ")
F.WriteLine(" </Html> ")
F.WriteLine(" ")
F.Close
Set F=Nothing
'********************************************************************
' *
' Entscheidende 2. H-t-a-Datei in "Programme\Schmelz.W" schreiben , *
' in der geplante Meldungen eingetragen und Befehle erteilt werden: *
' *
'********************************************************************
Datei0=Dat0&"Termine\Meldung."&"h"&"t"&"a"
If Fso.FileExists(Datei0) then Fso.DeleteFile(Datei0)
Set F=Fso.CreateTextFile(Datei0,true)
F.WriteLine(" ")
F.WriteLine(" <Html> ")
F.WriteLine(" <Head> ")
F.WriteLine(" ")
F.Write(" <Hta:Application Id=""OHTA"" ")
F.WriteLine(" Border=""Yes"" InnerBorder=""Yes"" Scroll=""No""> ")
F.Write(" <Title> . . . . . . . . . . . . ")
F.Write(" Termin - Melde - Programm . . . </Title> ")
F.WriteLine(" <Style Type=""Text/Css""> ")
F.WriteLine(" ")
F.Write(" TD {Font-size:13Pt;color:Black; ")
F.WriteLine(" Font-style:bold;font-family:Verdana} ")
F.Write(" Input{Font-size:13pt;color:Black; ")
F.WriteLine(" Font-style:bold;font-family:Verdana} ")
F.Write(" H2 {Font-size:16pt;color:DarkRed; ")
F.WriteLine(" Font-style:bold;font-family:Verdana} ")
F.WriteLine(" ")
F.WriteLine(" </Style> ")
F.WriteLine(" </Head> ")
F.WriteLine(" ")
F.WriteLine(" <Script Language=""VBScript""> ")
F.WriteLine(" Set Wss=CreateObject(""Wscript.Shell"") ")
F.WriteLine(" Set Fso=CreateObject(""Scripting.FileSystemObject"") ")
F.WriteLine(" Dat0=""C:\Programme\Schmelz.W\TermineMelden\"" ")
F.WriteLine(" DatX=Dat0&""TermineMelden.""&""v""&""b""&""s"" ")
F.WriteLine(" UV=VbCR&VbCR ")
F.WriteLine(" XYZ="" "" ")
F.WriteLine(" Dim XYZ, UV, WinDir, Dat0, DatX, Lauf, Menge ")
F.WriteLine(" ")
'Window.ResizeTo : Fenster hoch, breit
F.WriteLine(" Window.ResizeTo 660,625 ")
'Window.MoveTo : Fenster von oben links nach rechts unten schieben!
F.WriteLine(" Window.MoveTo 250,75 ")
F.WriteLine(" ")
F.WriteLine(" '************************************")
F.WriteLine(" ")
F.WriteLine(" Sub Schluss ") 'Meldung.h-t-a läuft weiter !
F.WriteLine(" Datei01=Dat0&""Termine\Info.""&""h""&""t""&""a"" ")
F.WriteLine(" If Fso.FileExists(Datei01) then Fso.DeleteFile(Datei01) ")
F.WriteLine(" If Fso.FileExists(Dat0&""Termine/Start.txt"") then _ ")
F.WriteLine(" Fso.DeleteFile(Dat0&""Termine/Start.txt"") ")
F.WriteLine(" Self.Close ")
F.WriteLine(" WScript.Quit ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '************************************")
F.WriteLine(" ")
F.WriteLine(" Sub Schluss2 ") 'hier wird alles unterbrochen !
F.WriteLine(" Datei0=Dat0&""Termine\Meldung.""&""h""&""t""&""a"" ")
F.WriteLine(" Datei01=Dat0&""Termine\Info.""&""h""&""t""&""a"" ")
F.WriteLine(" If Fso.FileExists(Datei0) then Fso.DeleteFile(Datei0) ")
F.WriteLine(" If Fso.FileExists(Datei01) then Fso.DeleteFile(Datei01) ")
F.WriteLine(" If Fso.FileExists(Dat0&""Termine/Start.txt"") then _ ")
F.WriteLine(" Fso.DeleteFile(Dat0&""Termine/Start.txt"") ")
F.WriteLine(" Self.Close ")
F.WriteLine(" WScript.Quit ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '************************************")
F.WriteLine(" ")
F.WriteLine(" Sub Weiter ")
F.WriteLine(" ")
F.WriteLine(" Titel="" Uhrzeit und Meldung eingeben !"" ")
F.WriteLine(" UV=VbCR&VbCR ")
F.WriteLine(" ")
F.WriteLine(" Datei01=Dat0&""Termine\Info.""&""h""&""t""&""a"" ")
F.WriteLine(" If Fso.FileExists(Datei01) then Fso.DeleteFile(Datei01) ")
F.WriteLine(" ")
F.WriteLine(" ")
F.WriteLine(" 'Falls nur die Suchschleife gestartet wird: ")
F.WriteLine(" If Document.All.Opt0.Checked then ")
If Schalt="0" then 'Wenn Suchschleife schon läuft!
F.Write(" MsgBox UV&VbCR&"" Die Suchschleife läuft bereits schon !"" ")
F.WriteLine(" &"" ""&UV&VbCR, VbCritical ")
F.WriteLine(" Exit Sub ")
End If
If Schalt="1" then 'Wenn Suchschleife eingeschaltet werden soll!
'Doppelten Lauf verhindern:
F.WriteLine(" If Fso.FileExists (Dat0&""Termine\Suchschleife.txt"") then ")
F.Write(" MsgBox UV&VbCR&"" Die Suchschleife läuft bereits schon !"" ")
F.WriteLine(" &"" ""&UV&VbCR, VbCritical ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If")
'Unnützen Lauf verhindern:
F.WriteLine(" Menge=""0"" 'Kontrolle, ob Meldungen laufen ")
F.WriteLine(" For i=1 to 50 ")
F.WriteLine(" If Fso.FileExists(Dat0&""Termine\Wecker""&i&"".txt"") then Menge=1+Menge ")
F.WriteLine(" Next ")
F.WriteLine(" If Menge=""0"" then ")
F.Write(" MsgBox UV&VbCR&"" Die Suchschleife ist noch unnötig !"" ")
F.WriteLine(" &"" ""&UV&VbCR,VbCritical ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
'Suchschleife jetzt starten:
F.Write("MsgBox UV&VbCR&VbTab&""Die Suchschleife wird jetzt gestartet !"" ")
F.WriteLine(" &"" ""&UV&VbCR ")
F.WriteLine(" If Fso.FileExists(Dat0&""Termine\SuchSchleife.txt"") then _")
F.WriteLine(" Fso.DeleteFile(Dat0&""Termine\SuchSchleife.txt"") ")
F.WriteLine(" Wss.Run DatX ")
F.WriteLine(" Lauf=""1"" ")
F.WriteLine(" Exit Sub ")
End If
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" ")
F.WriteLine(" 'Falls veraltete Meldungen zu löschen: ")
F.WriteLine(" If Document.All.Opt3.Checked then ")
F.WriteLine(" ")
F.WriteLine(" Nmr=""0"" 'Zahl der veralteten Meldungen ")
F.WriteLine(" i=1 ")
F.WriteLine(" Do until i>50 ")
F.WriteLine(" ")
F.WriteLine("If Fso.FileExists(Dat0&""Termine""&""\Wecker""&i&"".txt"") then ")
F.WriteLine(" ")
F.Write(" Set Data=Fso.OpenTextFile(Dat0&")
F.WriteLine(" ""Termine""&""\Wecker""&i&"".txt"") ")
F.WriteLine(" k=1 ")
F.WriteLine(" Do until Data.AtEndOfStream ")
F.WriteLine(" ReDim Preserve Zeile(k) ")
F.WriteLine(" Zeile(k)=Data.ReadLine ")
F.WriteLine(" k=k+1 ")
F.WriteLine(" Loop ")
F.WriteLine(" Data.Close ")
F.WriteLine(" ")
F.WriteLine(" 'Aus vergangenen Tagen, Zeiten verflossen? ")
F.WriteLine(" If (Right(Zeile(3),6)<Left(Now,6) or _ ")
F.WriteLine(" (Right(Zeile(3),6)=Left(Now,6) and _ ")
F.WriteLine(" Mid(Now,12,5)>=Mid(Zeile(4),4,5))) then ")
F.WriteLine(" Fso.DeleteFile(Dat0&""Termine""&""\Wecker""&i&"".txt"") ")
F.WriteLine(" Nmr=1+Nmr ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" End If ")
F.WriteLine(" i=i+1 ")
F.WriteLine(" Loop ")
F.WriteLine(" ")
F.WriteLine(" MsgBox UV&UV&_ ")
F.WriteLine(" ""Es wurden ""&Nmr&"" veraltete Meldungen gelöscht !""&_ ")
F.WriteLine(" "" ""&UV&UV,VbInformation, _ ")
F.WriteLine(" "" Veraltete Meldungen wurden gelöscht !!!"" ")
F.WriteLine(" ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" ")
F.WriteLine(" 'Falls alle Meldungen zu löschen: ")
F.WriteLine(" If Document.All.Opt2.Checked then ")
F.WriteLine(" ")
F.WriteLine(" Nmr=""0"" 'Zahl vorliegender Meldungen ")
F.WriteLine(" i=1 ")
F.WriteLine(" Do until i>50 ")
F.WriteLine(" ")
F.WriteLine("If Fso.FileExists(Dat0&""Termine""&""\Wecker""&i&"".txt"") then")
F.WriteLine(" ")
F.WriteLine(" Fso.DeleteFile(Dat0&""Termine""&""\Wecker""&i&"".txt"") ")
F.WriteLine(" Nmr=1+Nmr ")
F.WriteLine(" ")
F.WriteLine(" End If ")
F.WriteLine(" i=i+1 ")
F.WriteLine(" Loop ")
F.WriteLine(" ")
F.WriteLine(" MsgBox UV&UV&_ ")
F.WriteLine("""Es wurden ""&Nmr&"" vorliegende Meldungen gelöscht !""&_ ")
F.WriteLine(" "" ""&UV&UV,VbInformation, _ ")
F.WriteLine(" "" Die vorliegenden Meldungen sind gelöscht !!!"" ")
F.WriteLine(" ")
F.WriteLine(" ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" ")
F.WriteLine(" 'Falls Meldungen zu ändern: ")
F.WriteLine(" If Document.All.Opt4.Checked then ")
F.Write(" Wss.Run ""Explorer.exe""&"" ""&""/n,/e,C:\Programme\")
F.WriteLine("Schmelz.W\TermineMelden\Termine"" ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" ")
F.WriteLine(" 'Sechs freie Nummern suchen! ")
F.WriteLine(" For i=1 to 6 ")
F.WriteLine(" ReDim Preserve Nr(i) ")
F.WriteLine(" Nr(i)=""0"" ")
F.WriteLine(" Next ")
F.WriteLine(" ")
F.WriteLine(" k=1 ")
F.WriteLine(" For i=1 to 6 ")
F.WriteLine(" Neue=""0"" ")
F.WriteLine(" Nr(i)=k ")
F.WriteLine(" Do until Neue=""1"" ")
F.Write(" If not Fso.FileExists(""C:\Programme\Schmelz.W\TermineMelden\")
F.WriteLine("Termine\Wecker""&k&"".txt"") then ")
F.WriteLine(" Nr(i)=k ")
F.WriteLine(" Neue=""1"" ")
F.WriteLine(" End If ")
F.WriteLine(" k=k+1 ")
F.WriteLine(" Loop ")
F.WriteLine(" Next ")
F.WriteLine(" ")
F.WriteLine(" ")
F.WriteLine(" 'Einträge lesen, überprüfen: ")
F.WriteLine(" For i=1 to 6 ")
F.WriteLine(" ReDim Preserve Tag(i) ")
F.WriteLine(" ReDim Preserve Zeit(i) ")
F.WriteLine(" ReDim Preserve Mdg(i) ")
F.WriteLine(" Next ")
F.WriteLine(" ")
F.WriteLine(" Tag(1)=Document.All.Tg1.value ")
F.WriteLine(" Zeit(1)=Document.All.Zt1.value ")
F.WriteLine(" Mdg(1)=Document.All.Md1.value ")
F.WriteLine(" Tag(2)=Document.All.Tg2.value ")
F.WriteLine(" Zeit(2)=Document.All.Zt2.value ")
F.WriteLine(" Mdg(2)=Document.All.Md2.value ")
F.WriteLine(" Tag(3)=Document.All.Tg3.value ")
F.WriteLine(" Zeit(3)=Document.All.Zt3.value ")
F.WriteLine(" Mdg(3)=Document.All.Md3.value ")
F.WriteLine(" Tag(4)=Document.All.Tg4.value ")
F.WriteLine(" Zeit(4)=Document.All.Zt4.value ")
F.WriteLine(" Mdg(4)=Document.All.Md4.value ")
F.WriteLine(" Tag(5)=Document.All.Tg5.value ")
F.WriteLine(" Zeit(5)=Document.All.Zt5.value ")
F.WriteLine(" Mdg(5)=Document.All.Md5.value ")
F.WriteLine(" Tag(6)=Document.All.Tg6.value ")
F.WriteLine(" Zeit(6)=Document.All.Zt6.value ")
F.WriteLine(" Mdg(6)=Document.All.Md6.value ")
F.WriteLine(" ")
F.WriteLine(" ")
F.WriteLine("'Das Datum sinnvoll? ")
F.WriteLine(" i=1 ")
F.WriteLine(" Do until i>6 ")
F.WriteLine(" If Tag(i)<>"""" then ")
F.WriteLine(" If InStr(Tag(i),""."")=""2"" then Tag(i)=""0""&Tag(i) ")
F.Write(" If Len(Tag(i))=""5"" and not Right(Tag(i),1)=""."" ")
F.WriteLine(" then Tag(i)=Tag(i)&""."" ")
F.Write(" If Len(Tag(i))=""5"" and Right(Tag(i),1)=""."" ")
F.WriteLine(" then Tag(i)=Left(Tag(i),3)&""0""&Right(Tag(i),2) ")
F.WriteLine(" ")
F.WriteLine(" Tag(i)=Left(Tag(i),5) ")
F.WriteLine(" ")
F.Write(" If (Left(Now,2)>Left(Tag(i),2) and not ")
F.Write(" Mid(Now,4,2)<Right(Tag(i),2)) or (Left(Now,2)>Left(Tag(i),2) ")
F.WriteLine(" and Right(Tag(i),2)=Mid(Now,4,2)) then ")
F.WriteLine(" MsgBox UV&"" Das Datum ""&i&"" liegt zurück ! ! ! ""&UV ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" If(InStr(Tag(i),""."")>""3"" or InStrRev(Tag(i),""."")>""3"") then")
F.WriteLine(" MsgBox UV&"" Das Datum ""&i&"" ist sinnlos ! ! ! ""&UV ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" Tag(i)=Tag(i)&""."" ")
F.WriteLine(" ")
F.WriteLine(" If (Len(Tag(i))>""6"" _ ")
F.WriteLine(" or Left(Tag(i),2)>""31"" or Mid(Tag(i),4,2)>""12"") then ")
F.WriteLine(" MsgBox UV&"" Das Datum ""&i&"" ist sinnlos ! ! ! ""&UV ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" End If ")
F.WriteLine(" i=i+1 ")
F.WriteLine(" Loop ")
F.WriteLine(" ")
F.WriteLine(" ")
F.WriteLine(" 'Die Uhrzeiten sinnvoll? ")
F.WriteLine(" i=1 ")
F.WriteLine(" Do until i>6 ")
F.WriteLine(" If Zeit(i)<>"""" then ")
F.WriteLine(" If InStr(Zeit(i),"":"")=""2"" then Zeit(i)=""0""&Zeit(i) ")
F.WriteLine(" ")
F.WriteLine(" If (Mid(Now,12,5)>Zeit(i) and Tag(i)=Left(Now,6)) then ")
F.WriteLine(" MsgBox UV&"" Die Uhrzeit ""&i&"" liegt zurück ! ! ! ""&UV ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" If (Len(Zeit(i))>""5"" _")
F.WriteLine(" or Left(Zeit(i),2)>""23"" or Right(Zeit(i),2)>""59"") then ")
F.WriteLine(" MsgBox UV&"" Die Uhrzeit ""&i&"" ist sinnlos ! ! ! ""&UV ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" End If ")
F.WriteLine(" i=i+1 ")
F.WriteLine(" Loop ")
F.WriteLine(" ")
F.WriteLine(" ")
F.WriteLine(" 'Das Datum eingetragen? ")
F.WriteLine(" i=1 ")
F.WriteLine(" Do until i>6 ")
F.WriteLine(" If (Zeit(i)<>"""" and Mdg(i)<>"""") then ")
F.WriteLine(" If Tag(i)="""" then MsgBox UV&_ ")
F.WriteLine(" "" Das Datum ""&i&"" wurde nicht eingetragen ! ""&_ ")
F.WriteLine(" UV,,Titel:Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" i=i+1 ")
F.WriteLine(" Loop ")
F.WriteLine(" ")
F.WriteLine(" ")
F.WriteLine(" 'Die Zeiten eingetragen? ")
F.WriteLine(" i=1 ")
F.WriteLine(" Do until i>6 ")
F.WriteLine(" If (Tag(i)<>"""" and Mdg(i)<>"""") then ")
F.WriteLine(" If Zeit(i)="""" then MsgBox UV&_ ")
F.WriteLine(" "" Die Uhrzeit ""&i&"" wurde nicht eingetragen ! ""&_ ")
F.WriteLine(" UV,,Titel:Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" i=i+1 ")
F.WriteLine(" Loop ")
F.WriteLine(" ")
F.WriteLine(" ")
F.WriteLine(" 'Die Meldungen eingetragen? ")
F.WriteLine(" i=1 ")
F.WriteLine(" Do until i>6 ")
F.WriteLine(" If (Tag(i)<>"""" and Zeit(i)<>"""") then ")
F.WriteLine(" If Mdg(i)="""" then MsgBox UV&_ ")
F.WriteLine(" "" Die Meldung ""&i&"" wurde nicht eingetragen ! ""&_ ")
F.WriteLine(" UV,,Titel:Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" i=i+1 ")
F.WriteLine(" Loop ")
F.WriteLine(" ")
F.WriteLine(" ")
F.WriteLine(" 'Überhaupt etwas eingetragen? ")
F.WriteLine(" Leer=""0"" " )
F.WriteLine(" i=1 ")
F.WriteLine(" Do until i>6 ")
F.WriteLine(" If ((Tag(i)<>"""" and Zeit(i)="""" and Mdg(i)="""") or _ ")
F.WriteLine(" (Tag(i)="""" and Zeit(i)="""" and Mdg(i)="""")) then _ ")
F.WriteLine(" Leer=1+Leer ")
F.WriteLine(" i=i+1 ")
F.WriteLine(" Loop ")
F.WriteLine(" If Leer=""6"" then ")
F.WriteLine(" MsgBox UV&_ ")
F.WriteLine(" "" Es wurde keine Meldung eingetragen ! ""&_ ")
F.WriteLine(" UV,,Titel:Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" ")
F.WriteLine(" 'Protokoll-Dateien in Programme\Schmelz.W setzen: ")
F.WriteLine(" i=1 ")
F.WriteLine(" Do until i>6 ")
F.WriteLine(" If Zeit(i)<>"""" then ")
F.WriteLine(" Datei1=Dat0&""Termine""&""\Wecker""&Nr(i)&"".txt"" ")
F.WriteLine(" Set Data=Fso.CreateTextFile(Datei1) ")
F.Write(" Data.WriteLine(""Bei Änderungen nur Datum, ")
F.WriteLine(" Zeit und Meldung ändern!"") ")
F.Write(" Data.WriteLine(""Die Stellen dürfen ")
F.WriteLine(" dabei nicht geändert werden !!!"") ")
F.WriteLine(" Data.Write(Now&"" :: ""&""Wecker ""&Nr(i)) ")
F.WriteLine(" Data.WriteLine("" klingelt am ""&Tag(i)) ")
F.Write(" Data.WriteLine(""um ""&Zeit(i) ")
F.WriteLine(" &"" Uhr und meldet dann """" ""&Mdg(i)&"" """""") ")
F.WriteLine(" Data.Close ")
F.WriteLine(" Set Data=Nothing ")
F.WriteLine(" End If ")
F.WriteLine(" i=i+1 ")
F.WriteLine(" Loop ")
F.WriteLine(" ")
F.WriteLine(" 'Falls Suchschleife gestartet werden soll: ")
If Schalt = "1" then 'Wenn Suchschleife noch nicht läuft!
F.WriteLine(" ")
F.WriteLine(" Wss.Run DatX ")
F.WriteLine(" Schluss ")
F.WriteLine(" ")
End If
F.WriteLine(" ")
F.WriteLine(" Schluss2 ")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '************************************")
F.WriteLine(" ")
F.WriteLine(" Sub Eintraege ")
F.WriteLine(" ")
F.WriteLine(" Txt=""<Fieldset>"" ")
F.WriteLine(" Txt=Txt&""<BR>"" ")
F.WriteLine(" Txt=Txt&""<Center>"" ")
F.Write(" Txt=Txt&""<Input Type=""""Text"""" Id=""""Tg1"""" ")
F.Write(" Style=""""Width:63"""" Name=""""Tag1"""" Value="""""" ")
F.Write(" &Left(Now,6)&""""""> um <Input Type=""""Text"""" ")
F.Write(" Id=""""Zt1"""" Style=""""Width:60"""" Name=""""Zeit1"""" ")
F.Write(" Value=""""""&Mid(Now,12,5)&""""""> Uhr <Input ")
F.Write(" Type=""""Text"""" Id=""""Md1"""" Style=""""Width:220"""" ")
F.WriteLine(" Name=""""Meldung1"""" Value="""""""">"" ")
F.WriteLine(" Txt=Txt&""</Center>"" ")
F.WriteLine(" Txt=Txt&""</Fieldset>"" ")
F.WriteLine(" Document.All.Meldung1.InnerHTML=Txt ")
F.WriteLine(" ")
F.WriteLine(" Txt=""<Fieldset>"" ")
F.WriteLine(" Txt=Txt&""<Center>"" ")
F.Write(" Txt=Txt&""<Input Type=""""Text"""" Id=""""Tg2"""" ")
F.Write(" Style=""""Width:63"""" Name=""""Tag2"""" Value="""""" ")
F.Write(" &Left(Now,6)&""""""> um <Input Type=""""Text"""" ")
F.Write(" Id=""""Zt2"""" Style=""""Width:60"""" Name=""""Zeit2"""" ")
F.Write(" Value=""""""""> Uhr <Input ")
F.Write(" Type=""""Text"""" Id=""""Md2"""" Style=""""Width:220"""" ")
F.WriteLine(" Name=""""Meldung2"""" Value="""""""">"" ")
F.WriteLine(" Txt=Txt&""</Center>"" ")
F.WriteLine(" Txt=Txt&""</Fieldset>"" ")
F.WriteLine(" Document.All.Meldung2.InnerHTML=Txt ")
F.WriteLine(" ")
F.WriteLine(" Txt=""<Fieldset>"" ")
F.WriteLine(" Txt=Txt&""<Center>"" ")
F.Write(" Txt=Txt&""<Input Type=""""Text"""" Id=""""Tg3"""" ")
F.Write(" Style=""""Width:63"""" Name=""""Tag3"""" Value="""""" ")
F.Write(" &Left(Now,6)&""""""> um <Input Type=""""Text"""" ")
F.Write(" Id=""""Zt3"""" Style=""""Width:60"""" Name=""""Zeit3"""" ")
F.Write(" Value=""""""""> Uhr <Input ")
F.Write(" Type=""""Text"""" Id=""""Md3"""" Style=""""Width:220"""" ")
F.WriteLine(" Name=""""Meldung3"""" Value="""""""">"" ")
F.WriteLine(" Txt=Txt&""</Center>"" ")
F.WriteLine(" Txt=Txt&""</Fieldset>"" ")
F.WriteLine(" Document.All.Meldung3.InnerHTML=Txt ")
F.WriteLine(" ")
F.WriteLine(" Txt=""<Fieldset>"" ")
F.WriteLine(" Txt=Txt&""<Center>"" ")
F.Write(" Txt=Txt&""<Input Type=""""Text"""" Id=""""Tg4"""" ")
F.Write(" Style=""""Width:63"""" Name=""""Tag4"""" Value="""""" ")
F.Write(" &Left(Now,6)&""""""> um <Input Type=""""Text"""" ")
F.Write(" Id=""""Zt4"""" Style=""""Width:60"""" Name=""""Zeit4"""" ")
F.Write(" Value=""""""""> Uhr <Input ")
F.Write(" Type=""""Text"""" Id=""""Md4"""" Style=""""Width:220"""" ")
F.WriteLine(" Name=""""Meldung4"""" Value="""""""">"" ")
F.WriteLine(" Txt=Txt&""</Center>"" ")
F.WriteLine(" Txt=Txt&""</Fieldset>"" ")
F.WriteLine(" Document.All.Meldung4.InnerHTML=Txt ")
F.WriteLine(" ")
F.WriteLine(" Txt=""<Fieldset>"" ")
F.WriteLine(" Txt=Txt&""<Center>"" ")
F.Write(" Txt=Txt&""<Input Type=""""Text"""" Id=""""Tg5"""" ")
F.Write(" Style=""""Width:63"""" Name=""""Tag5"""" Value="""""" ")
F.Write(" &Left(Now,6)&""""""> um <Input Type=""""Text"""" ")
F.Write(" Id=""""Zt5"""" Style=""""Width:60"""" Name=""""Zeit5"""" ")
F.Write(" Value=""""""""> Uhr <Input ")
F.Write(" Type=""""Text"""" Id=""""Md5"""" Style=""""Width:220"""" ")
F.WriteLine(" Name = """"Meldung5"""" Value = """""""">"" ")
F.WriteLine(" Txt=Txt&""</Center>"" ")
F.WriteLine(" Txt=Txt&""</Fieldset>"" ")
F.WriteLine(" Document.All.Meldung5.InnerHTML=Txt ")
F.WriteLine(" ")
F.WriteLine(" Txt=""<Fieldset>"" ")
F.WriteLine(" Txt=Txt&""<Center>"" ")
F.Write(" Txt=Txt&""<Input Type=""""Text"""" Id=""""Tg6"""" ")
F.Write(" Style=""""Width:63"""" Name=""""Tag6"""" Value="""""" ")
F.Write(" &Left(Now,6)&""""""> um <Input Type=""""Text"""" ")
F.Write(" Id=""""Zt6"""" Style=""""Width:60"""" Name=""""Zeit6"""" ")
F.Write(" Value=""""""""> Uhr <Input ")
F.Write(" Type=""""Text"""" Id=""""Md6"""" Style=""""Width:220"""" ")
F.WriteLine(" Name=""""Meldung6"""" Value="""""""">"" ")
F.WriteLine(" Txt=Txt&""</Center> <BR>"" ")
F.WriteLine(" Txt=Txt&""</Fieldset>"" ")
F.WriteLine(" Document.All.Meldung6.InnerHTML=Txt ")
F.WriteLine(" ")
F.WriteLine(" Txt="""" ")
F.WriteLine(" Txt=""<Fieldset><BR>"" ")
F.WriteLine(" Txt=Txt&XYZ&""<Input Checked Type=""""Radio"""" ""&_ ")
F.WriteLine(" ""Name=""""R1"""" ID=""""Opt1""""> Die ""&_ ")
F.WriteLine(" ""Termin-Meldungen speichern ! <BR>"" ")
F.WriteLine(" Txt=Txt&XYZ&""<Input Type=""""Radio"""" ""&_ ")
F.WriteLine(" ""Name=""""R1"""" ID=""""Opt0""""> Die ""&_ ")
F.WriteLine(" ""Dauer-Suchschleife neu starten !<BR>"" ")
F.WriteLine(" Txt=Txt&XYZ&""<Input Type=""""Radio"""" ""&_ ")
F.WriteLine(" ""Name=""""R1"""" ID=""""Opt2""""> Alle ""&_")
F.WriteLine(" ""vorliegenden Meldungen löschen !<BR>""")
F.WriteLine(" Txt=Txt&XYZ&""<Input Type=""""Radio"""" ""&_ ")
F.WriteLine(" ""Name=""""R1"""" ID=""""Opt3""""> Nur ""&_ ")
F.WriteLine(" ""abgelaufene Meldungen löschen !<BR>"" ")
F.WriteLine(" Txt=Txt&XYZ&""<Input Type=""""Radio"""" ""&_ ")
F.WriteLine(" ""Name=""""R1"""" ID=""""Opt4""""> Mel""&_ ")
F.WriteLine(" ""dungen abändern oder löschen !<BR>"" ")
F.WriteLine(" Txt=Txt&""<BR>"" ")
F.WriteLine(" Txt=Txt&""</Fieldset>"" ")
F.WriteLine(" Document.All.Loeschen.InnerHTML=Txt ")
F.WriteLine(" ")
F.WriteLine(" 'Falls beim PC-Neustart Meldungen vorliegen ")
F.WriteLine(" '****************************************** ")
F.WriteLine(" If Fso.FileExists(Dat0&""Termine\Start.txt"") then _ ")
F.WriteLine(" MsgBox UV&""Bitte die """" Suchschleife """" für das""&UV&_ ")
F.WriteLine(" ""Termine - Melden jetzt starten ! ""&UV&_ ")
F.WriteLine(" ""Es liegen noch Meldungen vor !""&UV, _ ")
F.WriteLine(" VbInformation+VbSystemModal, _ ")
F.WriteLine(" "" Suchschleife starten !"" ")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '************************************")
F.WriteLine(" ")
F.WriteLine(" </Script> ")
F.WriteLine(" </Head> ")
F.WriteLine(" ")
F.WriteLine(" <Body OnLoad=""Eintraege"" bgcolor=""#f0e68c""> ")
F.WriteLine(" <Form> ")
F.WriteLine(" ")
F.WriteLine(" <BR> ")
F.WriteLine("<H2 Align=""Center"">Datum, Zeiten und Meldungen eintragen : ")
F.WriteLine(" <Table Border=""6"" Cellspacing=""10px"" Width=""88%""> ")
F.WriteLine(" <Tr>")
F.WriteLine(" <Td bgcolor=#90ee90> ")
F.WriteLine(" ")
F.WriteLine(" <Div Id=Meldung1></Div> ")
F.WriteLine(" <Div Id=Meldung2></Div> ")
F.WriteLine(" <Div Id=Meldung3></Div> ")
F.WriteLine(" <Div Id=Meldung4></Div> ")
F.WriteLine(" <Div Id=Meldung5></Div> ")
F.WriteLine(" <Div Id=Meldung6></Div> ")
F.WriteLine(" <Div Id=Loeschen></Div> ")
F.WriteLine(" ")
F.WriteLine(" <Center> ")
F.WriteLine(" <BR> ")
F.Write(" <Input Type=""Button"" Name=""Start"" ")
F.WriteLine( "Value=""Ausführen"" OnClick=""Weiter""> ")
F.WriteLine( " ")
F.Write(" <Input Type=""Button"" Name=""Ende"" ")
F.WriteLine(" Value=""Abbrechen"" OnClick=Schluss2> ")
F.WriteLine(" <BR><BR> ")
F.WriteLine(" </Center> ")
F.WriteLine(" ")
F.WriteLine(" </Td> ")
F.WriteLine(" </Tr> ")
F.WriteLine(" </Table> ")
F.WriteLine(" </Form> ")
F.WriteLine(" </Body> ")
F.WriteLine(" </Html> ")
F.WriteLine(" ")
F.Close
Set F=Nothing
'************************************************
' *
' Die erste geschriebene H-t-a-Datei aufrufen, *
' die 2. auf Wunsch aus ihr heraus aufgerufen : *
' *
'************************************************
'Falls beim PC-Neustart noch Meldungen vorliegen:
'************************************************
If Fso.FileExists(Dat0&"Termine\Start.txt") then
Wss.Run Dat0&"Termine\Meldung."&"h"&"t"&"a"
else
Wss.Run Dat0&"Termine\Info."&"h"&"t"&"a", , true
' "true" heißt : erst weiter, wenn beendet!
End If
'Falls Abbruch mit "X" oben rechts erfolgt ist, ist Ab-
'bruch nur möglich, wenn bei Neudurchlauf Datei0 fehlt!
'******************************************************
WScript.Sleep 1300
If (Fso.FileExists(Datei0) and Schalt="0") then _
Fso.DeleteFile(Datei0)
'(Falls Schalt=0, d.h. Suchschleife fehlt, die starten)
'1. Abschnitt mit den H-t-a-Dateien schließen, 1. H-t-a -
'Datei löschen, die gesamte Vbs-Datei erneut durchlaufen!
'********************************************************
WScript.Sleep 1000
If Fso.FileExists(Datei01) then Fso.DeleteFile(Datei01)
If Fso.FileExists(Dat0&"Termine/Start.txt") then _
Fso.DeleteFile(Dat0&"Termine/Start.txt")
WScript.Quit
End If
'################################################
'Das Ende des Abschnittes mit den H-t-a-Dateien !
'Zur Sicherheit prüfen, ob was zu löschen übrig:
'***********************************************
Datei0=Dat0&"Termine\Meldung."&"h"&"t"&"a"
Datei01=Dat0&"Termine\Info."&"h"&"t"&"a"
If Fso.FileExists(Datei0) then Fso.DeleteFile(Datei0)
If Fso.FileExists(Datei01) then Fso.DeleteFile(Datei01)
If Fso.FileExists(Dat0&"Termine/Start.txt") then _
Fso.DeleteFile(Dat0&"Termine/Start.txt")
'Beim Start Zeitmeldung schreiben, damit nie Zeitlücke:
'******************************************************
DateiX=Dat0&"Termine\SuchSchleife.txt"
Set Data=Fso.OpenTextFile(DateiX,8,true)
Data.WriteLine(Now)
Data.Close
Set Data=Nothing
WScript.Sleep 1000
'Ständige Prüfschleife, ob aktuelle Meldungen anfallen:
'******************************************************
Multi="1"
Korr="0"
Such="1"
Do until Such>1000000 'Reicht für ca. 1/3 Jahr Laufzeit!
'In 5,10,55,125,225,355,515 Min. melden, Suchschleife da!
'********************************************************
Produkt=60*Multi ' Der Divisor für die Modulo-Bildung
'Such läuft weiter, muss durch ständige Mod-Bildung auf Neu-
'start 1 gebracht werden, angepasst an wachsende Zeiträume !
'Ein Anwachsen des Melde-Abstandes bis 10 Std. ermöglichen:
'**********************************************************
If Such<3700 then
If (Such-Korr-30) mod Produkt="0" then
Wss.Popup UV&" Die Suchschleife für das"&UV&" "&_
"Termine - Melden läuft ! "&UV,2," "&_
" Die Suchschleife läuft !",VbInformation+VbSystemModal
' *************
' Mit "VbSystemModal" wird die Meldung immer nach vorne gerückt!
Multi=3+Multi
Korr=Korr+Produkt
End If
End If
'Ca. stündlich SuchSchleife.txt löschen, neu starten:
'****************************************************
If Such mod 400=0 then
If Fso.FileExists(DateiX) then Fso.DeleteFile(DateiX)
Wscript.Sleep 1000
End If
'Rückmeldungen, dass die "Suchschleife.txt" läuft:
'*************************************************
Set Data=Fso.OpenTextFile(DateiX,8,true )
Data.WriteLine(Now)
Data.Close
Set Data=Nothing
'Erst nach Rückmeldung unterbrechen, sonst Fehler bei Überprü-
'fung der " Suchschleife.txt " bei "längerer" MsgBox möglich !
'*************************************************************
'Immer Schleife von 10 s Dauer schaffen, nie länger!
'***************************************************
If Such<3700 then 'Korr wieder zurücksetzen (-Produkt)!
If (Such+1-Korr-30) mod Produkt<>"0" then _
WScript.Sleep 10000
If (Such+1-Korr-30) mod Produkt="0" then _
WScript.Sleep 7000 ' Wegen der Popup-Meldung von 3 s
Else
WScript.Sleep 10000
End If
'Prüfen, ob eine aktuelle Meldung vorliegt:
'******************************************
Menge="0" 'Kontrolle, ob Meldungen laufen
i=1
Do until (i>50 or Meldng="1")
Meldng="0"
If Fso.FileExists(Dat0&"Termine\Wecker"&i&".txt") then
Menge=1+Menge
Set Data=Fso.OpenTextFile(Dat0&"Termine"&"\Wecker"&i&".txt")
k=1
Do until Data.AtEndOfStream
ReDim Preserve Zeile(k)
Zeile(k)=Data.ReadLine
k=k+1
Loop
Data.Close
Set Data=Nothing
Datum=Right(Zeile(3),6)
Zeit=Mid(Zeile(4),4,5 )
Melden = Right(Zeile(4),Len(Zeile(4))-29)
If (Mid(Now,12,5)>= Zeit and Left(Now,6)=Datum) then
Meldng="1" ' Meldung erkannt!
Numr=i '*****************
End If
End If
i=i+1
Loop
'Bei keinen Meldungen, Suchschleife stoppen:
If Menge="0" then WScript.Quit
'Beginn des Melde-Mechanismus, falls Meldung gefunden:
'*****************************************************
If Meldng="1" then ' < xxxxxxxxxxxxxxxxxx s.u.
'Meldung muss immer in den Vordergrund gerückt werden:
'*****************************************************
MsgBox UV&UV&VbTab&Melden&" "&_
UV&UV,VbInformation+VbSystemModal,Titel
' *************
'Die Protokoll- Notiz in Programme\Schmelz.W löschen:
'****************************************************
If Fso.FileExists(Dat0&"Termine"&"\Wecker"&Numr&".txt") then _
Fso.DeleteFile(Dat0&"Termine"&"\Wecker"&Numr&".txt")
'Wenn keine Meldungen zurück, Suchschleife schließen:
'****************************************************
Lauf="0"
Set Ort=Fso.GetFolder(Dat0&"\Termine").Files
For each File in Ort
If Left(Fso.GetFileName(File),4)="Weck" then Lauf="1"
Next
If Lauf="0" then
If Fso.FileExists(Dat0&"Termine"&"\SuchSchleife.txt") then _
Fso.DeleteFile(Dat0&"Termine"&"\SuchSchleife.txt")
WScript.Quit
End If
'C:\Programme\Schmelz.W\TermineMelden erneut aufräumen:
'******************************************************
If Fso.FileExists(Dat0&"Termine/Meldung."&"h"&"t"&"a") then _
Fso.DeleteFile(Dat0&"Termine/Meldung."&"h"&"t"&"a")
If Fso.FileExists(Dat0&"Termine/Start.txt") then _
Fso.DeleteFile(Dat0&"Termine/Start.txt")
Meldng="0" ' Melde-Mechanismus beenden!
End If ' < xxxxxxxxxxxxxxxxxxx s.o.
'Ende der ständig laufenden SuchSchleife (nach 1/3 Jahr!)
'********************************************************
Such=1+Such
Loop
'Falls mögliches 1/3 Jahr für Schleife um ist!?
'**********************************************
MsgBox UV&VbCR&"Die Laufzeit von ""TermineMelden.vbs"" lief"&_
" ab !"&UV&"Bitte dieses Programm einfach neu "&_
"starten ! "&UV&VbCR,VbCritical,Titel
WScript.Quit
http://dieseyer.de • all rights reserved • © 2011 v11.4