PureBasic Forums - English

Code: Select all

; Credits: ChatGPT o4, Prompt by Dige

EnableExplicit

Structure NTPResult
  unixTime.q
  milliseconds.w
EndStructure

;--- Swap Endianness for long values
Procedure SwapEndianLong(val.l)
  ProcedureReturn ((val & $FF) << 24) | ((val & $FF00) << 8) | ((val & $FF0000) >> 8) | ((val & $FF000000) >> 24)
EndProcedure

;--- Calculate local time offset (e.g. +3600 for CET)
Procedure.q GetLocalTimeOffset()
  Protected local = Date()
  Protected st.SYSTEMTIME, ft.FILETIME, utc.q

  st\wYear   = Year(local)
  st\wMonth  = Month(local)
  st\wDay    = Day(local)
  st\wHour   = Hour(local)
  st\wMinute = Minute(local)
  st\wSecond = Second(local)

  SystemTimeToFileTime_(@st, @ft)
  LocalFileTimeToFileTime_(@ft, @ft)
  FileTimeToSystemTime_(@ft, @st)

  utc = Date(st\wYear, st\wMonth, st\wDay, st\wHour, st\wMinute, st\wSecond)

  ProcedureReturn local - utc
EndProcedure

;--- High-precision NTP time request
Procedure NTP_GetTime(*res.NTPResult, server.s = "ptbtime1.ptb.de")
  Protected ntpPacket.s = Space(48)
  PokeB(@ntpPacket, 27)

  Protected udp = OpenNetworkConnection(server, 123, #PB_Network_UDP)
  If udp = 0 : ProcedureReturn #False : EndIf

  SendNetworkData(udp, @ntpPacket, 48)

  Protected Timeout = ElapsedMilliseconds() + 3000
  Protected *mem = AllocateMemory(48)
  If *mem = 0 : CloseNetworkConnection(udp) : ProcedureReturn #False : EndIf

  Repeat
    If NetworkClientEvent(udp) = #PB_NetworkEvent_Data
      ReceiveNetworkData(udp, *mem, 48)

      Protected rawSec.l  = PeekL(*mem + 40)
      Protected rawFrac.l = PeekL(*mem + 44)

      Protected seconds.q = SwapEndianLong(rawSec)
      Protected fraction.q = SwapEndianLong(rawFrac)

      *res\unixTime = seconds - 2208988800
      *res\milliseconds = (fraction * 1000) / $100000000

      FreeMemory(*mem)
      CloseNetworkConnection(udp)
      ProcedureReturn #True
    EndIf
    Delay(10)
  Until ElapsedMilliseconds() > Timeout

  FreeMemory(*mem)
  CloseNetworkConnection(udp)
  ProcedureReturn #False
EndProcedure

;--- Set system time (UTC, Windows only)
Procedure SetSystemTimeFromUnix(unixTime.q)
  Protected st.SYSTEMTIME

  st\wYear   = Year(unixTime)
  st\wMonth  = Month(unixTime)
  st\wDay    = Day(unixTime)
  st\wHour   = Hour(unixTime)
  st\wMinute = Minute(unixTime)
  st\wSecond = Second(unixTime)
  st\wMilliseconds = 0

  SetSystemTime_(@st)
EndProcedure

;--- GUI setup
Procedure InitGUI()
  OpenWindow(0, 0, 0, 620, 400, "NTP Time Sync", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  TextGadget(0, 20, 15, 580, 20, "Last Sync:")
  ListIconGadget(1, 20, 40, 580, 260, "Timestamp", 180, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
  AddGadgetColumn(1, 1, "Offset (ms)", 120)
  AddGadgetColumn(1, 2, "NTP Time", 140)
  AddGadgetColumn(1, 3, "System Time", 140)
  ButtonGadget(2, 20, 320, 200, 30, "Set System Time (UTC)")
  ButtonGadget(3, 240, 320, 180, 30, "Sync Now")
  ButtonGadget(4, 440, 320, 160, 30, "Toggle Auto-Refresh")
  TextGadget(5, 20, 360, 580, 20, "Status:")
EndProcedure

;--- Time difference logging
Procedure LogTimeDiff()
  Static ntp.NTPResult
  Protected sysTime.q = Date()
  Protected result.s
  Protected localOffset = GetLocalTimeOffset()

  If NTP_GetTime(@ntp)
    ; Adjust system time to UTC
    Protected sysUTC.q = sysTime - localOffset
    Protected ntpTotalMS.q = ntp\unixTime * 1000 + ntp\milliseconds
    Protected sysTotalMS.q = sysUTC * 1000
    Protected deltaMS.q = ntpTotalMS - sysTotalMS

    ; Local view for GUI
    Protected ntpLocalTime.q = ntp\unixTime + localOffset

    result = FormatDate("%yyyy-%mm-%dd %hh:%ii:%ss", Date())
    AddGadgetItem(1, -1, result + Chr(10) + Str(deltaMS) + Chr(10) +
                  FormatDate("%hh:%ii:%ss", ntpLocalTime) + "." + RSet(Str(ntp\milliseconds), 3, "0") + Chr(10) +
                  FormatDate("%hh:%ii:%ss", sysTime))

    SetGadgetText(0, "Last Sync: " + FormatDate("%hh:%ii:%ss", Date()))
    SetGadgetText(5, "NTP response OK (" + Str(deltaMS) + " ms offset)")
  Else
    SetGadgetText(5, "⚠ Error: no response from NTP server")
  EndIf
EndProcedure

;--- Main
InitGUI()

Define autoRefresh = #True, ntp.NTPResult
AddWindowTimer(0, 1, 5000)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Break

    Case #PB_Event_Timer
      If EventTimer() = 1 And autoRefresh
        LogTimeDiff()
      EndIf

    Case #PB_Event_Gadget
      Select EventGadget()
        Case 2
          If NTP_GetTime(@ntp)
            SetSystemTimeFromUnix(ntp\unixTime)
            SetGadgetText(5, "System time set (UTC)")
          Else
            SetGadgetText(5, "⚠ Failed to set system time")
          EndIf

        Case 3
          LogTimeDiff()

        Case 4
          autoRefresh ! 1
          If autoRefresh
            SetGadgetText(5, "Auto-refresh enabled")
          Else
            SetGadgetText(5, "Auto-refresh disabled")
          EndIf
      EndSelect
  EndSelect
ForEver