The following code uses a Winsock control to connect to a NIST time server.

Private Sub Command1_Click() 'Main button to set the system
    ' time
    On Error GoTo ErrHandler

    Label3.Caption = "System Time has Not been Set Yet"

    SetIt = 1 'Used to only set time if the time from the
        ' time server is valid and reportedly accurate

    If Winsock1.State <> sckClosing Then 'Sometimes the
        ' Winsock gets delayed in the closing state, so
        ' make sure it is closed before trying again
       If Winsock1.State = sckClosed Then 'If closed, ok to
           ' open, else close it
          Timer1.Interval = 5000 'Start 5 second count to
              ' 'time' server
          Timer1.Enabled = True
          Screen.MousePointer = vbHourglass
          Winsock1.LocalPort = 0 'Must be set to 0
          Winsock1.RemoteHost = Trim$(Text1.Text) 'Address
              ' of NIST server
          Winsock1.RemotePort = 13 '13, 37 or 123 'Use 13!
          Winsock1.Protocol = 0 '1-UDP '0-TCP 'USE TCP!
          Winsock1.Connect 'This is what goes out and gets
              ' the time
       Else
          Winsock1.Close
          Screen.MousePointer = vbNormal
          Timer1.Interval = 0
          Timer1.Enabled = False
       End If
    Else
       Winsock1.Close
       Screen.MousePointer = vbNormal
       Timer1.Interval = 0
       Timer1.Enabled = False
    End If
    
    Exit Sub
ErrHandler:
    SetIt = 0
    Screen.MousePointer = vbNormal
    Timer1.Interval = 0
    Timer1.Enabled = False
    MsgBox "The Winsock Connection is Unavailable."
    Winsock1.Close
End Sub

    52949 03-11-06 16:23:43 00 0 0 650.2 UTC(NIST) *

The following code parses this data, uses it to initialize a SYSTIME structure, and then uses the SetSystemTime API function to set the system's time.

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) _
    'Fires when data is received from server
Dim datDate As Date 'formatted date
Dim strData As String 'time string from net time server
Dim JSys As SYSTEMTIME
Dim RetVal As Integer
Dim Ct As Integer

    On Error GoTo ErrHandler
    
    Winsock1.GetData strData, vbString 'get string from
        ' server
    datDate = FormatDateTime(strData) 'go format the new
        ' string
    
    If msAdj <> 0 Then 'if msadj = 0 then do not set an
        ' offset
       datDate = DateAdd("s", -1, datDate) 'only if msadj
           ' <> 0, subtract 1 sec from new time so addition
           ' of msadj is positive
    End If
    
    Label1.Caption = "Before " & Now 'time before adjustment
    
    If SetIt = 1 Then 'If all is ok, set system time
    
       'Initialize SYSTIME with new data
       JSys.wYear = Year(datDate)
       JSys.wMonth = Month(datDate)
       JSys.wDayOfWeek = 0 'DayOfWeek(datDate)'Not used
       JSys.wHour = Hour(datDate)
       JSys.wMinute = Minute(datDate)
       JSys.wSecond = Second(datDate)
       JSys.wDay = Day(datDate)
       
       If msAdj = 0 Then
          JSys.wMilliseconds = 0 'No millisec offset
       Else
          JSys.wMilliseconds = ((10000 - msAdj) / 10) 'must
              ' be positive
       End If
       
       'Set system time with new data
       Do Until RetVal <> 0 Or Ct > 9 'Make up to 10
           ' attempts to set the time
          RetVal = SetSystemTime(JSys)
          Ct = Ct + 1
       Loop
       
       Label2.Caption = "After " & Now 'time after
           ' adjustment
       
       If RetVal <> 0 Then
          Label3.Caption = "System Time was Set " & _
              "Successfully"
       Else
          Label3.Caption = "There was an Error in Setting " & _
              "Time"
       End If
       
       'Display time string that was sent from server
       Text2.Text = strData
    End If
    
    SetIt = 0
    Winsock1.Close
    Screen.MousePointer = vbNormal
    Timer1.Interval = 0
    Timer1.Enabled = False
    
    Exit Sub
ErrHandler:
    SetIt = 0
    Winsock1.Close
    Screen.MousePointer = vbNormal
    Timer1.Interval = 0
    Timer1.Enabled = False
End Sub

• NIST Internet Time Service (ITS). Software and instructions for installing the NISTIME application. It should run on most Windows and Mac computers.
• The Official U.S. Time. This runs a clock in your browser that is accurrate to within 1 second (in United States time zones).