File "ntp-sync.bas"
Path: /ntp-sync/ntp-sync.bas
File size: 11.55 KB
MIME-type:
Charset: utf-8
#COMPILE EXE
#DIM ALL
#REGISTER NONE
#TOOLS OFF
#RESOURCE "ntp-sync.pbr"
%NOMMIDS = 1
%NOGDI = 1
#INCLUDE "WIN32API.INC"
MACRO STARTUP_X = RTRIM$(ENVIRON$("APPDATA"),"\") + "\Microsoft\Windows\Start Menu\Programs\Startup\ntp-sync.exe"
MACRO STARTUP_L = RTRIM$(ENVIRON$("TEMP"),"\") + "\ntp-sync.log"
'---------------------------------------------------------------------------------------------------
FUNCTION PBMAIN AS LONG
LOCAL ff AS LONG
LOCAL r AS STRING
' First launch: propose to register
IF NOT EXIST(STARTUP_X) THEN
IF ?("Would you like to synchronize your " _
+ "computer to the atomic time at log on?" _
, %MB_ICONQUESTION + %MB_YESNO, "ntp-sync") _
= %IDYES THEN
' Attempt a registration, then sync
FILECOPY EXE.FULL$, STARTUP_X
NtpSync()
? "Program successfully registered." + $CR _
+ "Launch it again to check the last time syncs.", _
%MB_ICONINFORMATION, "ntp-sync"
ELSE
' Registration refused by the user
? "Aborted.", %MB_ICONWARNING, "ntp-sync"
END IF
EXIT FUNCTION
END IF
' Legacy: move possible logs from Local to %Temp%
IF EXIST(EXE.NAME$+".log") AND NOT EXIST(STARTUP_L) THEN
NAME EXE.NAME$+".log" AS STARTUP_L
END IF
' If launched from %RoamingAppData% -> launch a sync then quit
IF UCASE$(EXE.FULL$) = UCASE$(STARTUP_X) THEN
NtpSync()
EXIT FUNCTION
END IF
' If launched from anywhere else -> propose to see the logs
IF NOT EXIST(STARTUP_L) THEN
?"No logs to show.", %MB_ICONINFORMATION, "ntp-sync"
EXIT FUNCTION
END IF
IF MSGBOX("Would you like to check the last time syncs?" _
, %MB_ICONQUESTION + %MB_YESNO, "ntp-sync") = %IDYES THEN
ShowLogs()
END IF
END FUNCTION
'---------------------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------------
SUB ShowLogs()
LOCAL hDlg AS DWORD
LOCAL lStyle AS LONG
DIALOG NEW PIXELS, 0, "ntp-sync",,, 520, 246, _
%WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_CAPTION OR _
%WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_CLIPSIBLINGS OR _
%DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
%DS_SETFONT OR %WS_VISIBLE OR %WS_THICKFRAME _
, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _
%WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR _
, TO hDlg
DIALOG SET ICON hDlg, "AICO"
CONTROL ADD LISTVIEW, hDlg, 1000, "", 8, 8, 504, 200
LISTVIEW INSERT COLUMN hDlg, 1000, 1, "Time Stamp",120, %SS_LEFT
LISTVIEW INSERT COLUMN hDlg, 1000, 2, "Log Entry", 430, %SS_LEFT
LISTVIEW GET STYLEXX hDlg, 1000 TO lStyle
lStyle = lStyle + %LVS_EX_FULLROWSELECT + %LVS_EX_GRIDLINES
LISTVIEW SET STYLEXX hDlg, 1000, lStyle
CONTROL ADD BUTTON, hDlg, %IDCANCEL, "Close", 422, 216, 80, 24, _
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_PUSHBUTTON OR _
%BS_TEXT OR %BS_CENTER OR %BS_VCENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
DIALOG SHOW MODAL hDlg, CALL ProcLogs
END SUB
'---------------------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------------
CALLBACK FUNCTION ProcLogs
STATIC tid AS LONG
LOCAL ff,w,h AS LONG
LOCAL e AS STRING
IF CB.MSG = %WM_INITDIALOG THEN
ff = FREEFILE
OPEN STARTUP_L FOR INPUT AS #ff
DO
LINE INPUT #ff, e
LISTVIEW INSERT ITEM CB.HNDL, 1000, 1, %NULL, MID$(e, 2, LEN("YYYMMDD-HHmmSS,xxx")+1)
LISTVIEW SET TEXT CB.HNDL, 1000, 1, 2, TRIM$(MID$(e, LEN("YYYMMDD-HHmmSS,xxx")+4))
LOOP UNTIL EOF(#ff)
CLOSE #ff
SETTIMER CB.HNDL, tid, 4000, BYVAL 0
ELSEIF CB.MSG = %WM_TIMER THEN ' User message to force an ntp-sync at startup
KILLTIMER CB.HNDL, tid : tid = 0
DIALOG SET TEXT CB.HNDL, "ntp-sync (syncing...)"
NtpSync()
DIALOG SET TEXT CB.HNDL, "ntp-sync"
ELSEIF CB.MSG = %WM_EXITSIZEMOVE OR CB.MSG = %WM_SIZE THEN ' Dialog resize notif
IF CB.WPARAM = %SIZE_MAXIMIZED OR _
CB.WPARAM = %SIZE_RESTORED THEN
DIALOG GET CLIENT CB.HNDL TO w, h
CONTROL SET SIZE CB.HNDL, 1000, w-16, h-46
CONTROL SET LOC CB.HNDL, %IDCANCEL, w-98, h-30
END IF
ELSEIF CB.MSG = %WM_COMMAND AND CB.CTL = %IDCANCEL THEN ' Close button
DIALOG END CB.HNDL
END IF
END FUNCTION
'---------------------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------------
TYPE InputBuffer
JJJJJ AS ASCIIZ * 6 ' Modified Julian Date
year AS ASCIIZ * 3
month AS ASCIIZ * 3
day AS ASCIIZ * 3
hour AS ASCIIZ * 3
minute AS ASCIIZ * 3
second AS ASCIIZ * 3
TT AS ASCIIZ * 3 ' Regards US Standard or Daylight Saving Time
L AS ASCIIZ * 2 ' To leap or not to leap, that is the question
Health AS ASCIIZ * 2 ' = 0 for healthy, = 1 for < 5 secs error & should be OK within 10 minutes
' = 2 for > 5 secs error & = 4 for unknown error
msADV AS ASCIIZ * 6 ' millisecond advance for ACTS but not RFC-867
sLabel AS STRING * 9 ' Should be UTC(NIST)
dummy AS STRING * 1
otm AS STRING * 1 ' On-time marker (*) - no cr/lf pair sent
END TYPE
'---------------------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------------
UNION BufferUnion
wholeStr AS STRING * 48
section AS InputBuffer
END UNION
'---------------------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------------
FUNCTION NtpSync AS LONG
LOCAL hSocket, numberOfTimeServers, iCount, dummy, success, Start, Finish AS LONG
LOCAL wNistMilliseconds AS WORD
DIM DataBuffer AS BufferUnion
LOCAL qvTime AS QUAD
DIM udtvTime AS SYSTEMTIME
REDIM Site(0) AS STRING
REDIM SiteName(0) AS STRING
numberOfTimeServers = FillArray( Site(), SiteName() )
RANDOMIZE
' Shuffle the time servers to use
FOR iCount = 1 TO numberOfTimeServers - 1
dummy = RND(iCount, numberOfTimeServers)
SWAP Site(iCount), Site(dummy)
SWAP SiteName(iCount), SiteName(dummy)
NEXT
FOR iCount = 1 TO numberOfTimeServers
ERRCLEAR
hSocket = FREEFILE
TCP OPEN PORT 13 AT Site(iCount) AS hSocket TIMEOUT 2000
IF ERR = 0 THEN
Start = TIMEGETTIME() ' ................................................................. [1]
TCP LINE INPUT hSocket, DataBuffer.wholeStr
TCP LINE INPUT hSocket, DataBuffer.wholeStr
Finish = TIMEGETTIME() '................................................................. [2]
TCP CLOSE hSocket
' We should have got the on-time marker - try another server
IF VAL(DataBuffer.section.Health) > 0 THEN EXIT IF
IF DataBuffer.section.otm <> "*" THEN EXIT IF
udtvTime.wYear = VAL(DataBuffer.section.year) + 2000
udtvTime.wMonth = VAL(DataBuffer.section.month)
udtvTime.wDay = VAL(DataBuffer.section.day)
udtvTime.wHour = VAL(DataBuffer.section.hour)
udtvTime.wMinute = VAL(DataBuffer.section.minute)
udtvTime.wSecond = VAL(DataBuffer.section.second)
wNistMilliseconds = VAL(DataBuffer.section.msADV) ' the ms value to the next whole second
SYSTEMTIMETOFILETIME udtvTime, BYVAL VARPTR(qvTime)
' FILETIME routines used as opposed to VARIANTTIME routines as suggested by Clay Clear
' We are going to add latency which is the time estimated by ([2] - [1]) / 2
' and subtract 45ms which is the 'correction' for US users.
qvTime = qvTime + ((Finish - Start) / 2 - wNistMilliseconds - 45) * 10000
FILETIMETOSYSTEMTIME BYVAL VARPTR(qvTime), udtvTime
SETSYSTEMTIME udtvTime
POSTMESSAGE %HWND_TOPMOST, %WM_TIMECHANGE, 0&, 0& ' another suggestion by Clay Clear
success = %TRUE
LogMe "Time set by " + SiteName(iCount) + " (# of servers tried:" _
+ STR$(iCount) + ") - Estimated Latency:" + STR$((Finish - Start) \ 2) + "ms"
EXIT FOR
END IF
NEXT
IF ISFALSE success THEN LogMe "Failed to get time - Error:" + STR$(ERR)
END FUNCTION
'---------------------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------------
FUNCTION FillArray( MyArray1( ) AS STRING, MyArray2( ) AS STRING ) AS LONG
LOCAL x AS LONG
REDIM MyArray1( 1 TO DATACOUNT/2 ) AS STRING
REDIM MyArray2( 1 TO DATACOUNT/2 ) AS STRING
FOR x = 1 TO DATACOUNT/2
MyArray1( x ) = READ$( 2 * x - 1 ) ' giving 1, 3, 5, ..., DATACOUNT - 1
MyArray2( x ) = READ$( 2 * x ) ' giving 2, 4, 6, ..., DATACOUNT
NEXT
FUNCTION = DATACOUNT/2
DATA time-a.timefreq.bldrdoc.gov
DATA "NIST, Boulder A, Colorado"
DATA time-b.timefreq.bldrdoc.gov
DATA "NIST, Boulder B, Colorado"
DATA time-c.timefreq.bldrdoc.gov
DATA "NIST, Boulder C, Colorado"
DATA utcnist.colorado.edu
DATA "University of Colorado, Boulder"
DATA time.nist.gov
DATA "NCAR, Boulder, Colorado"
DATA time-nw.nist.gov
DATA "Microsoft, Redmond, Washington"
DATA nist1.symmetricom.com
DATA "Symmetricom, San Jose, California"
DATA nist1-dc.WiTime.net
DATA "WiTime, Virginia"
DATA nist1-ny.WiTime.net
DATA "WiTime, New York City"
DATA nist1-sj.WiTime.net
DATA "WiTime, San Jose, California"
DATA nist1.aol-ca.symmetricom.com
DATA "Symmetricom, AOL facility, Sunnyvale, California"
DATA nist1.aol-va.symmetricom.com
DATA "Symmetricom, AOL facility, Virginia"
DATA nist1.columbiacountyga.gov
DATA "Columbia County, Georgia"
DATA nist.expertsmi.com
DATA "Monroe, Michigan"
END FUNCTION
'---------------------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------------
FUNCTION EXIST(BYVAL fileOrFolder AS STRING) AS LONG
LOCAL Dummy&
Dummy& = GETATTR(fileOrFolder)
FUNCTION = (ERRCLEAR = 0)
END FUNCTION
'---------------------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------------
FUNCTION TimeStamp() AS STRING
' YYYMMDD-HHmmSS,xxx
LOCAL t AS STRING
t = DATE$
t = RIGHT$(t,4)+LEFT$(t,2)+MID$(t,4,2)
t += "-"+REMOVE$(TIME$,":")
t += ","+FORMAT$((TIMER*1000) MOD 1000, "000")
FUNCTION = t
END FUNCTION
'---------------------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------------
SUB LogMe(BYVAL e AS STRING)
LOCAL ff AS LONG
' Append to existing log file
ff = FREEFILE
OPEN STARTUP_L FOR APPEND AS #ff
PRINT #ff, "[" + TimeStamp() + "] " + e
CLOSE #ff
END SUB
'---------------------------------------------------------------------------------------------------