Type NTP_PACKET
' поля заголовка для установки битовых параметров
     Control As UByte
     Stratum As UByte
     Poll As UByte
     Precision As UByte
' поля: базовая задержка, базовая дисперсия, идентификатор эталонных часов
     RootDelay As UInteger
     RootDispersion As UInteger
     ReferenceIdentifier As UInteger
' поля с временными метками    
     ReferenceTimestamp As NTP_TIMESTAMP   
     OriginateTimestamp As NTP_TIMESTAMP   
     ReceiveTimestamp As NTP_TIMESTAMP   
     TransmitTimestamp As NTP_TIMESTAMP   
' опциональные поля, используются при NTP-аутентификации
     KeyIdentifier As UInteger
     MessageDigest As UByte Ptr * 16
End Type

Type NTP_TIMESTAMP
     Seconds As UInteger
     Fraction As UInteger
End Type

#include once "win/winsock2.bi"

Function get_NTP_sec(ntpServ As zString, ntpPort As Integer = 123, cu_sec As Byte = 0) As Uinteger
     If(Len(ntpServ) < 5 Or InStr(ntpServ, ".") = 0) Then   
        ntpServ = "pool.ntp.org" '"193.27.209.1"
     EndIf
   Dim tdiff_ns2us as Uinteger = 2208988800
     
   Dim wsa_ptr as WSAData
     
   If WSAStartup(MAKEWORD(2, 0), @wsa_ptr) = SOCKET_ERROR Then
    return 0
   end if
     
   if(wsa_ptr.wVersion <> MAKEWORD(2, 0)) then
    WSACleanup()   
    return 0
   end If

   Dim sock as SOCKET
        
     sock = opensocket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)
     If(sock = INVALID_SOCKET) Then
        WSACleanup()
        Return 0
     EndIf

   'Dim Bcast As Bool = TRUE
   'setsockopt(sock,SOL_SOCKET,SO_BROADCAST,@Bcast,sizeof(BOOL))
     
     Dim ia as in_addr
   Dim hostentry as hostent ptr
     Dim ip_iaddr as u_long

   ia.s_addr = inet_addr(StrPtr(ntpServ))

   if (ia.s_addr = INADDR_NONE Or ia.s_addr = 0) Then
    hostentry = gethostbyname(ntpServ)
    if (hostentry = 0) Then
       WSACleanup()
     return 0
    end If
    ip_iaddr = *cast(UInteger ptr, *hostentry->h_addr_list)
   else
      ip_iaddr = ia.s_addr
   end If

     Dim saddr as sockaddr_in
     saddr.sin_family = AF_INET
   saddr.sin_port    = htons(ntpPort)
   saddr.sin_addr.s_addr =  ip_iaddr 'inet_addr(ntpServ)
     
   If(connect(sock, Cast(PSOCKADDR, @saddr), len(saddr)) = SOCKET_ERROR) Then
      'Var WSA_err = WSAGetLastError()
      '? "WSA_err = " &  WSA_Err
        closesocket(sock)
      WSACleanup()
        Return 0
   EndIf
     
     Dim ps_buff As Ubyte Ptr = Callocate(68, SizeOf(Byte))
     ps_buff[0] = &h1B
       
     if(send(sock, ps_buff, 68, 0) <= 0) Then
        closesocket(sock)
      WSACleanup()
        Return 0
     end If
     Dim pr_buff As Ubyte Ptr = Callocate(68, SizeOf(Byte))
     Dim rcv_len As Integer = 255
     Dim rcv_bytes As Integer = recv(sock, pr_buff, rcv_len, 0)
     if(rcv_bytes < 44 Or cast(Ubyte,pr_buff[40]) < 127) Then
        closesocket(sock)
      WSACleanup()
        Return 0
     end If
       
     Dim res_sec As uInteger = 0

     res_sec  = pr_buff[40] Shl 24
     res_sec += pr_buff[41] Shl 16
     res_sec += pr_buff[42] Shl 8
     res_sec += pr_buff[43] Shl 0
       
     If(res_sec <= tdiff_ns2us) Then
        Return 0
     EndIf
     If(cu_sec <> 0) Then
        Return (res_sec - tdiff_ns2us)
     EndIf     
       
     Return res_sec
End Function

#include once "crt/time.bi"

Shell "chcp 1251"

Var curr_sec = get_NTP_sec(,,1)

If(curr_sec > 0) Then
     Var tcurr_sec = cast(time_t,curr_sec)
     Var ptime_GM = gmtime(@tcurr_sec)
     Dim As ZString * 255 tstr_GM
     Var res=strftime(tstr_GM,128,"%a, %d %b %Y %H:%M:%S",ptime_GM)
     print "Точное время по Гринвичу: " & tstr_GM
       
     curr_sec += (3600 * 4)
     Var tcurr_sec_4h = cast(time_t,curr_sec)
     Var ptime_MSK = gmtime(@tcurr_sec_4h)
     Dim As ZString * 255 tstr_MSK
     res=strftime(tstr_MSK,128,"%a, %d %b %Y %H:%M:%S",ptime_MSK)
     print "Точное время по Москве:   " & tstr_MSK
Else
     print "Произошла ошибка при получении временой метки..."
EndIf

Sleep