FreeBasic
Главная
Вход
Регистрация
Среда, 16.10.2024, 06:25Приветствую Вас Гость | RSS
[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]
  • Страница 1 из 1
  • 1
Получение точного времени по протоколу NTP
ShadExДата: Воскресенье, 29.12.2013, 20:41 | Сообщение # 1
Лейтенант
Группа: Проверенные
Сообщений: 51
Репутация: 1
Статус: Offline
Протокол NTP/SNTP позволяет синхронизировать время на локальной машине с серверами точного времени. Такая синхронизация нужна для тех случаев, когда требуется установить максимально точные дату/время, так как при получении временных меток учитываются задержки при получении/отправке запроса сервером. Таким образом разница между отсылкой ответа сервером и получением временной метки на локальной машине составляет не более 25 милисекунд.
Размер пакета с запросом к серверу занимает 68 байт и отправляется на сервер через UDP-сокет. Получить полное описание всех возможных значений при получении/отправке запроса, а также более подробно узнать о архитектуре сетевого протокола задания времени NTP можно по ссылке:
http://citforum.ru/nets/semenov/4/44/ntp_4415.shtml

Я же просто приведу здесь для наглядности код структуры на Фрибейсике:
Код
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


Структура NTP_TIMESTAMP для значений временных меток содержит два беззнаковых четырехбитных числа, где первое - это количество секунд прошедших от полуночи 1 января 1900 года, а второе - дополнительные значения с часовым смещением и DST, но они нам не понадобятся, так как по умолчанию все сервера отсылают временные метки без смещения (часовой пояс - по Гринвичу):
Код
Type NTP_TIMESTAMP
     Seconds As UInteger
     Fraction As UInteger
End Type


Для компактности кода я решил не реализовывать заполнение структуры из полученного ответа от сервера, а просто сконвертировал 4 байта(значение секунд из временной метки - TransmitTimestamp) начиная с 41 байта в беззнаковое четырехбитное число.
Итак, вот код функции для отправки/получения запроса от сервера по протоколу NTP:
Код
#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


При успешном получении ответа от сервера функция вернет количество секунд, прошедших от полуночи 1 января 1900 года или 0 в случае ошибки.
Первый параметр - по-умолчанию - пустая строка, может принимать строку с именем домена или IP-адресом сервера. Если строка не задана или содержит некорректный адрес для соединения, то по-умолчанию функция отправит запрос к серверу "pool.ntp.org", который выступает своеобразным кластером для серверов синхронизации точного времени и поэтому доступен всегда, в отличии от региональных серверов.
Второй параметр - номер порта (по умолчанию для протокола NTP для соединения используется 123-й порт)
Третий параметр - по-умолчанию - 0, если установлен в 1, то функция вернет количество секунд прошедших от полуночи 1 января 1970 года (начало эпохи Unix).

Пример использования:
Код
#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


З.Ы.: я не случайно оставил закоментированный вывод кода ошибки при неудачном соединении к серверу, так как если указать строку с IP-адресом, то при одновременных компиляции и запуске примера из IDE у меня выдает ошибку "Доступ запрещен" (код 10013), и только потом уже отдельно запуская скомпилированный экзешник такая ошибка больше не повторится...
Вообще-то такое поведение немного странно, потому что такая ошибка возникает при попытке использовать широковещательный адрес в функциях sendto или WSASendTo, когда широковещание не разрешено параметрами setsockopt и SO_BROADCAST...
Но на всякий случай я оставил также в функции закоментированную строку с установкой опции SO_BROADCAST для сокета...


Сообщение отредактировал ShadEx - Воскресенье, 29.12.2013, 20:42
 
haavДата: Воскресенье, 29.12.2013, 22:06 | Сообщение # 2
Генералиссимус
Группа: Администраторы
Сообщений: 1366
Репутация: 49
Статус: Offline
Цитата ShadEx ()
З.Ы.: я не случайно оставил закоментированный вывод кода ошибки при неудачном соединении к серверу, так как если указать строку с IP-адресом, то при одновременных компиляции и запуске примера из IDE у меня выдает ошибку "Доступ запрещен" (код 10013), и только потом уже отдельно запуская скомпилированный экзешник такая ошибка больше не повторится...


У меня такой ошибки нет.

Вообще хороший пример, надо будет не забыть выложить на основном сайте.


Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
 
ShadExДата: Понедельник, 30.12.2013, 02:25 | Сообщение # 3
Лейтенант
Группа: Проверенные
Сообщений: 51
Репутация: 1
Статус: Offline
Цитата haav ()
У меня такой ошибки нет.


У меня тоже в ближайшем будущем такая ошибка возникать не будет - в марте заканчивается поддержка WinXP и я уже на семерку "перелезу"...


Сообщение отредактировал ShadEx - Понедельник, 30.12.2013, 02:28
 
  • Страница 1 из 1
  • 1
Поиск: