' (C) 2001 by Dr. Tobias Weltner, www.scriptinternals.de ' atomuhr.vbs ' http://www.scriptinternals.de/content/4-Anwendungen/uhrzeit/atomuhr/atomuhr0.htm ' atomuhr.vbs ' 'v2.3***************************************************** ' Autor: dieseyer@gmx.de ' dieseyer.de ' Erweitert und verändert durch Service.CD@gmx.de zu timeset.vbs ' Dadurch ist es möglich die Zeit per Scheduler zu setzen: ' - PopUp... (anstatt MsgBox) - Meldungen verschwinden von selbst ' - Nur wenn die Abweichung kleiner +/- 600 Sekunden wird die Zeit autom. gesetzt. ' - Es wird eine Protokolldatei timeset.log ' '********************************************************* ' ### DIESER TEIL AUTOMATISCH EINGESETZT, UM DAS STARTEN DES SCRIPTS ÜBER DAS INTERNET ZU VERHINDERN: if Instr(wscript.ScriptFullName, "Temporary Internet File")>0 then if MsgBox("Öffnen Sie NIEMALS direkt ein Skript im Internet - es könnte Viren enthalten! Trotzdem öffnen und sofort ausführen?",vbYesNo+vbQuestion,"Sicherheitshinweis")=vbNo then MsgBox "Gute Entscheidung! Wiederholen Sie das Download, und speichern Sie das Skript diesmal zuerst!",vbInformation : wscript.quit ' ### ENDE AUTOMATISCHER TEIL Dim remotedate, diff, newnow, datumjetzt, tagabweichung, zeitjetzt, sekabweichung Dim TextX, FileOut, MaxKorrektur Set WshShell = WScript.CreateObject("WScript.Shell") Set fso = WScript.CreateObject("Scripting.FileSystemObject") ' Set wshshell = CreateObject("WScript.Shell") Set http = GetHTTPObject MaxKorrekt = 6000 ' max. Abweichung, bei der die Zeit autom. gesetzt wird ' ist die Abweichung größer, muss die Zeit von Hand gesetzt werden WSCript.sleep 5*1000 Zeitzone = wshshell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias") If IsArray(Zeitzone) Then HexVal = Hex(Zeitzone(3)) & Hex(Zeitzone(2)) & Hex(Zeitzone(1)) & Hex(Zeitzone(0)) Else HexVal = Hex(Zeitzone) End If Zeitzone = - CLng("&H" & HexVal) / 60 ' wshshell.Popup "Zeitunterschied zu GMC: " & Zeitzone & " Stunde" , 2 ' MsgBox "Zeitunterschied zu GMC: " & Zeitzone & "h" Call ZeitAnfrage() TextX= "" TextX= TextX & "remotedate: " & vbTab & remotedate & vbCRLF TextX= TextX & "diff : " & vbTab & vbTab & diff & vbCRLF TextX= TextX & "newnow : " & vbTab & newnow & vbCRLF TextX= TextX & "datumjetzt : " & vbTab & datumjetzt & vbCRLF TextX= TextX & "tagabweichung : " & vbTab & tagabweichung & vbCRLF TextX= TextX & "zeitjetzt : " & vbTab & vbTab & zeitjetzt & vbCRLF TextX= TextX & "sekabweichung : " & vbTab & sekabweichung & vbCRLF ' wshshell.Popup TextX, 5, WScript.ScriptName If Abs( sekabweichung ) < 2 and Abs( tagabweichung ) < 2 Then wshshell.Popup "Systemzeit ok!" & vbCRLF & "Abweichung: " & sekabweichung & " Sek.", 5, WScript.ScriptName & " - keine Korrektur", 4096 + vbInformation TextX = newnow & " " & sekabweichung & " " & vbTab & " Sekunden Abweichung - keine Korrektur erforderlich. " LogDatei ' Sub LogDatei Else If Abs( sekabweichung ) < MaxKorrekt Then Call ZeitAnfrage() wshshell.Run "%comspec% /k time " & zeitjetzt , 0 wshshell.Run "%comspec% /k date " & datumjetzt , 0 wshshell.Popup "Zeit wurde auf " & zeitjetzt & " gesetzt!" & vbCRLF & "Abweichung war " & sekabweichung & " Sek." , 5, WScript.ScriptName & " - Korrektur", 4096 + vbInformation TextX = newnow & " " & sekabweichung & " " & vbTab & " Sekunden Abweichung korregiert. " LogDatei ' Sub LogDatei Else zeitmsg = "Systemzeit liegt mit " & sekabweichung & " " & " Sekunden daneben. Auf " & CDate(zeitjetzt) & " einstellen?" TextX = newnow & " " & sekabweichung & " " & vbTab & " Sekunden Abweichung - nicht korregiert. " LogDatei ' Sub LogDatei wshshell.Popup "Zeit wird nicht auf " & zeitjetzt & " gesetzt!" & vbCRLF & "Abweichung ist mit " & sekabweichung & " Sek zu groß." , 5, WScript.ScriptName & " - keine Korrektur!", 4096 + vbInformation ' antwort = MsgBox(zeitmsg, vbQuestion+vbSystemModal+vbYesNo, " atom_uhr_dienst.VBS") ' If antwort = vbYes then ' ZeitAnfrage ' wshshell.Run "%comspec% /c time " & zeitjetzt, 0 ' End If End If End If ' wshshell.Popup "Fertig!" , 5 , WScript.ScriptName & " , vbInformation ' MsgBox "Fertig!", vbInformation Function GetHTTPObject On Error Resume Next Set http = CreateObject("microsoft.xmlhttp") If Err.Number <> 0 Then wshshell.Popup "Internet Explorer 5 oder höher erforderlich!", 5, WScript.ScriptName & " - Fehler", 4096 + vbInformation WScript.Quit End If err.clear Set GetHTTPObject = http End Function ' Function GetHTTPObject Sub ZeitAnfrage For zaehler = 0 to 4 http.open "GET","http://tycho.usno.navy.mil/cgi-bin/timer.pl"& Now(),false zeit1 = Now On Error Resume Next http.send If Err.Number <> 0 Then wshshell.Popup "Es besteht keine verwendbare Verbindung zum Internet!" , 120, WScript.ScriptName & " - Fehler", 4096 + vbInformation WScript.Quit End If zeit2 = Now anfragedauer = DateDiff("s", zeit1, zeit2) gmttime = http.getResponseHeader("Date") ' wshshell.Popup gmttime , 2 , " akt. Datum / Zeit (" & zaehler & ")", 0 ' MsgBox gmttime , , " akt. Datum / Zeit (" & zaehler & ")" gmttime = Right(gmttime, Len(gmttime) - 5) gmttime = Left(gmttime, Len(gmttime) - 3) If anfragedauer < 2 Then Exit For Next If zaehler = 4 then wshshell.Popup "Anfrage kann nicht verarbeitet werden. Später versuchen...", 60, WScript.ScriptName & " - Fehler", 4096 + vbInformation WScript.Quit End If gmttime = Replace(gmttime, " Dec ", " 12 ") gmttime = Replace(gmttime, " Nov ", " 11 ") gmttime = Replace(gmttime, " Oct ", " 10 ") gmttime = Replace(gmttime, " Sep ", " 09 ") gmttime = Replace(gmttime, " Aug ", " 08 ") gmttime = Replace(gmttime, " Jul ", " 07 ") gmttime = Replace(gmttime, " Jun ", " 06 ") gmttime = Replace(gmttime, " May ", " 05 ") gmttime = Replace(gmttime, " Apr ", " 04 ") gmttime = Replace(gmttime, " Mar ", " 03 ") gmttime = Replace(gmttime, " Feb ", " 02 ") gmttime = Replace(gmttime, " Jan ", " 01 ") remotedate = DateAdd("h", Zeitzone, gmttime) diff = DateDiff("s",zeit1,remotedate) newnow = DateAdd("s", diff + anfragedauer, Now) datumjetzt = DateValue(newnow) tagabweichung = DateDiff("d", Date, datumjetzt) zeitjetzt = TimeValue(newnow) zeitjetzt = Right(0 & Hour(zeitjetzt), 2) & ":" & Right(0 & Minute(zeitjetzt), 2) & ":" & Right(0 & Second(zeitjetzt), 2) ' wshshell.Popup zeitjetzt , 3 , WScript.ScriptName, 0 sekabweichung = DateDiff("s", Time, zeitjetzt) End Sub ' Sub ZeitAnfrage Sub LogDatei ' Set FileOut = fso.OpenTextFile("TimeSet.Log", 2, true) ' Datei zum Erweitern öffnen (notfals anlegen) Set FileOut = fso.OpenTextFile("TimeSet.Log", 8, true) ' Datei zum Erweitern öffnen (notfals anlegen) fileOut.WriteLine (TextX) Set FileOut = Nothing ' Datei schließen End Sub ' Sub TimeSet.Log