Delphi开发环境中应用层网络协议的实现

　已经进入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