Форум: "Сети";
Текущий архив: 2005.01.23;
Скачать: [xml.tar.bz2];

Вниз

Как синхронизировать часы   Найти похожие ветки 

← →
Алексей   (2004-11-03 14:09) [0]

У меня возникла проблема с часами в компютере и мне необходимо довольно часто их синхронизировать с сервером времени в Интернете.
Поэтому я решил написать маленькую програмку для автоматической синхронизации даты и времени. Может кто решал подобную задачу, тогда у меня просьба: посоветуйте как это сделать наиболее эффективно.
С уважением, Алексей.

---

← →
easy ©   (2004-11-03 15:34) [1]

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.

---

← →
panov ©   (2004-11-03 15:45) [2]

program SetTime;
uses
 Windows, SysUtils, IdTime;

var
 CurrTime: TDateTime;
 st: TSystemTime;
 YY,MM,DD,HH,NN,SS,MS: Word;
begin
 CurrTime := Now;
   try
     with tIdTime.Create(nil) do
     begin
//        Host := "ntps1-0.uni-erlangen.de";
       Host := "192.168.0.1";
       try
         CurrTime := DateTime;
       except
         Free;
       end;
       Free;
     end;
   except
   end;
   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.


---

← →
Comp ©   (2004-11-03 18:32) [3]

>  [2] panov ©   (03.11.04 15:45)


Неплохо. Тем более на API.

Правда с хостом 192.168.0.1 не работает.
С "ntps1-0.uni-erlangen.de" все нормально.

---

← →
Сергей Г   (2004-11-05 20:10) [4]

Не врубаюсь у меня почему-то время получается на один час больше?????????????????? С какими "часами" синхронизируемся?

---

Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2005.01.23;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.038 c