Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.05.02;
Скачать: CL | DM;

Вниз

Как синхронизировать время с сервером точного времени в Интернет?   Найти похожие ветки 

 
kas-t   (2004-03-04 19:41) [0]

Народ, может кто подскажет как можно из Delphi синхронизировать время с удаленным сервером точного времени в Интернете? Желательно конечно пример, или хотя бы направление в какую сторону копать . Зарание огромное спасибо!


 
TButton ©   (2004-03-04 19:47) [1]

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


 
TButton ©   (2004-03-04 19:48) [2]

а ну коннектиться через TCP\IP если это так важно в данном контексте...


 
kas-t   (2004-03-04 21:25) [3]

А как приконнектится? И чем? Можно примерчик?


 
Rouse_ ©   (2004-03-04 22:21) [4]

Ну вообщето насколько я помню на 37-ой порт, а во вторых, может проще через IdTime?


 
Rouse_ ©   (2004-03-04 22:25) [5]

Кстати на DAYTIME (13-й порт) не обязательно устанавливать соединение, можно и по UDP


 
TButton ©   (2004-03-04 22:45) [6]

Удалено модератором
Примечание: Будь другом, не ляпай экспромтом...


 
Карелин Артем ©   (2004-03-05 10:11) [7]

Net time может?


 
Verg ©   (2004-03-05 10:35) [8]

И 13 и 37-ой
Разница в том, что на 13 порту время возвращается в текстовом формате, а с 37-го - 32-х разрядное число - количество секунд, прошедших с 00:00:00 1 января 1900 года (UTC).


 
able ©   (2004-03-05 12:28) [9]

net time??


 
Fredericco ©   (2004-03-05 14:23) [10]


unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   Timer1: TTimer;
   ClientSocket1: TClientSocket;
   procedure Timer1Timer(Sender: TObject);
   procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
   procedure ClientSocket1Disconnect(Sender: TObject;
     Socket: TCustomWinSocket);
   procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
     ErrorEvent: TErrorEvent; var ErrorCode: Integer);
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 DayOfWeek:string;
 Month:string;
 sDayOfMonth:string;
 sTime:string;
 sHour,sMin,sSec:string;
 sYear:string;
 HostOfServ:array[1..2] of string;
 CurrServ:integer=1;

implementation

{$R *.DFM}

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 try
   ClientSocket1.Open;
   Timer1.Enabled:=False;
 except
   if CurrServ=1 then CurrServ:=2 Else CurrServ:=1;
   ClientSocket1.Host:=HostOfServ[CurrServ];
 end;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
 Socket: TCustomWinSocket);
var
 s:string;
 st:_SYSTEMTIME;
begin
 try
   GetLocalTime(st);
   s:=Socket.ReceiveText;
   s:=Copy(s,1,Length(s)-2);
   {"Fri Aug  1 11:20:53 2003"}

   DayOfWeek:=Copy(s,1,3);
   Month:=Copy(s,4,3);
   sDayOfMonth:=Copy(s,9,2);
   sYear:=Copy(s,21,4);
   sHour:=Copy(s,12,2);
   sMin:=Copy(s,15,2);
   sSec:=Copy(s,18,2);

   st.wHour:=StrToInt(sHour);
   st.wMinute:=StrToInt(sMin);
   st.wSecond:=StrToInt(sSec);
   SetLocalTime(st);
 except
 end;
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
 Socket: TCustomWinSocket);
begin
 Timer1.Enabled:=True;
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
 Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
 var ErrorCode: Integer);
begin
 ErrorCode:=0;
 Socket.Disconnect(Socket.SocketHandle);
 if CurrServ=1 then CurrServ:=2 Else CurrServ:=1;
 ClientSocket1.Host:=HostOfServ[CurrServ];
 Timer1.Enabled:=False;
 Timer1.Enabled:=True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 HostOfServ[1]:="ntp.psn.ru";
 HostOfServ[2]:="sign.chg.ru";
end;

end.


 
kas-t   (2004-03-06 08:40) [11]

Досканально по разбиратся с исходным кодом не успел. Но попробывал его запустить. При запуске спустя указанное время в таймере выскакивает ошибка (я добавил извещение об этом) после чего соеденние больше не происходит. В общем, ни какой информации с серверов не приходит. Я так понимаю порт дожен быть указан 13?


 
TUser ©   (2004-03-06 13:25) [12]

см на delphiworld есть несколько примеров сабжа.


 
Verg ©   (2004-03-06 14:30) [13]

Разберись с тем исходником - "научишь" его работать, то будет плюс к навыкам в асинхронных сокетах.

Вот еще тебе "лабораторная" :) по блокирующим сокетам:

program gettime;

{$APPTYPE CONSOLE}

uses
 Windows,
 WinSock, SysUtils;

function IsIP(const Value: string): Boolean;
var
 n, x: Integer;
begin
 Result := true;
 x := 0;
 for n := 1 to Length(Value) do
   if not (Value[n] in ["0".."9", "."]) then
   begin
     Result := False;
     Break;
   end else
   begin
     if Value[n] = "." then
       Inc(x);
   end;
 if x <> 3 then
   Result := False;
end;

function GetNetTime(const Host : string): string;
const
  EOLN = #10;
  BUFFER_MAX   = 300;
var
 S : TSocket;
 PHst : PHostent;
 Addr : TSockAddrIn;
 Recvd, Rec : integer;
 I : integer;
begin
 Result:="ERROR";
 FillChar(Addr, sizeof(addr), 0);
 Addr.sin_family := AF_INET;
 Addr.sin_port   := htons(13);
 if not IsIp(Host) then
 begin
   PHst := gethostbyname(pchar(Host));
   if PHst = nil then
     exit;
   Addr.sin_addr.S_addr :=  PInteger(PHst^.h_addr^)^;
 end else
   Addr.sin_addr.S_addr := inet_addr(pchar(Host));
 S := socket(PF_INET, SOCK_STREAM,0);
 if S<>INVALID_SOCKET then
 try
   if connect(S, Addr, sizeof(Addr)) = SOCKET_ERROR then
     exit;
   SetLength(Result, BUFFER_MAX);
   Recvd := 0;
   try
     repeat
       Rec := recv(S, result[Recvd+1], length(Result) - Recvd, 0);
       if Rec <= 0 then
         exit;
       Recvd := Recvd + Rec;
       I := Pos(EOLN, Result);
       if (I > 0) and (I <= Recvd) then
         Exit;
       if Recvd = length(Result) then
         exit;
     until false;
   finally
     SetLength(Result, Recvd);
     Result := trim(Result);
   end;
 finally
   closesocket(S);
 end;
end;

var
 WSAData : TWSAData;

begin
 if WSAStartup(MAkeWord(1,1), WSAData) = 0 then
 try
   Writeln(GetNetTime("ntp.psn.ru"));
 finally
   WSACleanup;
 end else
   Writeln("Ошибка инициализации WinSock");
 ReadLn;
end.



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

Текущий архив: 2004.05.02;
Скачать: CL | DM;

Наверх




Память: 0.51 MB
Время: 0.023 c
7-1079437536
dik
2004-03-16 14:45
2004.05.02
Последовательный порт


1-1082110808
webpauk
2004-04-16 14:20
2004.05.02
Transparent text


3-1080906055
Дмитрий
2004-04-02 15:40
2004.05.02
CONNECT TO FIREBIRD через Инет!!! Хелп!


3-1081251793
V-A-V
2004-04-06 15:43
2004.05.02
Прверка уникальности индекса


6-1078166800
pomashok
2004-03-01 21:46
2004.05.02
raise