| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Синхронизация времени

GUEST ©   (2004-08-11 04:16:00) 

Как синхронизировать время с атомными часами через интернет?
Заранее благодарю.

---

Vit@ly   (2004-08-11 15:38:00) [1]

В посте не "заметил" слова Delphi
http://www.express-computing.com/files/download.com/ExpressTimeSync30.exe
Триальная версия на 30 дней

---

easy   (2004-08-11 14:22:00) [2]

unit frmMainU;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ScktComp, StdCtrls;

type
 TForm1 = class(TForm)
   Memo1: TMemo;
   Button1: TButton;
   ClientSocket1: TClientSocket;
   procedure Button1Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
   procedure ClientSocket1Connect(Sender: TObject;
     Socket: TCustomWinSocket);
   procedure ClientSocket1Disconnect(Sender: TObject;
     Socket: TCustomWinSocket);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

function ntohl(const value: cardinal): cardinal;
asm
 mov edx, eax
 mov ecx, eax
 shl ecx, 16
 and eax, $0000ff00
 or eax, ecx
 mov ecx, edx
 shl eax, 8
 and ecx, $00ff0000
 shr edx, 16
 or ecx, edx
 shr ecx, 8
 or eax, ecx
end;

function TimeZoneBias: Double;
var
 ATimeZone: TTimeZoneInformation;
begin
 if (GetTimeZoneInformation(ATimeZone) = TIME_ZONE_ID_DAYLIGHT) then
 begin
   result := ATimeZone.Bias + ATimeZone.DaylightBias;
 end
 else
 begin
   result := ATimeZone.Bias + ATimeZone.StandardBias;
 end;
 Result := Result / 1440;
end;

function SecsToTime(ASecs: Cardinal): TDateTime;
const
 SECS_PER_DAY = 24 * 60 * 60;
 UNIX_OFFSET = 25569;
begin
 Result := ntohl(ASecs) / SECS_PER_DAY + encodedate(1900, 1, 1) - TimeZoneBias;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Memo1.Clear;
 memo1.Lines.Add('Connecting to ' + ClientSocket1.Host + '...');
 ClientSocket1.Open;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 ClientSocket1.Host := 'time-A.timefreq.bldrdoc.gov';
 ClientSocket1.Port := 37;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
 Socket: TCustomWinSocket);
var
 buf: Cardinal;
begin
 Socket.ReceiveBuf(buf, sizeof(buf));
 memo1.Lines.Add(#13#10 + '-----------------------');
 memo1.Lines.Add(formatdatetime('dd.mm.yyyy hh:nn:ss', SecsToTime(buf)));
 memo1.Lines.Add('-----------------------'#13#10);
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
 Socket: TCustomWinSocket);
begin
 memo1.Lines.Add('Connect');
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
 Socket: TCustomWinSocket);
begin
 memo1.Lines.Add('Disonnect');
end;

end.

---

Мастер   (2004-08-11 12:05:00) [3]

procedure TForm1.Button1Click(Sender: TObject);
var
 iT: tIdTime;
 CurrTime: TDateTime;
 st: TSystemTime;
 YY,MM,DD,HH,NN,SS,MS: Word;
begin
 iT := tIdTime.Create(nil);
 iT.Host := 'ntps1-0.uni-erlangen.de';
 CurrTime := iT.DateTime;
 iT.Free;
 GetLocalTime(st);
 DecodeDate(CurrTime,YY,MM,DD);
 DecodeTime(CurrTime,HH,NN,SS,MS);
 st.wYear := YY;
 st.wMonth := MM;
 st.wDay := DD;
 st.wHour := HH;
 st.wMinute := NN;
 st.wSecond := SS;
 st.wMilliseconds := MS;
 SetLocalTime(st);
end;

---

REA   (2004-08-11 09:53:00) [4]

Вот, например TIdTime, TIdSNTP. Сам не пробовал.

Unit IdTime

Description
TIdTime is a client implementation of the Time Protocol as described in the Internet Standards document:

RFC 868 - Time Protocol ( http://www.rfc-editor.org/rfc/rfc868.txt)

Time is a simple protocol for synchronizing time on a local network. For a time protocol with higher accuracy over several networks, use TIdSNTP. To retrieve the current date and time in human-readable form, use TIdDayTime.

Please note that the Time Protocol in its current form cannot handle most dates after the year 2035. This limitation is stated in RFC 868.

---

GUEST   (2004-08-11 08:40:00) [5]

ну можеть у кого примерчик есть, я тоже на сайт ене нашел...

---

TUser   (2004-08-11 05:57:00) [6]

Я точно видел на DelphiWorld статью об этих серверах. Сейчас вот не могу ее найти, но она там точно есть. Поищи.

---

GUEST   (2004-08-11 05:27:00) [7]

Да атомные это так, забыл в кавычки взять :)
Как вообще организовать взаимодействие программы с этими серверами? как узнать время?

---

TUser   (2004-08-11 05:12:00) [8]

Насчет атомных часов не знаю, но есть специальные сервера, с которых мжно узнать время. Атомные там часы стоят или песочные - это надо спросить у хозяина сервера. Поищи, может найдешь с атомными.

---

Наверх