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

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

Как синхронизировать часы [D6, D7, WinME, WinXP]


Алексей ©   (2004-11-03 14:09:00) 

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


Сергей Г   (2004-11-05 20:10:00) [1]

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


Comp   (2004-11-03 18:32:00) [2]


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


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

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


panov   (2004-11-03 15:45:00) [3]

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.


easy   (2004-11-03 15:34:00) [4]

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.


Наверх

Титульная страница Поиск, карта сайта Написать письмо