Конференция "Начинающим" » Достоверные дата время [D7, XP]
 
  • dis12345 © (09.08.17 23:54) [0]
    Здравствуйте!
    Подскажите как программно получить значение текущей даты и времени (НЕ компьютера (может сесть батарейка и дата в биосе улетит в прошлое)) а с какого-то сервера времени ?
  • 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;

 
Конференция "Начинающим" » Достоверные дата время [D7, XP]
Есть новые Нет новых   [87965   +9][b:0.001][p:0.002]