interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs,
StdCtrls,winsock ;// 添加winsock单元，直接调用WINSOCK API；
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure MyConnect(host:string){ Private declarations };
Procedure MySend( s:string);
function MyReceive: string;
procedure MyDisconnect;
function MySyncTime(host:string):TDateTime;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
type
// NTP 数据格式
tNTPGram = packed record
head1, head2, file://其中,head1为LI VN 及Mode（见图二）;
head3, head4 : byte;
RootDelay : longint;
RootDisperson : longint;
RefID : longint;
Ref1, Ref2,
Org1, Org2,
Rcv1, Rcv2,
Xmit1, Xmit2 : longint;//Transmit Timestamp（传输时间戳）
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption:= timetostr(MySyncTime('bernina.ethz.ch'));
end;

procedure TForm1.FormCreate(Sender: TObject); file://初始化套接字;
var sData:TWSAData; 
fsStackDescription:string;
begin
if WSAStartup($101, sData) = SOCKET_ERROR then
raise Exception.Create('Winsock Initialization Error.'); 
fsStackDescription := StrPas(sData.szDescription);
UDPSize := sData.iMaxUdpDg;
fiMaxSockets := sData.iMaxSockets;
MySocket:= INVALID_SOCKET ;

end;

var d, d1 : double;
begin
d := dt + tzbias - 2;
d := d * 86400;
d1 := d;
if d1 > maxint then begin
d1 := d1 - maxint2;
end;
nsec := trunc(d1);
d1 := ((frac(d) * 1000) / 1000) * maxint2;
if d1 > maxint then begin
d1 := d1 - maxint2;
end;
nfrac := trunc(d1);
end;

d1 := nfrac;
if d1 < 0 then d1 := maxint2 + d1 - 1;
d1 := d1 / maxint2;
d1 := trunc(d1 * 1000) / 1000;
result := (d + d1) / 86400;
result := result - tzbias + 2;
end;

end;
end;