Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »

Достоверные дата время [D7, XP]


dis12345 ©   (09.08.17 23:54

Здравствуйте!
Подскажите как программно получить значение текущей даты и времени (НЕ компьютера (может сесть батарейка и дата в биосе улетит в прошлое)) а с какого-то сервера времени ?


Inovet ©   (10.08.17 08:06[1]

Везде забанили?

Служба точного времени
https://ru.wikipedia.org/wiki/%D0%A1%D0%BB%D1%83%D0%B6%D0%B1%D0%B0_%D1%82%D0%BE%D1%87%D0%BD%D0%BE%D0%B3%D0%BE_%D0%B2%D1%80%D0%B5%D0%BC%D0%B5%D0%BD%D0%B8

В статье ссылка на
NTP (англ. Network Time Protocol — протокол сетевого времени)
https://ru.wikipedia.org/wiki/NTP


ВладОшин ©   (10.08.17 08:27[2]

IdDayTime1.Host := 'time.nist.gov';
 ShowMessage(IdDayTime1.ConnectAndGetAll);


dim12345   (10.08.17 08:42[3]

Нашел:

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.


dim12345   (10.08.17 08:53[4]

О! У ВладОшин лаконичнее !  Буду разбираться!  Спасибо!!!


han_malign ©   (10.08.17 12:57[5]


> function ntohl(const value: cardinal): cardinal;
> asm

Жаль копирайта нет - есть платформонезависимая Winsock.ntohl.
особенно учитывая:
function byteswap(value: cardinal): cardinal; assembler;
asm
    bswap EAX
end;


версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо