'*** 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(" ") F.WriteLine(" ") F.WriteLine(" ") F.Write(" ") F.Write(" . . . . . . . . . . . . ") F.Write(" Termin - Melde - Programm . . . ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine("
") F.WriteLine(" ") F.WriteLine("
") F.WriteLine("

Es liegen folgende Meldungen vor : ") F.WriteLine("
") 'Über proz. Breite und Höhe das Innenfenster an Außenfenster anpassen: F.Write(" ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine("
") F.WriteLine(" ") F.WriteLine("
") XYZ = "    " DatZeit = "Heute ist "&Tg&", der "&Date&", um "&Left(Time,5)&" Uhr ! " F.WriteLine( XYZ&DatZeit ) F.WriteLine("

") If Zahl>1 then i=1 Do until i>Zahl F.WriteLine(XYZ&Meldg(i)&"
") i=i+1 Loop else F.WriteLine(XYZ&Melden&"
") End If If Zahl>=1 then If Schalt="1" then 'Die Suchschleife ist zu starten ! F.Write("
    ") F.WriteLine(" Noch läuft keine ""Suchschleife"", bitte sie gleich starten:") F.Write("
    ") 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("



") End If F.WriteLine(" ") F.WriteLine("
") F.WriteLine("

") F.Write(" ") F.WriteLine("    ") F.Write(" ") F.WriteLine("

") F.WriteLine("
") F.WriteLine(" ") F.WriteLine("
") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine(" ") 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(" ") F.WriteLine(" ") F.WriteLine(" ") F.Write(" ") F.Write(" . . . . . . . . . . . . ") F.Write(" Termin - Melde - Programm . . . ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine("
") F.WriteLine(" ") F.WriteLine("
") F.WriteLine("

Datum, Zeiten und Meldungen eintragen : ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine("
") F.WriteLine(" ") F.WriteLine("
") F.WriteLine("
") F.WriteLine("
") F.WriteLine("
") F.WriteLine("
") F.WriteLine("
") F.WriteLine("
") F.WriteLine(" ") F.WriteLine("
") F.WriteLine("
") F.Write(" ") F.WriteLine( "    ") F.Write(" ") F.WriteLine("

") F.WriteLine("
") F.WriteLine(" ") F.WriteLine("
") F.WriteLine(" ") F.WriteLine(" ") F.WriteLine(" ") 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