Windows 10 - Sync time at computer startup

README.md

Windows 10 Timesync VBS Script

• Feature : Update local clock synced with http webserver
• Requirements: Working windows with VBS Host, Administrator right access

Usage

• Run .vbs script driectly or setup a task to run at every startup
• Or you can import xml file to "Task Scheduler" management windows
• With startup task. Please import xml file to task scheduler management.
• Run test once when imported.
• If the task fail. Run secpol.msc /s and add Logon as batch script for user SYSTEM

Author

Rob van der Woude

Update for windows 10

Zuko

Synctime at start.xml

<?xml version="1.0" encoding="UTF-16"?>
<Task version="1.4" xmlns="http://schemas.microsoft.com/windows/2004/02/mit/task">
  <RegistrationInfo>
    <Date>2021-06-02T20:08:52.9254295</Date>
    <Author>ZUKO-GL552JX\Zuko</Author>
    <URI>\Synctime at start</URI>
  </RegistrationInfo>
  <Triggers>
    <BootTrigger>
      <ExecutionTimeLimit>PT2M</ExecutionTimeLimit>
      <Enabled>true</Enabled>
      <Delay>PT2M</Delay>
    </BootTrigger>
    <LogonTrigger>
      <ExecutionTimeLimit>PT2M</ExecutionTimeLimit>
      <Enabled>true</Enabled>
    </LogonTrigger>
    <SessionStateChangeTrigger>
      <ExecutionTimeLimit>PT2M</ExecutionTimeLimit>
      <Enabled>true</Enabled>
      <StateChange>ConsoleConnect</StateChange>
    </SessionStateChangeTrigger>
  </Triggers>
  <Principals>
    <Principal id="Author">
      <UserId>S-1-5-18</UserId>
      <RunLevel>HighestAvailable</RunLevel>
    </Principal>
  </Principals>
  <Settings>
    <MultipleInstancesPolicy>StopExisting</MultipleInstancesPolicy>
    <DisallowStartIfOnBatteries>false</DisallowStartIfOnBatteries>
    <StopIfGoingOnBatteries>true</StopIfGoingOnBatteries>
    <AllowHardTerminate>true</AllowHardTerminate>
    <StartWhenAvailable>true</StartWhenAvailable>
    <RunOnlyIfNetworkAvailable>true</RunOnlyIfNetworkAvailable>
    <IdleSettings>
      <StopOnIdleEnd>true</StopOnIdleEnd>
      <RestartOnIdle>false</RestartOnIdle>
    </IdleSettings>
    <AllowStartOnDemand>true</AllowStartOnDemand>
    <Enabled>true</Enabled>
    <Hidden>false</Hidden>
    <RunOnlyIfIdle>false</RunOnlyIfIdle>
    <DisallowStartOnRemoteAppSession>false</DisallowStartOnRemoteAppSession>
    <UseUnifiedSchedulingEngine>true</UseUnifiedSchedulingEngine>
    <WakeToRun>false</WakeToRun>
    <ExecutionTimeLimit>PT2M</ExecutionTimeLimit>
    <Priority>7</Priority>
    <RestartOnFailure>
      <Interval>PT1M</Interval>
      <Count>30</Count>
    </RestartOnFailure>
  </Settings>
  <Actions Context="Author">
    <Exec>
      <Command>cscript.exe</Command>
      <Arguments>"D:\Desktop\timesyncweb.vbs"</Arguments>
    </Exec>
  </Actions>
</Task>

timesyncweb.vbs

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