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