Delphi開發環境中應用層網絡協議的實現

時間 2020-01-27

原文原文鏈接

參考網址:[url]http://www.yesky.com/406/181406.shtml[/url]

已經進入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級範圍內。

　　二、用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同步本地計算機時間，結束時關閉套接字。

　　 2、編程步驟:

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

　　3、完整的單元文件以下：

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.chbiofiz.mf.uni-lj.si*black-ice.cc.vt.educhime.utoronto.ca*churchy.udel.edu (128.4.1.5) clepsydra.dec.comclock.psu.educlock.tricity.wsu.edu (192.31.216.30) constellation.ecn.uoknor.educuckoo.nevada.edu*delphi.cs.ucla.edudominator.eecs.harvard.edu