http://dieseyer.de • all rights reserved • © 2011 v11.4

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



http://dieseyer.de • all rights reserved • © 2011 v11.4