|
Option Explicit |
|
|
|
Dim arrDateTime |
|
Dim blnTest |
|
Dim dtmDateTime, dtmNewDateTime |
|
Dim intDateDiff, intOffset, intStatus, intThreshold, intTimeDiff |
|
dim colItems, objHTTP, objItem, objRE, objWMIService |
|
Dim strDateTime, strLocalDateTime, strMsg, strNewdateTime, strURL |
|
|
|
' Defaults |
|
intThreshold = 10 |
|
strURL = "http://zuko.pro/" |
|
|
|
' Check command line arguments |
|
With WScript.Arguments |
|
If .Named.Count > 0 Then Syntax |
|
If .Unnamed.Count > 2 Then Syntax |
|
If .Unnamed.Count > 0 Then |
|
If IsNumeric( .Unnamed(0) ) Then |
|
intThreshold = CInt( .Unnamed(0) ) |
|
Else |
|
strURL = .Unnamed(0) |
|
End If |
|
End If |
|
If .Unnamed.Count = 2 Then |
|
If IsNumeric( .Unnamed(1) ) Then |
|
intThreshold = CInt( .Unnamed(1) ) |
|
Else |
|
strURL = .Unnamed(1) |
|
End If |
|
' Only 1 argument should be numeric, not both |
|
If IsNumeric( .Unnamed(0) ) And IsNumeric( .Unnamed(1) ) Then |
|
Syntax |
|
End If |
|
' 1 argument should be numeric |
|
If Not ( IsNumeric( .Unnamed(0) ) Or IsNumeric( .Unnamed(1) ) ) Then |
|
Syntax |
|
End If |
|
End If |
|
' Threshold value must be between 0 and 60 |
|
If intThreshold < 0 Then Syntax |
|
If intThreshold > 60 Then Syntax |
|
' URL must be a WEB server (full URL including protocol) |
|
blnTest = False |
|
Set objRE = New RegExp |
|
objRE.Pattern = "^https?://.+$" |
|
blnTest = objRE.Test( strURL ) |
|
Set objRE = Nothing |
|
If Not blnTest Then Syntax |
|
End With |
|
|
|
' Get server time from a web server |
|
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" ) |
|
objHTTP.Open "GET", strURL, False |
|
objHTTP.SetRequestHeader "User-Agent", WScript.ScriptName |
|
' WScript.Echo strURL |
|
' WScript.Echo WScript.ScriptName |
|
On Error Resume Next |
|
objHTTP.Send |
|
intStatus = objHTTP.Status |
|
strDateTime = objHTTP.GetResponseHeader( "Date" ) |
|
WScript.Echo "Server time : " + strDateTime |
|
Set objHTTP = Nothing |
|
If Err Then Syntax |
|
On Error Goto 0 |
|
|
|
' Abort if the server could not be reached |
|
If intStatus <> 200 Then Syntax |
|
|
|
' Convert the returned Apache timestamp string to a date to work with |
|
arrDateTime = Split( strDateTime, " " ) |
|
strDateTime = arrDateTime(1) & " " _ |
|
& arrDateTime(2) & " " _ |
|
& arrDateTime(3) & " " _ |
|
& arrDateTime(4) |
|
dtmDateTime = CDate( strDateTime ) |
|
strDateTime = Year( dtmDateTime ) _ |
|
& Right( "0" & Month( dtmDateTime ), 2 ) _ |
|
& Right( "0" & Day( dtmDateTime ), 2 ) _ |
|
& Right( "0" & Hour( dtmDateTime ), 2 ) _ |
|
& Right( "0" & Minute( dtmDateTime ), 2 ) _ |
|
& Right( "0" & Second( dtmDateTime ), 2 ) |
|
|
|
' Get and set local system date and time |
|
Set objWMIService = GetObject( "winmgmts:{(Systemtime)}//./root/CIMV2" ) |
|
Set colItems = objWMIService.ExecQuery( "Select * From Win32_OperatingSystem" ) |
|
For Each objItem In colItems |
|
' Get timezone offset telative to GMT |
|
intOffset = CInt( objItem.CurrentTimeZone ) |
|
' Get current local system time ("before" time) |
|
strLocalDateTime = objItem.LocalDateTime |
|
' Add offset to GMT to get correct local time |
|
dtmNewDateTime = DateAdd( "n", intOffset, dtmDateTime ) |
|
' Format date and time string to be used to set new system time |
|
strNewdateTime = Year( dtmNewDateTime ) _ |
|
& Right( "0" & Month( dtmNewDateTime ), 2 ) _ |
|
& Right( "0" & Day( dtmNewDateTime ), 2 ) _ |
|
& Right( "0" & Hour( dtmNewDateTime ), 2 ) _ |
|
& Right( "0" & Minute( dtmNewDateTime ), 2 ) _ |
|
& Right( "0" & Second( dtmNewDateTime ), 2 ) |
|
If intOffset < 0 Then |
|
strNewdateTime = strNewdateTime & ".000000-" & Right( CStr( intOffset - 1000 ), 3 ) |
|
Else |
|
strNewdateTime = strNewdateTime & ".000000+" & Right( CStr( intOffset + 1000 ), 3 ) |
|
End If |
|
' Check difference between local and server date and time |
|
intDateDiff = CLng( Left( strLocalDateTime, 8 ) ) - CLng( Left( strNewdateTime, 8 ) ) |
|
intTimeDiff = CLng( Mid( strLocalDateTime, 9, 6 ) ) - CLng( Mid( strNewdateTime, 9, 6 ) ) |
|
If Abs( intTimeDiff ) > intThreshold Then |
|
' Set new date and time |
|
objItem.SetDateTime strNewdateTime |
|
' Display "before" and "after" time |
|
strMsg = "Synchronized:" & vbCrLf _ |
|
& "Before:" & vbTab & strLocalDateTime & vbCrLf _ |
|
& "After: " & vbTab & strNewdateTime |
|
Else |
|
' Display "local" and "server" time |
|
strMsg = "Skipped synchronization (threshold " & intThreshold & " second" |
|
If intThreshold > 1 Then strMsg = strMsg & "s" |
|
strMsg = strMsg & ")" & vbCrLf _ |
|
& "Local: " & vbTab & strLocalDateTime & vbCrLf _ |
|
& "Server:" & vbTab & strNewdateTime |
|
End If |
|
WScript.Echo strMsg |
|
Next |
|
Set colItems = Nothing |
|
Set objWMIService = Nothing |
|
|
|
|
|
Sub Syntax( ) |
|
Dim strMsg |
|
strMsg = vbCrLf _ |
|
& WScript.ScriptName & ", Version 1.10" _ |
|
& vbCrLf _ |
|
& "Synchronize the local system date and time with a web server" _ |
|
& vbCrLf & vbCrLf _ |
|
& "Usage:" & vbTab & WScript.ScriptName & " [ server ] [ seconds ]" _ |
|
& vbCrLf & vbCrLf _ |
|
& "Where:" & vbTab & "server " & vbtab & "is the URL of the web server to synchronize date" _ |
|
& vbCrLf _ |
|
& " " & vbTab & " " & vbTab & "and time with (default: http://zuko.pro/)" _ |
|
& vbCrLf _ |
|
& " " & vbTab & "seconds" & vbTab & "is the threshold in seconds (i.e. if the difference" _ |
|
& vbCrLf _ |
|
& " " & vbTab & " " & vbTab & "between the current and new time is less, skip" _ |
|
& vbCrLf _ |
|
& " " & vbTab & " " & vbTab & "synchronization; 0..60, default: 10)" _ |
|
& vbCrLf & vbCrLf _ |
|
& "Author: Rob van der Woude."_ |
|
& vbCrLf _ |
|
& "Update win10 : Zuko." _ |
|
& vbCrLf _ |
|
& "https://zuko.pro - https://zuko.pw" |
|
WScript.Echo strMsg |
|
WScript.Quit 1 |
|
End Sub |