'*** 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("