已經進入Internet網絡時代了,許多新出的軟件都擁有網絡功能。其實,在這些軟件背后所依靠的技術基礎就是一系列的Inernet網絡協議標準,亦即TCP/IP系列協議。

　　下面本人簡要介紹一下在Delphi環境下，直接采用winsock套接字編程，應用SNTP協議開發出具有網絡時間校準功能的應用,以此來說明如何在編程實踐中實現應用層網絡協議，相信感興趣的讀者能從中舉一反三。

　　一、程序原理：

　　1、 SNTP協議的運作機制 SNTP（簡單網絡時間協議）是在UDP協議基礎上發展出來的應用協議，目前廣泛應用于整個INTERNET上計算機時鐘的同步，依據同步源的性能及網絡路徑的差異，提供1~50ms的較準精度（資料來源：RFC-2030）。

　　SNTP報文封裝見圖三，有關IP報頭和UDP報頭的詳細結構這里不再贅述，需要知道的是針對我們的SNTP應用，UDP報頭的源端口和目的端口值均應設定為123，SNTP數據緊跟在UDP報頭后（數據格式見圖二），SNTP協議應用分服務器端和客戶端，根據我們的應用需求只要考慮SNTP客戶端單播模式（UNICAST MODE）的運作：在該模式下，客戶端初始化NTP數據報，將SNTP數據頭的VN（協議版本號）值設置成3（即Version3）；Mode值設置成3（即客戶端模式）；數據區的Transmit Timestamp（傳輸時間戳）值設置成客戶機當前時間；然后向一個特定的單播模式時間服務器發出該數據報并接受服務器的回答，收到回答報文后從其中的傳輸時間戳里獲取同步時間。需要注意的是請求數據報初始化時其傳輸時間戳必須被設定為客戶機當前時間，這樣可以通過計算,消除服務器客戶機之間的傳播延遲，有效地將同步精度控制在10ms級范圍內。

　　2、用WINSOCK API實現SNTP 首先，調用socket(domain,type,protocol)建立套接字，其中domain 為 PF_INET（Internet域）；type 為SOCK_DGRAM（UDP數據報）； protpcol為IPPROTO_IP（IP協議）。其次，調用sendto(socket_id,buf,buflen,flags,to,tolen)發送SNTP客戶端請求，其中，buf為SNTP數據；to為時間服務器名字，它是一結構，包含域名、端口號、32位主機地址等；socket_id為套接字號 。接著，調用recvfrom (socket_id,buf,buflen,flags,from,fromlen)接收SNTP數據回答，其中buf為SNTP數據回答。，將回答數據中的傳輸時間戳（Transmit Timestamp）轉換成Delphi的時間格式，并調用WINDOWS API函數SetLocalTime同步本地計算機時間，結束時關閉套接字。

　　二、編程步驟:

　　在IDE中建立一個新工程,缺省的Form上放一個label控件、一個button控件，在button控件的OnClick事件句柄中鍵入執行同步時間函數及label控件時間顯示代碼，另外在單元文件中建立MySyncTime等5個有關時間同步函數（過程），，編譯該工程。

　　三、完整的單元文件如下：


unit Unit1;

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;


// 用于轉換本機網絡字節順序;
lr = packed record
l1, l2, l3, l4 : byte;
end;
var MySocket:Tsocket;
fiMaxSockets:integer;
MyAddr: TSockAddrIn;
UDPSize:integer;
const Port=123;// SNTP端口號必須為123；

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;


procedure TForm1.MyConnect(host:string);//建立套接字,域名解析;
var fsPeerAddress:string;
function ResolveHost(const psHost: string; var psIP: string): u_long;//主機名解析成IP地址;
var
pa: PChar;
sa: TInAddr;
aHost: PHostEnt;
begin
psIP := psHost;
if CompareText(psHost, 'LOCALHOST') = 0 then begin
sa.S_un_b.s_b1 := #127;
sa.S_un_b.s_b2 := #0;
sa.S_un_b.s_b3 := #0;
sa.S_un_b.s_b4 := #1;
psIP := '127.0.0.1';
Result := sa.s_addr;
end else begin
Result := inet_addr(PChar(psHost));
if Result = u_long(INADDR_NONE) then begin
aHost := GetHostByName(PChar(psHost));
pa := aHost^.h_addr_list^;
sa.S_un_b.s_b1 := pa[0];
sa.S_un_b.s_b2 := pa[1];
sa.S_un_b.s_b3 := pa[2];
sa.S_un_b.s_b4 := pa[3];
psIP := IntToStr(Ord(sa.S_un_b.s_b1)) + '.' + IntToStr(Ord(sa.S_un_b.s_b2)) + '.'
+ IntToStr(Ord(sa.S_un_b.s_b3)) + '.' + IntToStr(Ord(sa.S_un_b.s_b4));
Result := sa.s_addr;
end;
end;
end;
begin
MySocket:=socket(PF_INET,SOCK_DGRAM, IPPROTO_IP);//建立套接字,采用UDP/IP協議;
if MySocket = INVALID_SOCKET then begin
raise Exception.Create('套接字建立失敗！');
end;
try
with MyAddr do begin file://時間服務器名字；
sin_family := PF_INET;
sin_port := HToNS(Port);
sin_addr.S_addr := ResolveHost(host, fsPeerAddress);
end;
except
On E: Exception do begin
if MySocket <> INVALID_SOCKET then begin
CloseSocket(MySocket);
end;;
raise;
end;
end;
end;


procedure TForm1.MySend( s:string); file://發送 請求時間數據報;
begin
SendTo(MySocket, s[1], Length(s), 0,Myaddr , sizeof(Myaddr));
end;
function TForm1.MyReceive; file://接收服務器時間數據報;
var
AddrVoid: TSockAddrIn;
fsUDPBuffer:string;
i:integer;
begin
SetLength(fsUDPBuffer, UDPSize);
i:= SizeOf(AddrVoid) ;
result := Copy(fsUDPBuffer,1,Recvfrom(Mysocket, fsUDPBuffer[1], Length(fsUDPBuffer), 0, AddrVoid , i) );
end;
function flip(var n : longint) : longint; file://網絡字節順序與本機字節順序轉換;
var
n1, n2 : lr;
begin
n1 := lr(n);
n2.l1 := n1.l4;
n2.l2 := n1.l3;
n2.l3 := n1.l2;
n2.l4 := n1.l1;
flip := longint(n2);
end;
function tzbias : double; // 獲取本地時間區與UTC時間偏差;
var
tz : TTimeZoneInformation;
begin
GetTimeZoneInformation(tz);
result := tz.Bias / 1440;
end;
const maxint2 = 4294967296.0;


// 將DELPHI的 TDateTime 格式轉換成為 NTP 時間戳(timestamp)格式 ;
procedure dt2ntp(dt : tdatetime; var nsec, nfrac : longint);

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;


// 將NTP 時間戳(timestamp)格式轉換成為DELPHI的 TDateTime 格式;
function ntp2dt(nsec, nfrac : longint) : tdatetime;
var
d, d1 : double;
begin
d := nsec;
if d < 0 then d := maxint2 + d - 1;

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;


function TForm1.MySyncTime(host:string):TDateTime;//獲取時間服務器上的標準時間,同時同步本地時間;
var
ng : TNTPGram;
s : string;
SysTimeVar : TSystemTime;
begin
fillchar(ng, sizeof(ng), 0); file://將 SNTP數據報初始化;
ng.head1 := $1B; // 設置SNTP數據報頭為SNTP 協議版本3,模式3(客戶機)，即二進制00011011;
dt2ntp(now, ng.Xmit1, ng.xmit2);//將本機時間轉換為數據報時間格式;
ng.Xmit1 := flip(ng.xmit1);
ng.Xmit2 := flip(ng.xmit2);
setlength(s, sizeof(ng));
move(ng, s[1], sizeof(ng));
try
MyConnect(host);
MySend(s);
s := MyReceive;
move(s[1], ng, sizeof(ng));
result := ntp2dt(flip(ng.xmit1), flip(ng.xmit2));// 將收到的數據報時間格式轉換為本機時間;
DateTimeToSystemTime( result, SysTimeVar) ;
SetLocalTime( SysTimeVar ); file://同步本地時間;
MyDisconnect;
except
MyDisconnect;
showmessage('時間同步失敗!');
application.Terminate;

end;
end;


procedure TForm1.MyDisconnect; file://關閉套接字;
begin
if MySocket <> INVALID_SOCKET then begin
CloseSocket(MySocket);
end;
end;
end.

　　
　　程序在Delphi3+ win98se 上通過。

　　附部分SMTP時間服務器網址：

augean.eleceng.adelaide.edu.au*
bernina.ethz.ch
biofiz.mf.uni-lj.si*
black-ice.cc.vt.edu
chime.utoronto.ca*
churchy.udel.edu (128.4.1.5)
clepsydra.dec.com
clock.psu.edu
clock.tricity.wsu.edu (192.31.216.30)
constellation.ecn.uoknor.edu
cuckoo.nevada.edu*
delphi.cs.ucla.edu
dominator.eecs.harvard.edu