Programowanie w języku Delphi » Gotowce

Czas - synchronizacja przez SNTP

  • 2012-10-07 21:55
  • 0 komentarzy
  • 4665 odsłon
  • Oceń ten tekst jako pierwszy

Synchronizacja Czasu - SNTP


<justify>Artykuł dotyczy programu do synchronizacji czasu poprzez sieć, opartego na protokole SNTP.</justify>

Kilka słów wstępu


<justify>Jedną z metod wykonywania synchronizacji zegrów komputerów poprzez sieć jest protokół NTP (ang. Network Time Protocol) oraz jego uproszczona wersja SNTP (ang. Simple Network Time Protocol). Zadaniem NTP/SNTP jest zapewnienie możliwości ustawienia czasu zegara komputera z dokładnością około od 10 do 30 ms. Obecnie na całym świecie jest dostępnych bardzo wiele serwerów czasu, które udostępniaja tą usługę. Również w Polsce mamy przynajmniej kilkanaście serwerów czasu np. vega.cbk.poznan.pl, ntp.task.gda.pl czy tempus1.gum.gov.pl, więcej polskich serwerów czasu można znaleźć na stronie: http://odyniec.fdns.net/ntp . Dodatkowo wykaz wybranych serwerów NTP z całego świata możemy zobaczyć np. na stronie: http://support.microsoft.com/kb/262680 . Istotną sprawą na którą trzeba zwrócić uwagę podczas wybierania serwera jest tzw. stratum czyli precyzja z jaką serwer synchronizuje czas (kolejny nr w hierarchii NTP - odległość serwera od źródła czasu), najbardziej dokładne sa serwery stratum = 1, dalej (mniej dokładne) stratum = 2, 3, 4, itd. Jednak dla potrzeb amatorskich i domowych zastosowań nie musimy się aż tak bardzo tym przejmować. Oczywiście w Polsce nie ma sensu synchronizować zegara z serwara, który znajduje slę na drugiej półkuli, wybierajmy zawsze serwer możliwie bliski. Więcej informacji na temat synchronizacji czasu przez SNTP można otrzymać w dokumentacji RFC na: http://rfc.net/rfc2030 . Kilka rozwiązań zastosowanych w programie jest wzorowanych na module IdSNTP.pas z pakietu Indy.</justify>

Klient SNTP


<justify>Klient został napisany w Delphi 6 jako aplikacja konsolowa. Główny moduł programu korzysta z modułów dodatkowych: SNTPSocket, SNTPFunctions, SNTPRegSetup, SNTPDateTime. Cała transmisja odbywa się poprzez gniazdko UDP na porcie 123, który to jest przypisany na stałe do transmisji czasu w NTP i SNTP. Przy prezentacji kodu poszczególnych modułów ograniczono się tylko do kilku słów wyjaśnienia na wstępie, pozostałe informacje zostały umieszczone w formie komentarzy w treści kodu modułów.</justify>

Moduł SNTPSocket


<justify>Funkcje tego modułu zajmują się wykonaniem połączenia oraz obsługą wysyłania i odbioru datagramu SNTP. Został on napisany z użyciem funkcji WinAPI, zwłaszcza funkcji biblioteki Windows Sockets.</justify>

{*************************************************************}
{                                                             }
{    Klient protokołu SNTP dla Windows 9x/Me/NT/2000/XP       }
{                                                             }
{    Copyright (c) 2005, 2006 AD    }
{                                                             }
{*************************************************************}
 
unit SNTPSocket;
 
interface
 
uses
  Windows, SysUtils, WinSock, SNTPDateTime;
 
type
  { Zawartość pól rekordu jaki składa się na datagram SNTP, }
  { więcej informacji na: http://www.rfc.net/rfc2030.html }
  TNTPGram = packed record
    Head1         : Byte;     { Typ całkowity 8-bitowy bez znaku   }
    Head2         : Byte;     { Typ całkowity 8-bitowy bez znaku   }
    Head3         : ShortInt; { Typ całkowity 8-bitowy ze znakiem  }
    Head4         : ShortInt; { Typ całkowity 8-bitowy ze znakiem  }
    RootDelay     : LongInt;  { Typ całkowity 32-bitowy ze znakiem }
    RootDispersion: LongWord; { Typ całkowity 32-bitowy bez znaku  }
    RefID         : LongWord; { Typ całkowity 32-bitowy bez znaku  }
    Ref1          : LongWord; { Typ całkowity 32-bitowy bez znaku  }
    Ref2          : LongWord; { Typ całkowity 32-bitowy bez znaku  }
    Org1          : LongWord; { Typ całkowity 32-bitowy bez znaku  }
    Org2          : LongWord; { Typ całkowity 32-bitowy bez znaku  }
    Rcv1          : LongWord; { Typ całkowity 32-bitowy bez znaku  }
    Rcv2          : LongWord; { Typ całkowity 32-bitowy bez znaku  }
    Xmit1         : LongWord; { Typ całkowity 32-bitowy bez znaku  }
    Xmit2         : LongWord; { Typ całkowity 32-bitowy bez znaku  }
  end;
 
  function StrToOem(const AAnsiStr: string): string;
  function StartWSAStartup: Boolean;
  function AddrConvert(var AAddr: TSockAddrIn; AAddrStr: string): string;
  function SendAndRecvData(ABuffer: TNTPGram; const APort, ALengthBuffer,
    AFlags: Word; const ARcvTime: Integer): TNTPGram;
  function CloseConnect(const ASocket: Integer): Boolean;
  procedure GetLocalIPAndName(var ALocalIP, ALocalName: string);
 
var
  Addr: TSockAddrIn;
  MySocket, RecvTime: Word;
  Host, LocalIP, LocalName, HostIn: string;
 
const
  Flags = 0;
  { Domyślny port dla protokolu SNTP/NTP: 123 }
  Port: Word = 123;
  { Maksymalna długość nazwy hosta }
  MaxHostNameLen = High(Byte);
 
implementation
 
{ Konwersja kodowania Windows 1250 na OEM 852 (DOS lub konsola Windows), }
{ umożliwia to poprawne wyświetlenie polskich czcionek w oknie konsoli }
 
function StrToOem(const AAnsiStr: string): string;
begin
  SetLength(Result, Length(AAnsiStr));
  if Length(Result) > 0 then
    CharToOem(PChar(AAnsiStr), PChar(Result));
end;
 
{ Obsługa błędow związanych Socketem }
 
procedure MsgWSAError;
begin
  WriteLn(StrToOem(SysErrorMessage(WSAGetLastError)));
  Halt(1);
end;
 
{ Pobranie nazwy i adresu lokalnej maszyny }
 
procedure GetLocalIPAndName(var ALocalIP, ALocalName: string);
var
  APHostEnt: PHostEnt;
  APHostName: PChar;
begin
  APHostName := nil;
  { Pobranie IP i nazwy lokalnego komputera }
  gethostname(APHostName, SizeOf(MaxHostNameLen));
  { Wpisanie do struktury HostEnt nazwy i adresu maszyny }
  APHostEnt := gethostbyname(APHostName);
  if APHostEnt <> nil then
  begin
    ALocalIP := inet_ntoa(PInAddr(APHostEnt^.h_addr_list^)^);
    ALocalName := APHostEnt^.h_name
  end else
    MsgWSAError;
end;
 
{ Uruchomienie biblioteki Windows Sockets (WinSock) }
 
function StartWSAStartup: Boolean;
var
  WSAData: TWSAData;
begin
  Result := False;
  { Inicjujemu użycie biblioteki Windows Sockets }
  if WSAStartup(MAKEWORD(2, 2), WSAData) = NO_ERROR then
  begin
    { Utworzenie nowego socketu dla połączenia User Datagram Protocol (UDP) }
    MySocket := socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP);
    Result := True;
  end else
    MsgWSAError;
end;
 
{ Konwersja adresu IP na Nazwę DNS i odwrotnie }
 
function AddrConvert(var AAddr: TSockAddrIn; AAddrStr: string): string;
var
  AHostEnt: PHostEnt;
begin
  FillChar(AAddr, SizeOf(AAddr), 0);
  AAddr.sin_family := AF_INET;
  { Jeśli podano adres IP }
  if AAddrStr[1] in ['0'..'9'] then
  begin
    AAddr.sin_addr.S_addr := inet_addr(PChar(AAddrStr));
    AHostEnt := gethostbyaddr(@AAddr.sin_addr.S_addr,
      SizeOf(AAddr.sin_addr.S_addr), AAddr.sin_family);
    Result := AHostEnt^.h_name
  end else
  { Jeśli podano nazwe DNS }
  begin
    AHostEnt := gethostbyname(PChar(AAddrStr));
    if AHostEnt <> nil then
    begin
      move(AHostEnt^.h_addr_list^^, AAddr.sin_addr.S_addr,
        SizeOf(AAddr.sin_addr.S_addr));
      AAddr.sin_addr.S_addr := LongInt(PLongWord(AHostEnt^.h_addr^)^);
      Result := inet_ntoa(AAddr.sin_addr)
    end else
      MsgWSAError();
  end;
end;
 
{ Wysyłanie i odbieranie danych z serwera }
 
function SendAndRecvData(ABuffer: TNTPGram; const APort, ALengthBuffer,
  AFlags: Word; const ARcvTime: Integer): TNTPGram;
begin
  { Ustawienie dopuszczalnego czasu odpowiedzi serwera }
  if setsockopt(MySocket, SOL_SOCKET, SO_RCVTIMEO, @ARcvTime,
    SizeOf(ARcvTime)) = SOCKET_ERROR then
    MsgWSAError;
  { Określenie i konwersja portu }
  Addr.sin_port := htons(APort);
  { Próba połączenia z serwerem }
  if connect(MySocket, Addr, SizeOf(Addr)) = SOCKET_ERROR then
    MsgWSAError
  else
  begin
    { Wysłanie danych }
    if send(MySocket, ABuffer, ALengthBuffer, AFlags) = SOCKET_ERROR then
      MsgWSAError;
    { Odbiór danych }
    if recv(MySocket, ABuffer, ALengthBuffer, AFlags) = SOCKET_ERROR then
      MsgWSAError;
  end;
  Result := ABuffer;
end;
 
{ Zamknięcie używanego Socketa }
 
function CloseConnect(const ASocket: Integer): Boolean;
begin
  if shutdown(MySocket, SD_BOTH) = SOCKET_ERROR then
  begin
    Result := False;
    MsgWSAError;
  end else
    if CloseSocket(ASocket) = SOCKET_ERROR then
    begin
      Result := False;
      MsgWSAError;
    end else
      Result := True;
end;
 
initialization
  StartWSAStartup;
  GetLocalIPAndName(LocalIP, LocalName);
 
finalization
  CloseConnect(MySocket);
  { Konczymy uzywanie biblioteki Windows Sockets }
  WSACleanup;
 
end.


Moduł SNTPFunctions


<justify>W module tym zostały zgromadzone funkcje i procedury używane do obsługi danych zapisanych w datagramie otrzymanym z serwera czasu. Wykonują one różnego rodzaju przekształcenia otrzymanych danych np. zamianę formatów czasu czy odczyt poszczególnych pół datagramu SNTP.</justify>

{*************************************************************}
{                                                             }
{    Klient protokołu SNTP dla Windows 9x/Me/NT/2000/XP       }
{                                                             }
{    Copyright (c) 2005, 2006 AD    }
{                                                             }
{*************************************************************}
 
unit SNTPFunctions;
 
interface
 
uses
  SysUtils, DateUtils, Windows, Math, SNTPSocket, SNTPDateTime;
 
type
  TLr = packed record
    L1: Byte;
    L2: Byte;
    L3: Byte;
    L4: Byte;
  end;
 
procedure ChkDatePC(ADateTime: TDateTime);
function GetHead1Byte1(const ANTPMessage: TNTPGram): Byte;
function GetLeapIndicator(const ANTPMessage: TNTPGram): Byte;
function GetVersionNumber(const ANTPMessage: TNTPGram): Byte;
function GetMode(const ANTPMessage: TNTPGram): Byte;
function GetStratum(const ANTPMessage: TNTPGram): Byte;
function GetPollInterval(const ANTPMessage: TNTPGram): Extended;
function GetPrecision(const ANTPMessage: TNTPGram): Extended;
function Flip(const ANumber: LongWord): LongWord; overload;
function Flip(const ANumber: LongInt): LongWord; overload;
function GetRootDelay(const ANTPMessage: TNTPGram): Double;
function GetRootDispersion(const ANTPMessage: TNTPGram): Double;
function GetReferenceIdentifier(const ANTPMessage: TNTPGram;
  const AStratum: Byte): string;
procedure DateTimeToNTP(const ADateTime: TDateTime;
  var ASecond, AFraction: LongWord);
function GetReferenceTimestamp(const ANTPMessage: TNTPGram): TDateTime;
function GetOriginateTimestamp(const ANTPMessage: TNTPGram): TDateTime;
function GetReceiveTimestamp(const ANTPMessage: TNTPGram): TDateTime;
function GetTransmitTimestamp(const ANTPMessage: TNTPGram): TDateTime;
function SetRoundtripDelay: TDateTime;
function SetLocalClockOffset: TDateTime;
function IsNTPGramOK(const ALeapIndicator : Byte;
  const ATransmitTimeStamp : TDateTime): Boolean;
 
var
  ExpPoll, ExpPrecision, VersionNumber : ShortInt;
  Head1Byte1, LeapIndicator, Mode, Stratum : Byte;
  OriginateTimestamp, TransmitTimestamp, ReceiveTimestamp,
    DestinationTimestamp, ReferenceTimeStamp : TDateTime;
  LocalClockOffset, RoundTripDelay, RootDelay, RootDispersion : Double;
  PollInterval, Precision : Extended;
  ReferenceIdentifier : string;
 
const
  { Wartość stała, służy do zamiany formatu czasu NTP na TDateTime dla Delphi, }
  { 2^32 = 4294967296, może lepiej bedzie High(LongWord) = 4294967295? }
  { W pliku IdSNTP.pas z pakietu Indy wartość ta wynosi 4294967297 - czemu? }
  NTPMaxInt = High(LongWord);
  { Rożnica w dniach pomiędzy początkiem liczenia czasu NTP i Delphi }
  DateTimeDiff = 2;
 
implementation
 
{ Sprawdzenie czy data naszego PC mieści się w zakresie dostępnym dla NTP, }
{ tj. zakres od 1 stycznia 1900 00:00:00 do 7 lutego 2036 06:28:15 }
 
procedure ChkDatePC(ADateTime: TDateTime);
var
  ABeginDateNTP, AEndDateNTP: TDateTime;
begin
  ABeginDateNTP := EncodeDateTime(1900, 1, 1, 0, 0, 0, 0);
  AEndDateNTP := EncodeDateTime(2036, 2, 7, 6, 28, 15, 0);
  ADateTime := ADateTime - TimeZoneBias;
  if (ADateTime < ABeginDateNTP) or  (ADateTime > AEndDateNTP) then
  begin
    WriteLn(StrToOem(
      'Data na Twoim PC poza zakresem 1900-01-01 00:00:00..2036-02-07 06:28:15'));
      Halt(1);
  end;
end;
 
{ Funkcja zwraca wartość pierwszego bajtu z pierwszego nagłówka datagramu, }
{ więcej informacji odnośnie działaniu tej i natępnych funkcji z tego modułu }
{ można odszukać na: http://www.rfc.net/rfc2030.html }
 
function GetHead1Byte1(const ANTPMessage: TNTPGram): Byte;
begin
  Result := ANTPMessage.Head1;
end;
 
{ Funkcja zwraca wskaźnik sekundy przestępnej (Leap Indicator) }
 
function GetLeapIndicator(const ANTPMessage: TNTPGram): Byte;
begin
  Result := (ANTPMessage.Head1 and $C0) shr 6;
end;
 
{ Funkcja zwraca numer wersji protokolu SNTP (Version Number) }
 
function GetVersionNumber(const ANTPMessage: TNTPGram): Byte;
begin
  Result := (ANTPMessage.Head1 and $38) shr 3;
end;
 
{ Funkcja zwraca kod trybu pracy (Mode) }
 
function GetMode(const ANTPMessage: TNTPGram): Byte;
begin
  Result := (ANTPMessage.Head1 and $7);
end;
 
{ Funkcja zwraca numer stratum serwera NTP (Stratum) }
 
function GetStratum(const ANTPMessage: TNTPGram): Byte;
begin
  Result := ANTPMessage.Head2;
end;
 
{ Funkcja zwraca interwał odpytujacy (Poll Interval) }
 
function GetPollInterval(const ANTPMessage: TNTPGram): Extended;
begin
  ExpPoll := ANTPMessage.Head3;
  Result := Power(2, ExpPoll);
end;
 
{ Funkcja zwraca precyzje zegara serwera NTP (Precision) }
 
function GetPrecision(const ANTPMessage: TNTPGram): Extended;
begin
  ExpPrecision := ANTPMessage.Head4;
  Result := Power(2, ExpPrecision);
end;
 
{ Funkcja wykonuje odwrócenie kolejności bajtow dla LongWord }
 
function Flip(const ANumber: LongWord): LongWord; overload;
var
  ANumber1, ANumber2: TLr;
begin
  ANumber1 := TLr(ANumber);
  ANumber2.L1 := ANumber1.L4;
  ANumber2.L2 := ANumber1.L3;
  ANumber2.L3 := ANumber1.L2;
  ANumber2.L4 := ANumber1.L1;
  Result := LongWord(ANumber2);
end;
 
{ Funkcja wykonuje odwrócenie kolejności bajtow dla LongInt }
 
function Flip(const ANumber: LongInt): LongWord; overload;
var
  ANumber1, ANumber2: TLr;
begin
  ANumber1 := TLr(ANumber);
  ANumber2.L1 := ANumber1.L4;
  ANumber2.L2 := ANumber1.L3;
  ANumber2.L3 := ANumber1.L2;
  ANumber2.L4 := ANumber1.L1;
  Result := LongWord(ANumber2);
end;
 
{ Funkcja zwraca True dla 1 i False dla 0, jest pomocniczą funkcją }
{ dla funkcji BinToFrac(AValue: LongInt): Double; }
 
function GetBit(const ABinValue: LongInt; const AValue: Byte): Boolean;
begin
  Result := (ABinValue and (1 shl AValue)) <> 0;
end;
 
{ Funkcja zwraca liczbę binarną 32 bitową (stałoprzecinkową), }
{ przecinek pomiędzy bitem 15 i 16, tylko jako jej część dziesiętna }
{ Funkcja używana do obliczeń (Root dispersion) i (Root delay) }
 
function BinToFrac(const AValue: LongInt): Double;
var
  ADigits: Byte;
begin
  Result := 0.0;
  { Czytamy tylko część ułamkową z całej liczby, czyli bity od 0 do 15 }
  for ADigits := 0 to 15 do
  Result := (Result + Ord(GetBit(AValue, ADigits))) / 2;
end;
 
{ Funkcja zwraca opóźnienie względem pierwszorzędnego }
{ źródła czasu (Root Delay) }
{ Przed obliczeniem wykonane jest odwrócenie bajtów funkcją Flip }
 
function GetRootDelay(const ANTPMessage: TNTPGram): Double;
begin
  Result := BinToFrac(Flip(ANTPMessage.RootDelay));
end;
 
{ Funkcja zwraca współczynnik dyspersji (Root Dispersion) }
{ Przed obliczeniem wykonane jest odwrócenie bajtow funkcją Flip }
 
function GetRootDispersion(const ANTPMessage: TNTPGram): Double;
begin
  Result := BinToFrac(Flip(ANTPMessage.RootDispersion));
end;
 
{ Uzyskanie danych o źródle synchronizacji serwera NTP }
{ (Reference Identifier) jest zwracany jako kod źródła lub }
{ jako adres IP, jeżeli źródło ma Stratum większe od 1 }
 
function GetReferenceIdentifier(const ANTPMessage: TNTPGram;
  const AStratum: Byte): string;
var
  ARefID0, ARefID1, ARefID2, ARefID3: Byte;
  AStringIP : string;
begin
  { Odczyt poszczególnych znakow kodu źródła }
  ARefID0 := (ANTPMessage.RefID and $FF);
  ARefID1 := (ANTPMessage.RefID and $FF00) shr 8;
  ARefID2 := (ANTPMessage.RefID and $FF0000) shr 16;
  ARefID3 := (ANTPMessage.RefID and $FF000000) shr 24;
  if AStratum = 1 then
    { Stratum = 1, to zapis jako 3 lub 4 znaki w kodzie ASCII np. kod: PPS }
    Result := Format('%s%s%s%s', [Chr(ARefID0), Chr(ARefID1), Chr(ARefID2),
      Chr(ARefID3)])
  else
  { Stratum > 1, to zapis jako adres IPv4 32 bity }
  begin
    AStringIP := Format('%d.%d.%d.%d', [ARefID0, ARefID1, ARefID2, ARefID3]);
    Result := Format('Serwer: %s [%s]', [AStringIP,
      AddrConvert(Addr, AStringIP)]);
  end;
end;
 
{ Zamiana formatu czasu NTP time na TDateTime }
{ funkcja na podstawie funkcji z pakietu Indy (unit IdSNTP.pas) }
 
function NTPToDateTime(const ASecond, AFraction: LongWord): TDateTime;
var
  Value1: Double;
  Value2: Double;
begin
  Value1 := ASecond;
  Value2 := AFraction;
  Value2 := Trunc(Value2 / NTPMaxInt * 1000) / 1000;
  Result := ((Value1 + Value2) * OneSecond) - TimeZoneBias + DateTimeDiff;
end;
 
{ funkcja mojego pomysłu }
 
{function NTPToDateTime(ASecond, AFraction: LongWord): TDateTime;
var
  AFracDbl: Double;
begin
  AFracDbl := ((Int64(AFraction) * 1000) shr 32) / 1000;
  Result := ((ASecond + AFracDbl) * OneSecond) - TimeZoneBias + DateTimeDelta;
end;}
 
{ Zamiana formatu czasu TDateTime na NTP time }
{ funkcja na podstawie funkcji z pakietu Indy (unit IdSNTP.pas) }
 
procedure DateTimeToNTP(const ADateTime: TDateTime;
  var ASecond, AFraction: LongWord);
var
  ASecDbl, AFracDbl: Double;
begin
  ASecDbl := (ADateTime + TimeZoneBias - DateTimeDiff) * SecsPerDay;
  AFracDbl := ASecDbl;
  if AFracDbl > NTPMaxInt then
  begin
    AFracDbl := AFracDbl - NTPMaxInt;
  end;
  ASecond := LongWord(Trunc(AFracDbl));
  AFracDbl := Frac(ASecDbl) * NTPMaxInt;
  if AFracDbl > NTPMaxInt then
  begin
    AFracDbl := AFracDbl - NTPMaxInt;
  end;
  AFraction := LongWord(Trunc(AFracDbl));
end;
 
{ Odczyt czasu źródła (Reference Timestamp) }
 
function GetReferenceTimestamp(const ANTPMessage: TNTPGram): TDateTime;
begin
  Result := NTPToDateTime(Flip(ANTPMessage.Ref1), Flip(ANTPMessage.Ref2));
end;
 
{ Odczyt czasu wysłania przez Twój PC, T1 (Originate Timestamp) }
 
function GetOriginateTimestamp(const ANTPMessage: TNTPGram): TDateTime;
begin
  Result := NTPToDateTime(Flip(ANTPMessage.Org1), Flip(ANTPMessage.Org2));
end;
 
{ Odczyt czasu odbioru przez serwer, T2 (Receive Timestamp) }
 
function GetReceiveTimestamp(const ANTPMessage: TNTPGram): TDateTime;
begin
  Result := NTPToDateTime(Flip(ANTPMessage.Rcv1), Flip(ANTPMessage.Rcv2));
end;
 
{ Odczyt czasu odesłania przez serwer, T3 (Transmit Timestamp) }
 
function GetTransmitTimestamp(const ANTPMessage: TNTPGram): TDateTime;
begin
  Result := NTPToDateTime(Flip(ANTPMessage.Xmit1), Flip(ANTPMessage.Xmit2));
end;
 
{ Pobranie czasu odbioru przez Twój PC, T4 (Destination Timestamp) }
 
function GetDestinationTimestamp: TDateTime;
begin
  Result := TimeDst;
end;
 
{ Obliczenie tzw. opóźnienia podróży (Roundtrip Delay) }
 
function SetRoundtripDelay: TDateTime;
begin
  Result := (DestinationTimestamp - OriginateTimestamp) - (ReceiveTimestamp -
    TransmitTimestamp);
end;
 
{ Obliczenie przesunięcia zegara (ClockOffset), }
{ pomiedzy zegarem serwera czasu, a Twoim PC }
 
function SetLocalClockOffset: TDateTime;
begin
  Result := ((ReceiveTimestamp - OriginateTimestamp) + (TransmitTimestamp -
    DestinationTimestamp)) / 2;
end;
 
{ Tylko wynik tej funkcji = True oznacza poprawny komunikat SNTP }
 
function IsNTPGramOK(const ALeapIndicator: Byte;
  const ATransmitTimeStamp: TDateTime): Boolean;
begin
  if (ALeapIndicator = 3) or (TransmitTimestamp = 0) then
    Result := False
  else
    Result := True;
end;
 
end.


Moduł SNTPRegSetup


<justify>Zadanie tego modułu to zapis i odczyt ustawień programu do rejestru systemu oraz ewentualne ustawienie wartości domyśnych parametrów wejściowych programu.</justify>

{*************************************************************}
{                                                             }
{    Klient protokołu SNTP dla Windows 9x/Me/NT/2000/XP       }
{                                                             }
{    Copyright (c) 2005, 2006 AD   }
{                                                             }
{*************************************************************}
 
unit SNTPRegSetup;
 
interface
 
uses
  Windows, Registry;
 
function ReadRegSetup(const ARegKey: string; var AHostIn: string;
  var ARecvTime: Word): Boolean;
function WriteRegSetup(const ARegKey: string; var AHostIn: string;
  var ARecvTime: Word): Boolean;
 
var
  Reg: TRegistry;
 
implementation
 
{ Odczyt ustawień z rejestru Windows }
 
function ReadRegSetup(const ARegKey: string; var AHostIn: string;
  var ARecvTime: Word): Boolean;
begin
  Result := False;
  Reg := TRegistry.Create;
  Reg.Access := KEY_READ;
  Reg.RootKey := HKEY_CURRENT_USER;
  if Reg.KeyExists(ARegKey) then
  try
    if Reg.OpenKey(ARegKey, False) then
    begin
      if Reg.ValueExists('HostIn') then
        AHostIn := Reg.ReadString('HostIn');
      if Reg.ValueExists('RecvTime') then
        ARecvTime := Reg.ReadInteger('RecvTime');
      Result := True;
    end;
  finally
    Reg.CloseKey;
  end else
  begin
    { Domyślny serwer NTP: vega.cbk.poznan.pl, jeden z pewniejszych w Polsce, }
    { Stratum 1, serwer jest zlokalizowany w Centrum Badań Kosmicznych PAN }
    { w Borowcu niedaleko Poznania, jest synchronizowany bezpośrednio }
    { do cezowego wzorca czasu HP5071A, oznaczenie źródła czasu PPS }
    AHostIn := '150.254.183.15';
    {Domyślny czas oczekiwania na odpowiedź serwera w milisekundach (2,5 s) }
    ARecvTime := 2500;
  end;
end;
 
{ Zapis ustawień do rejestru Windows }
 
function WriteRegSetup(const ARegKey: string; var AHostIn: string;
  var ARecvTime: Word): Boolean;
begin
  Result := False;
  Reg.Access := KEY_WRITE;
  Reg.RootKey := HKEY_CURRENT_USER;
  if not Reg.KeyExists(ARegKey) then
    if not Reg.CreateKey(ARegKey) then
    begin
      Reg.Free;
      Exit;
    end;
  if Reg.OpenKey(ARegKey, False) then
  try
    Reg.WriteString('HostIn', AHostIn);
    Reg.WriteInteger('RecvTime', ARecvTime);
    Result := True;
  finally
    Reg.CloseKey;
  end;
end;
 
initialization
  Reg := TRegistry.Create;
 
finalization
  Reg.Free;
 
end.


Moduł SNTPDateTime


<justify>Funkcje tego modułu są odpowiedzialne za pobranie informacji o strefie czasowej komputera oraz mają umożliwić wykonanie przestawienia zegara w systemie.</justify>

{*************************************************************}
{                                                             }
{    Klient protokołu SNTP dla Windows 9x/Me/NT/2000/XP       }
{                                                             }
{    Copyright (c) 2005, 2006 AD    }
{                                                             }
{*************************************************************}
 
unit SNTPDateTime;
 
interface
 
uses
  Windows, SysUtils, DateUtils;
 
function GetLocalTime: TDateTime;
function GetTimeZoneInfo(var ABias: TDateTime): string;
function SetLocalTimeWin9xWinNT(const ADateTime: TDateTime): Boolean;
function SetTimeZoneBiasStr(const ATimeZoneBias: TDateTime): string;
 
var
  TimeZoneName: string[32];
  TimeZoneBias, TimeOrg, TimeDst, GMTTime, LocalTime: TDateTime;
 
implementation
 
uses
  SNTPSocket;
 
{ Funkcja zwraca offset strefy czasowej w godzinach jako string }
 
function SetTimeZoneBiasStr(const ATimeZoneBias: TDateTime): string;
begin
  if ATimeZoneBias > 0 then
    Result := FormatDateTime('"GMT-"hh:nn', ATimeZoneBias)
  else
    Result := FormatDateTime('"GMT+"hh:nn', ATimeZoneBias);
end;
 
{ Funkcja zwraca czas lokalny (aktualny czas strefowy) w formacie TDateTime }
 
function GetLocalTime: TDateTime;
begin
  Result := Now;
end;
 
{ Funkcja zwraca offset strefy czasowej w dobach (TDateTime) oraz jej nazwe }
{ Offset (ABias) = GMT - czas lokalny }
{ czas lokalny = aktualny czas strefowy }
{ GMT = Greenwich Mean Time, czas poludnika zerowego w Greenwich, }
{ w Polsce czas letni  = GMT + 2 godziny, czas zimowy = GMT + 1 godzina }
 
function GetTimeZoneInfo(var ABias: TDateTime): string;
var
  AName: string;
  ATimeZone: TIME_ZONE_INFORMATION;
begin
  case GetTimeZoneInformation(ATimeZone) of
    TIME_ZONE_ID_UNKNOWN:
      begin
        AName := ATimeZone.StandardName;
        ABias := ATimeZone.Bias;
      end;
    TIME_ZONE_ID_STANDARD:
      begin
        AName := ATimeZone.StandardName;
        ABias := ATimeZone.Bias + ATimeZone.StandardBias;
      end;
    TIME_ZONE_ID_DAYLIGHT:
      begin
        AName := ATimeZone.DayLightName;
        ABias := AtimeZone.Bias + ATimeZone.DaylightBias;
      end else
    { TIME_ZONE_ID_INVALID }
      WriteLn(StrToOem(SysErrorMessage(GetLastError)));
  end;
  { Przeliczenie offsetu z minut na doby (format dla TDateTime) }
  ABias := ABias * OneMinute;
  Result := AName;
end;
 
{ Funkcja ustawia czas w Windows }
 
function SetDateTime(const ADateTime: TDateTime): Boolean;
var
  ASystemTime: TSystemTime;
begin
  DateTimeToSystemTime(ADateTime, ASystemTime);
  Result := SetLocalTime(ASystemTime);
end;
 
{ Funkcja umożliwia dokonanie zmiany czasu w systemach z rodziny Windows NT, }
{ bez uprawnień administratora dla użytkownika, działa też dla systemow }
{ z rodziny Windows 9x }
 
function SetLocalTimeWin9xWinNT(const ADateTime: TDateTime): Boolean;
var
   ABuffer: LongWord;
   ATokenPriv, ATokenPrivOrg: TTokenPrivileges;
   AHandleToken: THandle;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    if not Windows.OpenProcessToken(GetCurrentProcess(),
      TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, AHandleToken) then
    begin
      Result := False;
      Exit;
    end;
    Windows.LookupPrivilegeValue(nil, 'SE_SYSTEMTIME_NAME',
      ATokenPriv.Privileges[0].LUID);
    ATokenPriv.PrivilegeCount := 1;
    ATokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
    if not Windows.AdjustTokenPrivileges(AHandleToken, FALSE, ATokenPriv,
      SizeOf(ATokenPriv), ATokenPrivOrg, ABuffer) then
    begin
      Result := False;
      Exit;
    end;
    Result := SetdateTime(ADateTime);
    Windows.AdjustTokenPrivileges(AHandleToken, FALSE, ATokenPrivOrg,
      SizeOf(ATokenPrivOrg), ATokenPriv, ABuffer);
    Windows.CloseHandle(AHandleToken);
  end else
    Result := SetDateTime(ADateTime);
end;
 
end.


Moduł główny programu


<justify>Działanie modułu głównego sprowadza się właściwie do wykonania sformatowania do czytelnej postaci rezultatów synchronizacji i informacji przesłanych w datagramie SNTP. Dodatkową funkcjonalnościa tego modułu jest automatyczne zapisanie czasów i poprawek zegara naszego komputera do pliku logów. Sam proces formatowania tekstu został zrealizowany przez zadeklarowanie szeregu łańcuchów jako stałych, przechowujących informacje o formacie, które są wykorzystywane przez funkcje Format.</justify>

{*************************************************************}
{                                                             }
{    Klient protokołu SNTP dla Windows 9x/Me/NT/2000/XP       }
{                                                             }
{    Copyright (c) 2005, 2006 AD    }
{                                                             }
{*************************************************************}
 
program adSNTP;
 
{$APPTYPE CONSOLE}
 
uses
  Windows, SysUtils, DateUtils, Classes, IniFiles, SNTPSocket, SNTPDateTime,
    SNTPFunctions, SNTPRegSetup;
 
var
  NTPGram: TNTPGram;
  LeapIndicatorStr, ModeStr, StratumStr, TimeZoneBiasStr, PathToLogFile,
    PathToRegKey: string;
  StringList: TStringlist;
  Row: Byte;
  Counter: Byte = 0;
  AdjErrorCode: LongWord;
  ConsoleSize: TCoord;
 
const
  { Stałe zawierające format treści rezultatów wyświetlanych na ekranie }
  STitle                = '%s - klient SNTP %s (%s) dla %s';
  SCopyright            = '%s';
  SEmpty                = '%s';
  SLocalPC              = '%-25s%s %s [%s]';
  STimeServer           = '%-25s%s %s [%s]';
  SPort                 = '%-25s%s %d';
  SHead1Byte1           = '%-25s%s Dec(%d), Hex(%s) [pierwszy bajt datagramu]';
  SLeapInicator         = '%-25s%s %d [%s]';
  SVersionNumber        = '%-25s%s %d [oznaczenie wer. protokołu]';
  SMode                 = '%-25s%s %d [%s]';
  SStratum              = '%-25s%s %d [%s]';
  SPollInterval         = '%-25s%s %d [2**%d = %.0f s, maks. odst. pomiędzy komunikatami]';
  SPrecision            = '%-25s%s %d [2**%.0d = %.12f... s = %.1f Hz]';
  SRootDelay            = '%-25s%s %.3f s [względem pierwszorzędnego źródła]';
  SRootDispersion       = '%-25s%s %.3f s [względem pierwszorzędnego źródła]';
  SReferenceIdentifier  = '%-25s%s %s';
  SReferenceTimestamp   = '%-25s%s %s';
  SOriginateTimeStamp   = '%-25s%s %s [T1]';
  SReceiveTimestamp     = '%-25s%s %s [T2]';
  STransmitTimestamp    = '%-25s%s %s [T3]';
  SDestinationTimestamp = '%-25s%s %s [T4]';
  SRoundTripDelay       = '%-25s%s %.3f s [(T4 - T1) - (T3 - T2)]';
  SLocalClockOffset     = '%-25s%s %.3f s [((T2 - T1) + (T3 - T4)) / 2]';
  STimeZoneName         = '%-25s%s %s [%s]';
  SLocalTime            = '%-25s%s %s';
  SGMTTime              = '%-25s%s %s';
  SAdjStatus            = '%-25s%s %s [kod rezultatu: %d]';
 
  { Stale zwracające dodtkowe informacje np. datę kompilacji }
  { Kod tabulatora }
  TAB = Chr($9);
  { Data kompilacji programu }
  Date = '18-04-2006';
  { Nr wersji }
  VerStr = 'wer. 1.2.8';
  { Nazwa aplikacji }
  ApplicationName = 'adSNTP';
  { Wersja systemu dla jakiego została wykonana kompilacja }
  TargetOS = 'Win32';
  { Informacje o autorach programu }
  CopyrightStr = 'Copyright (c) 2005, 2006 AD';
  { Jeden znak }
  OneChar = 1;
  { Ilość miejsc dla liczb szesnastkowych }
  HexDigits = 8;
 
{ Procedura zapisuje rezultaty do listy typu TStringList }
 
procedure WriteToStringList;
begin
  with StringList do
  begin
    Add(Format(STitle, [ApplicationName, VerStr, Date, TargetOS]));
    Add(Format(SCopyright, [CopyrightStr]));
    Add(Format(SEmpty, [EmptyStr]));
    Add(Format(SLocalPC, ['Twój PC', ':', LocalIP, LocalName]));
    Add(Format(STimeServer, ['Serwer czasu', ':', Host, HostIn]));
    Add(Format(SPort, ['Numer portu', ':', Port]));
    Add(Format(SHead1Byte1, ['Head1.Byte1.', ':', Head1Byte1,
      LowerCase(IntToHex(Head1Byte1, HexDigits))]));
    Add(Format(SLeapInicator, ['.Wskaźnik sekundy (LI)', ':',
      LeapIndicator, LeapIndicatorStr]));
    Add(Format(SVersionNumber, ['.Numer wersji (VN)', ':', VersionNumber]));
    Add(Format(SMode, ['.Tryb pracy', ':', Mode, ModeStr]));
    Add(Format(SStratum, ['Stratum', ':', Stratum, StratumStr]));
    Add(Format(SPollInterval, ['Interwał odpytujący', ':', ExpPoll, ExpPoll,
      PollInterval]));
    Add(Format(SPrecision, ['Prec. zegara serwera', ':', ExpPrecision,
      ExpPrecision, Precision, 1 / Precision]));
    Add(Format(SRootDelay, ['Opóźnienie podróży', ':', RootDelay]));
    Add(Format(SRootDispersion, ['Współczynnik dyspersji', ':',
      RootDispersion]));
    Add(Format(SReferenceIdentifier, ['ID źródła czasu', ':',
      ReferenceIdentifier]));
    Add(Format(SReferenceTimestamp, ['Ostatni czas źródła', ':',
      FormatDateTime('dd/mm/yyyy hh:nn:ss,zzz', ReferenceTimeStamp)]));
    Add(Format(SOriginateTimeStamp, ['Czas wysłania PC', ':',
      FormatDateTime('dd/mm/yyyy hh:nn:ss,zzz', OriginateTimeStamp)]));
    Add(Format(SReceiveTimestamp, ['Czas odbioru serwera', ':',
      FormatDateTime('dd/mm/yyyy hh:nn:ss,zzz', ReceiveTimestamp)]));
    Add(Format(STransmitTimestamp, ['Czas odesłania serwera', ':',
      FormatDateTime('dd/mm/yyyy hh:nn:ss,zzz', TransmitTimestamp)]));
    Add(Format(SDestinationTimestamp, ['Czas odbioru PC', ':',
      FormatDateTime('dd/mm/yyyy hh:nn:ss,zzz', DestinationTimestamp)]));
    Add(Format(SRoundTripDelay, ['Opóźnienie podróży', ':', RoundTripDelay]));
    Add(Format(SLocalClockOffset, ['Poprawka zegara PC', ':',
      LocalClockOffset]));
    Add(Format(STimeZoneName, ['Twoja strefa czasowa', ':', TimeZoneName,
      TimeZoneBiasStr]));
    Add(Format(SLocalTime, ['Poprawiony czas lokalny', ':',
      FormatDateTime('dd/mm/yyyy hh:nn:ss [dddd]', LocalTime)]));
    Add(Format(SGMTTime, ['Poprawiony czas GMT', ':',
      FormatDateTime('dd/mm/yyyy hh:nn:ss [dddd]', GMTTime)]));
    Add(Format(SAdjStatus, ['Synchronizacja zegara PC', ':', 'OK', AdjErrorCode]));
  end;
end;
 
{ Procedura zapisuje rezultaty do pliku logów }
 
procedure SaveSNTPLog(const APathToLogFile, AHostIn, ATimeZoneBias: string;
  const ADateTime: TDateTime; const AClockOffset: Double);
var
  ATextFile: TextFile;
begin
  if FileExists(APathToLogFile) then
  begin
    AssignFile(ATextFile, APathToLogFile);
    Append(ATextFile)
  end else
  begin
    AssignFile(ATextFile, APathToLogFile);
    Rewrite(ATextFile);
  end;
  try
    WriteLn(ATextFile, Format('%s%s%s%s%.6e%s%s',
      [FormatDateTime('dd/mm/yyyy hh:nn:ss', TimeDst), TAB, ATimeZoneBias, TAB,
      AClockOffset, TAB, AHostIn]));
  finally
    CloseFile(ATextFile);
  end;
end;
 
{ Pobranie rozmiaru buforu okna konsoli w znakach }
 
function GetConsoleSize: TCoord;
var
  ConsoleScreenBufferInfo: TConsoleScreenBufferInfo;
begin
  if GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE),
    ConsoleScreenBufferInfo) then
  Result := ConsoleScreenBufferInfo.dwSize;
end;
 
{ Implementacja pascalowej funkcji ReadKey }
 
function ReadKey: Char;
var
  AReadBuffer: LongWord;
  AInputRecord: TInputRecord;
  ALength: Cardinal;
begin
  Result := Chr($0);
  ALength := OneChar;
  repeat
    ReadConsoleInput(GetStdHandle(STD_INPUT_HANDLE), AInputRecord, ALength,
      AReadBuffer);
    if (AInputRecord.EventType = KEY_EVENT) and
      (AInputRecord.Event.KeyEvent.bKeyDown) then
    Result := AInputRecord.Event.KeyEvent.AsciiChar;
  until (AInputRecord.EventType = KEY_EVENT) and
    (AInputRecord.Event.KeyEvent.bKeyDown);
end;
 
{ Program główny }
 
begin
  ConsoleSize := GetConsoleSize;
  { Ustawienie scieżek do pliku logów }
  PathToLogFile := Concat(ExtractFilePath(ParamStr(0)), ApplicationName, '.log');
  PathToRegKey := Concat('\ArekDudka\', ApplicationName, '\ConnectSetup');
  ReadRegSetup(PathToRegKey, HostIn, RecvTime);
  { Pobranie parametrów z wiersza poleceń, jeśli są podane, }
  { program uruchamiamy poleceniem: adsntp [serwer] [czas odpowiedzi w ms], }
  { lub tylko: adsntp, to zostaną przyjęte parametry domyślne, }
  { jako serwer podajemy IP lub nazwe, a czas podajemy w milisekundach }
  if ParamStr(1) <> EmptyStr then
    HostIn := ParamStr(1);
  { Ustawienie dopuszczalnego czasu na połączenie z serwerem }
  if ParamStr(2) <> EmptyStr then
    RecvTime := StrToInt(ParamStr(2));
  { Utworzenie listy łańcuchów }
  StringList := TStringList.Create;
  { Pobranie danych strefy czasowej }
  TimeZoneName := GetTimeZoneInfo(TimeZoneBias);
  { Konwersja nazwy podanego serwera NTP }
  Host := AddrConvert(Addr, HostIn);
  FillChar(NTPGram, SizeOf(NTPGram), 0);
  { Ustawienie pierwszego bajtu datagramu, które odpowiada zgłoszeniu }
  { Twojego PC jako klienta oraz zgłoszenie informacji o użytej wersji }
  { protokolu SNTP jako wer. 3, Hex(1B) = Dec(27) }
  NTPGram.Head1 := $1B;
  TimeOrg := GetLocalTime;
  { Sprawdzenie zakresu daty }
  ChkDatePC(TimeOrg);
  DateTimeToNTP(TimeOrg, NTPGram.Xmit1, NTPGram.Xmit2);
  NTPGram.Xmit1 := Flip(NTPGram.Xmit1);
  NTPGram.Xmit2 := Flip(NTPGram.Xmit2);
  { Wysłanie i odczyt danych z serwera czasu }
  NTPGram := SendAndRecvData(NTPGram, Port, SizeOf(NTPGram), Flags, RecvTime);
  { Opracowanie danych zawartych w zwrotnym datagramie z serwera }
  TimeDst := GetLocalTime;
  Head1Byte1 := GetHead1Byte1(NTPGram);
  LeapIndicator := GetLeapIndicator(NTPGram);
  case LeapIndicator of
    0: LeapIndicatorStr := 'brak ostrzeżeń';
    1: LeapIndicatorStr := 'ostatnia minuta ma 61 sekund';
    2: LeapIndicatorStr := 'ostatnia minuta ma 59 sekund';
    3: LeapIndicatorStr := 'stan alarmu (zegar bez synchronizacji)';
  end;
  VersionNumber := GetVersionNumber(NTPGram);
  Mode := GetMode(NTPGram);
  case Mode of
    0: ModeStr := 'zarezerwowany';
    1: ModeStr := 'symetryczny aktywny';
    2: ModeStr := 'symetryczny pasywny';
    3: ModeStr := 'klient';
    4: ModeStr := 'serwer';
    5: ModeStr := 'broadcast';
    6: ModeStr := 'komunikat kontrolny NTP';
    7: ModeStr := 'zarezerwowany dla prywatnego użytku';
  end;
  Stratum := GetStratum(NTPGram);
  case Stratum of
    0:     StratumStr := 'nieokreslony lub niedostępny';
    1:     StratumStr := 'pierwszorzędne źródło (np. zegar radiowy)';
    2..15: StratumStr := '2..15: drugorzędne źródło (NTP lub SNTP)';
    16:    StratumStr := '16..255: zarezerwowany';
  end;
  PollInterval := GetPollInterval(NTPGram);
  Precision := GetPrecision(NTPGram);
  RootDelay := GetRootDelay(NTPGram);
  RootDispersion := GetRootDispersion(NTPGram);
  ReferenceIdentifier := GetReferenceIdentifier(NTPGram, Stratum);
  ReferenceTimeStamp := GetReferenceTimestamp(NTPGram);
  OriginateTimeStamp := GetOriginateTimestamp(NTPGram);
  ReceiveTimeStamp := GetReceiveTimestamp(NTPGram);
  TransmitTimeStamp := GetTransmitTimestamp(NTPGram);
  DestinationTimeStamp := TimeDst;
  RoundTripDelay := SetRoundTripDelay * SecsPerDay;
  LocalClockOffset := SetLocalClockOffset * SecsPerDay;
  { Sprawdzenie poprawności datagramu }
  if IsNTPGramOK(LeapIndicator, TransmitTimeStamp) then
  begin
    { Sprawdzenie powodzenia wykonania przestawienia czasu w systemie }
    if SetLocalTimeWin9xWinNT(TimeOrg + LocalClockOffset * OneSecond +
      RoundTripDelay * OneSecond) then
    begin
      AdjErrorCode := GetLastError;
      { Ponowne pobranie danych strefy czasowej - już poprawionej }
      TimeZoneName := GetTimeZoneInfo(TimeZoneBias);
      TimeZoneBiasStr := SetTimeZoneBiasStr(TimeZoneBias);
      LocalTime := GetLocalTime;
      GMTTime := LocalTime + TimeZoneBias;
      WriteToStringList;
      SaveSNTPLog(PathToLogFile, HostIn, TimeZoneBiasStr, GetLocalTime,
        LocalClockOffset);
    end else
      AdjErrorCode := GetLastError;
  end;
  { Wyprowadzenie rezultatow na ekran, wydruk zostaje zatrzymany }
  { jeżeli ilość wierszy tekstu przekracza wielkość buforu konsoli }
  for Row := 0 to StringList.Count - 1 do
  begin
    Inc(Counter);
    if Counter mod ConsoleSize.Y = 0 then
      ReadKey;
    WriteLn(StrToOem(StringList[Row]));
  end;
  WriteRegSetup(PathToRegKey, HostIn, RecvTime);
  StringList.Free;
end.


Zakończenie


<justify>Gotowy plik wykonywalny programu oraz kod źródłowy modułów można pobrać tutaj: http://www.toya.net.pl/~topcon/sntp.zip . Program uruchamiamy poleceniem: adsntp lub z podaniem parametrów: adsntp [Nazwa lub IP serwera] [czas na połączenie]. Przykładowe wywołanie może wyglądać tak: adsntp ntp.task.gda.pl 2500. Ostatni parametr - czas, podawany jest w milisekundach.</justify>