Ok, I think I figured it out.
Draw a winsock control and a command button on a form, and paste the code. It will synchronize your system time with the atom clock of the nist institute.
Code:Option Explicit Private Declare Function SetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As Long 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 Sub GetTime() Dim TimeOut As Boolean Dim StartTime As Single TimeOut = False StartTime = Timer Winsock1.RemoteHost = "time.nist.gov" Winsock1.RemotePort = 13 Winsock1.Connect While (Not Winsock1.State = 7) Or TimeOut DoEvents TimeOut = Timer > StartTime + 5 Wend End Sub Private Sub Command1_Click() Call GetTime End Sub Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Dim strData As String Winsock1.GetData strData, vbString Call SetTime(strData) Winsock1.Close Winsock1.LocalPort = 0 Unload Me End Sub Private Sub SetTime(ByVal TimeString As String) Dim RetVal As Long Dim udtTime As SYSTEMTIME Dim TempDate As Date If Val(Mid(TimeString, 31, 1)) < 2 Then 'server is healthy enough TempDate = CDate(Val(Mid(TimeString, 2, 5)) - 15018) With udtTime .wYear = Year(TempDate) .wDayOfWeek = 0 .wMonth = Month(TempDate) .wDay = Day(TempDate) .wHour = Val(Mid(TimeString, 17, 2)) .wMinute = Val(Mid(TimeString, 20, 2)) .wSecond = Val(Mid(TimeString, 23, 2)) .wMilliseconds = 0 End With RetVal = SetSystemTime(udtTime) End If End Sub




Reply With Quote