Visual Basic Network Services

SetSystemTime: SNTP Time Server Synchronization using Winsock
     
Posted:   Sunday February 03, 2002
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   None, but see Comments below.
Author:   VBnet - Randy Birch, MSKB, Paul Hewson
     

Related:  

WM_TIMECHANGE: Detect System Changes to the Date/Time
RegQueryValueEx: Identify Time Zones by Time Zone Bias
NetRemoteTOD: Get Time of Day Info for Local or Remote Machines
SetSystemTime: Date and Time Synchronization to a Remote Server
     
 Prerequisites
Network or DUN connection.

Windows XP, as part of enhanced Date/Time control panel functionality, provides for automatic updating of the system date/time via connection to either of a pair of Simple Network Time Protocol (SNTP) time servers that are available on the Internet (time.windows.com and time.nist.gov). This is the same functionality gained by issuing a NET TIME command.  

Shown in the illustration is the result of calling the indicated time server using just the Winsock control provided with VB and the SetSystemTime API. The 32bit time stamp returned by SNTP servers is the number of seconds since midnight 1 January 1900 GMT, such that the time "1" is 12:00:01 am on January 1, 1900 GMT. Using a base of 1990, the SNTP time routines will serve until 2036. 

About NTP Time Servers
There are two levels, or tiers, of Network Time Protocol (NTP) time servers that are available on the Internet. The NTP is defined in Request for Comments (RFC) 1305.

The first-level time servers are primarily intended to act as source time servers for second-level time servers. The first-level time servers may also be capable of providing mission-critical time services. Some first-level time servers may have a restricted access policy.

Second-level time servers are intended for general SNTP time service needs. Second-level time servers usually enable public access. It is recommended that you use second-level time servers for normal SNTP time server configuration because they are usually located on a closer network that can produce faster updates. And it is further recommended that you research any time server selection to ensure that it can meet your specific time server requirements. For a larger list of servers, check out MS knowledge base article Q262680.

 BAS Module Code
None.

 Form Code
To a form add a combo (Combo1), a list (List1), a Winsock control (Winsock1), and two command buttons (Command1, Command2), along with the following code:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim sNTP As String      'the 32bit time stamp returned by the server
Dim TimeDelay As Single 'the time between the acknowledgement of
                        'the connection and the data received.
                        'we compensate by adding half of the round
                        'trip latency
Private Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
End Type

Private Declare Function SetSystemTime Lib "kernel32" _
   (lpSystemTime As SYSTEMTIME) As Long



Private Sub Form_Load()
   
   With Combo1
   .AddItem "time-a.timefreq.bldrdoc.gov"
   .AddItem "time-b.timefreq.bldrdoc.gov"
   .AddItem "time-c.timefreq.bldrdoc.gov"
   .AddItem "utcnist.colorado.edu"
   .AddItem "time-nw.nist.gov"
   .AddItem "nist1.nyc.certifiedtime.com"
   .AddItem "nist1.dc.certifiedtime.com"
   .AddItem "nist1.sjc.certifiedtime.com"
   .AddItem "nist1.datum.com"
   .AddItem "ntp2.cmc.ec.gc.ca"
   .AddItem "ntps1-0.uni-erlangen.de"
   .AddItem "ntps1-1.uni-erlangen.de"
   .AddItem "ntps1-2.uni-erlangen.de"
   .AddItem "ntps1-0.cs.tu-berlin.de"
   .AddItem "time.ien.it"
   .AddItem "ptbtime1.ptb.de"
   .AddItem "ptbtime2.ptb.de"
   .ListIndex = 0
   End With

End Sub


Private Sub Command1_Click()

  'show routine's activity for debugging
   With List1
      If .ListCount > 0 Then .AddItem ""
      .AddItem "target: " & Combo1.Text
      .AddItem "opening connection"
   End With
   
  'clear the string used for incoming data
   sNTP = Empty
   
  'connect 
   With Winsock1
      If .State <> sckClosed Then .Close
      .RemoteHost = Combo1.Text
      .RemotePort = 37  'port 37 is the timserver port
      .Connect
   End With
   
End Sub


Private Sub Command2_Click()

  'opens the date/time window
   Call Shell("rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,0", vbNormalFocus)
   
End Sub


Private Sub Winsock1_Connect()

   List1.AddItem "   winsock connection made"

End Sub


Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
   
   Dim sData As String
   Winsock1.GetData sData, vbString
   sNTP = sNTP & sData
   
   List1.AddItem "      data received: " & sData & "    (" & bytesTotal & " bytes)"

End Sub


Private Sub Winsock1_Close()
   
   On Error Resume Next
   List1.AddItem "   closing connection"
   Winsock1.Close
   List1.AddItem "   sockets closed"
   
   Call SyncSystemClock(sNTP)

End Sub


Private Sub SyncSystemClock(ByVal sTime As String)

   Dim NTPTime As Double
   Dim UTCDATE As Date
   Dim dwSecondsSince1990 As Long
   Dim ST As SYSTEMTIME
   
   sTime = Trim(sTime)
   
   If Len(sTime) = 4 Then
   
     'since the data was returned in a string, 
     'format it back into a numeric value 
      NTPTime = Asc(Left$(sTime, 1)) * (256 ^ 3) + _
                Asc(Mid$(sTime, 2, 1)) * (256 ^ 2) + _
                Asc(Mid$(sTime, 3, 1)) * (256 ^ 1) + _
                Asc(Right$(sTime, 1))
                      
     'and create a valid date based on 
     'the seconds since January 1, 1990 
      dwSecondsSince1990 = NTPTime - 2840140800#

      UTCDATE = DateAdd("s", CDbl(dwSecondsSince1990), #1/1/1990#)
   
     'fill a SYSTEMTIME structure with the appropriate values
      With ST
         .wYear = Year(UTCDATE)
         .wMonth = Month(UTCDATE)
         .wDay = Day(UTCDATE)
         .wHour = Hour(UTCDATE)
         .wMinute = Minute(UTCDATE)
         .wSecond = Second(UTCDATE)
      End With
   
     'just shows what's happening
      With List1
         .AddItem "   beginning system clock synchronization"
         .AddItem "      data value (GMT): " & vbTab & NTPTime
         .AddItem "      sec since 1990 (GMT):" & vbTab & dwSecondsSince1990
         .AddItem "      system date (local) : " & vbTab & Now 'Date & " " & Time
         .AddItem "      synced date (GMT) : " & vbTab & UTCDATE
         .AddItem "      calling SetSystemTime"
      End With
      
     'and call the API with the new date & time
      If SetSystemTime(ST) Then
      
         List1.AddItem "clock synchronised succesfully"
         List1.TopIndex = List1.NewIndex
      
      Else
      
         List1.AddItem "SetSystemTime failed. Clock not synchronised"
      
      End If

   Else
   
      List1.AddItem "Time passed not valid. Clock not synchronised"

   End If
      
End Sub


Private Sub Winsock1_Error(ByVal Number As Integer, _
                           Description As String, _
                           ByVal Scode As Long, _
                           ByVal Source As String, _
                           ByVal HelpFile As String, _
                           ByVal HelpContext As Long, _
                           CancelDisplay As Boolean)

   With List1
      .AddItem "   error received: " & Description
      .AddItem "   error received: " & Number
   End With
   
  'if an error occurred, assure the socket is closed 
   If Number > 0 Then
   
      If Winsock1.State <> sckClosed Then
      
         Winsock1.Close
         List1.AddItem "sockets closed"
      
      Else
      
         List1.AddItem "sockets closed"
      
      End If
   End If
      
End Sub
 Comments
The Microsoft Knowledge Base contains a few articles particular to this topic.

Q216734 discusses How to Configure an Authoritative Time Server in Windows 2000.  The information is of special interest to network admins who want to synchronize servers or workstations running Windows 2000 . Q224799, again for Win2k, covers the Basic Operation of the Windows Time Service.

Network admins should also note that according to the MSDN, calling SetSystemTime under Windows NT, Windows 2000 or Windows XP enables the SE_SYSTEMTIME_NAME privilege before changing the system time. This privilege is disabled by default.


 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter