从Internet时间服务器获取标准时间(0分)

{******************************************************************************}
{ 本程序利用ClientSocket连接到提供“格林尼制标准时间”服务的时间服务器取得标}
{准时间，在“ClientSocket1Read”中，作者只对从“Time.nist.gov”接收到的数据进行}
{了处理，每个Time Server返回的数据格式不同，使用者可以自行分析其他Time Server返}
{回的数据 }
{******************************************************************************}
unit uAdjustTime;

interface

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

const
arrAddress:array[0..3] of string=('192.43.244.18', // Time.nist.gov(NIST物理学实验室)
'192.5.41.40', // tick.usno.navy.mil(美国海军天文台)
'192.48.153.80', // Clock.sgi.com(SGI)
'18.145.0.30'); // Tick.mit.edu(麻省理工学院)
type
TfrmAdjustTime = class(TForm)
ClientSocket1: TClientSocket;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
ComboBox1: TComboBox;
Edit1: TEdit;
Edit2: TEdit;
Bevel1: TBevel;
Button1: TButton;
Panel1: TPanel;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Lookup(Sender: TObject;
Socket: TCustomWinSocket);
procedure ComboBox1Change(Sender: TObject);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
procedure AppException(Sender: TObject; E: Exception);
public
{ Public declarations }
end;

var
frmAdjustTime: TfrmAdjustTime;
ServerAddress: string;
ConNum: integer;

implementation

{$R *.DFM}

//向选定的地址连接
procedure TfrmAdjustTime.Button1Click(Sender: TObject);
begin
ConNum := ConNum + 1;
if ConNum > 1 then Memo1.Lines.Add('-------------------------------------------------------------');
ClientSocket1.Close;
ClientSocket1.Address := ServerAddress;
ClientSocket1.Port := 13;
try
ClientSocket1.Open;
except
on E: ESocketError do Memo1.Lines.Add('Can not connect to Time Server!');
end;
end;

//分析接收到的消息
procedure TfrmAdjustTime.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
strTime: string;
StandardTime, BeijingTime, DTime: TDateTime;
SysTime: TSystemTime;
begin
strTime := Socket.ReceiveText; // 取得格林尼治时间;
strTime := Copy(strTime, 8, 17); // 取得日期时间部分;
if Length(strTime) = 17 then strTime := '20' + strTime; // 年份转换为四位;
DTime := EncodeTime(8, 0, 0, 0); // 时差
StandardTime := StrToDateTime(strTime); //标准时间
BeijingTime := StandardTime + DTime; // 北京时间
Edit1.Text := DateTimeToStr(StandardTime);
Edit2.Text := DateTimeToStr(BeijingTime);
DateTimeToSystemTime(StandardTime, SysTime);
SetSystemTime(SysTime); //修正本机系统时间
Memo1.Lines.Add('Adjust time successful!');
end;

//错误处理
procedure TfrmAdjustTime.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Memo1.Lines.Add(IntToStr(ErrorCode));
case ErrorEvent of
eeGeneral: Memo1.Lines.Add('The socket received an error message that does not fit into any of the following categories.');
eeSend: Memo1.Lines.Add('An error occurred when trying to write to the socket connection.');
eeReceive: Memo1.Lines.Add('An error occurred when trying to read from the socket connection.');
eeConnect: Memo1.Lines.Add('A connection request that was already accepted could not be completed.');
eeDisconnect: Memo1.Lines.Add('An error occurred when trying to close a connection.');
eeAccept: Memo1.Lines.Add('A problem occurred when trying to accept a client connection request.');
end;
ErrorCode := 0;
ClientSocket1.Close;
end;

//正在连接
procedure TfrmAdjustTime.ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add('Connectting......');
end;

//连接成功
procedure TfrmAdjustTime.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add('Connected!');
end;

//解析服务器地址
procedure TfrmAdjustTime.ClientSocket1Lookup(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add('Search Time Server......');
end;

//确定服务器IP地址
procedure TfrmAdjustTime.ComboBox1Change(Sender: TObject);
begin
Button1.Enabled := ComboBox1.Text <> '';
if ComboBox1.Text <> ''
then Serveraddress:=arrAddress[ComboBox1.ItemIndex];
end;

//断开连接
procedure TfrmAdjustTime.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add('Disconnection！');
end;

//初始化
procedure TfrmAdjustTime.FormCreate(Sender: TObject);
begin
Application.OnException := AppException;
ConNum := 0;
end;

//异常处理
procedure TfrmAdjustTime.AppException(Sender: TObject; E: Exception);
begin
Memo1.Lines.Add(E.Message);
if E is ESocketError then Memo1.Lines.Add('Can not connect to Time Server!');
ClientSocket1.Close;
end;

//关闭
procedure TfrmAdjustTime.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
ClientSocket1.Close;
ClientSocket1.Destroy;
end;


end.

用indy也可以的

time server,indy,ics都有例子的，是RFC的标准协议，格式统一的

格式应该是统一的，但是有些服务器并没有遵循标准，比较气人。

finish

finish