#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
'---------------------------------------------------------------------------------------------------