Czas - synchronizacja przez SNTP
topcon
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>