Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for timesyncweb.vbs

(view source code of timesyncweb.vbs as plain text) 

  1. Option Explicit
  2.  
  3. Dim arrDateTime
  4. Dim blnTest
  5. Dim dtmDateTime, dtmNewDateTime
  6. Dim intDateDiff, intOffset, intStatus, intThreshold, intTimeDiff
  7. dim colItems, objHTTP, objItem, objRE, objWMIService
  8. Dim strDateTime, strLocalDateTime, strMsg, strNewdateTime, strURL
  9.  
  10. ' Defaults
  11. intThreshold = 10
  12. strURL       = "http://www.xs4all.nl/"
  13.  
  14. ' Check command line arguments
  15. With WScript.Arguments
  16. 	If .Named.Count   > 0 Then Syntax
  17. 	If .Unnamed.Count > 2 Then Syntax
  18. 	If .Unnamed.Count > 0 Then
  19. 		If IsNumeric( .Unnamed(0) ) Then
  20. 			intThreshold = CInt( .Unnamed(0) )
  21. 		Else
  22. 			strURL = .Unnamed(0)
  23. 		End If
  24. 	End If
  25. 	If .Unnamed.Count = 2 Then
  26. 		If IsNumeric( .Unnamed(1) ) Then
  27. 			intThreshold = CInt( .Unnamed(1) )
  28. 		Else
  29. 			strURL = .Unnamed(1)
  30. 		End If
  31. 		' Only 1 argument should be numeric, not both
  32. 		If IsNumeric( .Unnamed(0) ) And IsNumeric( .Unnamed(1) ) Then
  33. 			Syntax
  34. 		End If
  35. 		' 1 argument should be numeric
  36. 		If Not ( IsNumeric( .Unnamed(0) ) Or IsNumeric( .Unnamed(1) ) ) Then
  37. 			Syntax
  38. 		End If
  39. 	End If
  40. 	' Threshold value must be between 0 and 60
  41. 	If intThreshold <  0 Then Syntax
  42. 	If intThreshold > 60 Then Syntax
  43. 	' URL must be a WEB server (full URL including protocol)
  44. 	blnTest = False
  45. 	Set objRE = New RegExp
  46. 	objRE.Pattern = "^https?://.+$"
  47. 	blnTest = objRE.Test( strURL )
  48. 	Set objRE = Nothing
  49. 	If Not blnTest Then Syntax
  50. End With
  51.  
  52. ' Get server time from a web server
  53. Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
  54. objHTTP.Open "GET", strURL, False
  55. objHTTP.SetRequestHeader "User-Agent", WScript.ScriptName
  56. On Error Resume Next
  57. objHTTP.Send
  58. intStatus   = objHTTP.Status
  59. strDateTime = objHTTP.GetResponseHeader( "Date" )
  60. Set objHTTP = Nothing
  61. If Err Then Syntax
  62. On Error Goto 0
  63.  
  64. ' Abort if the server could not be reached
  65. If intStatus <> 200 Then Syntax
  66.  
  67. ' Convert the returned Apache timestamp string to a date to work with
  68. arrDateTime = Split( strDateTime, " " )
  69. strDateTime = arrDateTime(1) & " " _
  70.             & arrDateTime(2) & " " _
  71.             & arrDateTime(3) & " " _
  72.             & arrDateTime(4)
  73. dtmDateTime = CDate( strDateTime )
  74. strDateTime = Year( dtmDateTime ) _
  75.             & Right( "0" & Month(  dtmDateTime ), 2 ) _
  76.             & Right( "0" & Day(    dtmDateTime ), 2 ) _
  77.             & Right( "0" & Hour(   dtmDateTime ), 2 ) _
  78.             & Right( "0" & Minute( dtmDateTime ), 2 ) _
  79.             & Right( "0" & Second( dtmDateTime ), 2 )
  80.  
  81. ' Get and set local system date and time
  82. Set objWMIService = GetObject( "winmgmts:{(Systemtime)}//./root/CIMV2" )
  83. Set colItems      = objWMIService.ExecQuery( "Select * From Win32_OperatingSystem" )
  84. For Each objItem In colItems
  85. 	' Get timezone offset telative to GMT
  86. 	intOffset        = CInt( objItem.CurrentTimeZone )
  87. 	' Get current local system time ("before" time)
  88. 	strLocalDateTime = objItem.LocalDateTime
  89. 	' Add offset to GMT to get correct local time
  90. 	dtmNewDateTime   = DateAdd( "n", intOffset, dtmDateTime )
  91. 	' Format date and time string to be used to set new system time
  92. 	strNewdateTime   = Year( dtmNewDateTime ) _
  93. 	                 & Right( "0" & Month(  dtmNewDateTime ), 2 ) _
  94. 	                 & Right( "0" & Day(    dtmNewDateTime ), 2 ) _
  95. 	                 & Right( "0" & Hour(   dtmNewDateTime ), 2 ) _
  96. 	                 & Right( "0" & Minute( dtmNewDateTime ), 2 ) _
  97. 	                 & Right( "0" & Second( dtmNewDateTime ), 2 )
  98. 	If intOffset < 0 Then
  99. 		strNewdateTime = strNewdateTime & ".000000-" & Right( CStr( intOffset - 1000 ), 3 )
  100. 	Else
  101. 		strNewdateTime = strNewdateTime & ".000000+" & Right( CStr( intOffset + 1000 ), 3 )
  102. 	End If
  103. 	' Check difference between local and server date and time
  104. 	intDateDiff = CLng( Left( strLocalDateTime, 8 ) )    - CLng( Left( strNewdateTime, 8 ) )
  105. 	intTimeDiff = CLng( Mid(  strLocalDateTime, 9, 6 ) ) - CLng( Mid(  strNewdateTime, 9, 6 ) )
  106. 	If Abs( intTimeDiff ) > intThreshold And intDateDiff = 0 Then
  107. 		' Set new date and time
  108. 		objItem.SetDateTime strNewdateTime
  109. 		' Display "before" and "after" time
  110. 		strMsg = "Synchronized:"   & vbCrLf _
  111. 		       & "Before:" & vbTab & strLocalDateTime & vbCrLf _
  112. 		       & "After: " & vbTab & strNewdateTime
  113. 	Else
  114. 		' Display "local" and "server" time
  115. 		strMsg = "Skipped synchronization (threshold " & intThreshold & " second"
  116. 		If intThreshold > 1 Then strMsg = strMsg  & "s"
  117. 		strMsg = strMsg & ")" & vbCrLf _
  118. 		       & "Local: "    & vbTab & strLocalDateTime & vbCrLf _
  119. 		       & "Server:"    & vbTab & strNewdateTime
  120. 	End If
  121. 	WScript.Echo strMsg
  122. Next
  123. Set colItems      = Nothing
  124. Set objWMIService = Nothing
  125.  
  126.  
  127. Sub Syntax( )
  128. 	Dim strMsg
  129. 	strMsg = vbCrLf _
  130. 	       & WScript.ScriptName & ", Version 1.00" _
  131. 	       & vbCrLf _
  132. 	       & "Synchronize the local system date and time with a web server" _
  133. 	       & vbCrLf & vbCrLf _
  134. 	       & "Usage:" & vbTab & WScript.ScriptName & "  [ server ]  [ seconds ]" _
  135. 	       & vbCrLf & vbCrLf _
  136. 	       & "Where:" & vbTab & "server " & vbtab & "is the URL of the web server to synchronize date" _
  137. 	       & vbCrLf _
  138. 	       & "      " & vbTab & "       " & vbTab & "and time with (default: http://www.xs4all.nl/)" _
  139. 	       & vbCrLf _
  140. 	       & "      " & vbTab & "seconds" & vbTab & "is the threshold in seconds (i.e. if the difference" _
  141. 	       & vbCrLf _ 
  142. 	       & "      " & vbTab & "       " & vbTab & "between the current and new time is less, skip" _
  143. 	       & vbCrLf _
  144. 	       & "      " & vbTab & "       " & vbTab & "synchronization; 0..60, default: 10)" _
  145. 	       & vbCrLf & vbCrLf _
  146. 	       & "Written by Rob van der Woude" _
  147. 	       & vbCrLf _
  148. 	       & "http://www.robvanderwoude.com"
  149. 	WScript.Echo strMsg
  150. 	WScript.Quit 1
  151. End Sub
  152.  

page last modified: 2025-10-11; loaded in 0.0132 seconds