你
你健康我快乐
Unregistered / Unconfirmed
GUEST, unregistred user!
我的程序代码如下,不知为何套接字会创建失败?有没有哪位高手做过NTP的程序,不用Delphi带的控件(我试过好几个Delphi带的控件都不好用),只用WinSocket。敬请各位指教!谢谢!unit Unit1;interfaceuses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Winsock; //添加winsock单元,直接调用WINSOCK API;type TForm1 = class(TForm) Label1: TLabel; Button1: TButton; 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;type TNTPGram = packed record //NTP数据格式 head1, head2, 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;const Port = 123; //SNTP端口号必须为123; maxint2 = 4294967296.0;var Form1: TForm1; MySocket: TSocket; fiMaxSockets: Integer; MyAddr: TSockAddrIn; UDPSize: Integer;implementation{$R *.DFM}procedure TForm1.Button1Click(Sender: TObject);begin //label1.Caption := timetostr(MySyncTime('bernina.ethz.ch')); label1.Caption := timetostr(MySyncTime('time.windows.com'));end;procedure TForm1.FormCreate(Sender: TObject); //初始化套接字;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 raise Exception.Create('套接字建立失败!'); try with MyAddr do //时间服务器名字 begin 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 CloseSocket(MySocket); raise; end; end;end;procedure TForm1.MySend(s: String); //发送请求时间数据报;begin SendTo(MySocket, s[1], Length(s), 0,Myaddr , sizeof(Myaddr));end;function TForm1.MyReceive; //接收服务器时间数据报;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; //网络字节顺序与本机字节顺序转换;var n1, n2 : lr;begin n1 := lr; 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;//将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 d1 := d1 - maxint2; nsec := trunc(d1); d1 := ((frac(d) * 1000) / 1000) * maxint2; if d1 > maxint then d1 := d1 - maxint2; 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); //将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); MyDisconnect; except MyDisconnect; showmessage('时间同步失败!'); Application.Terminate; end;end;procedure TForm1.MyDisconnect;begin if MySocket <> INVALID_SOCKET then CloseSocket(MySocket);end;end.