WinSock网络校时源码,编译完只有36KB

talince

[ 本帖最后由 talince 于 2014-8-1 23:36 编辑 ]\n\n
WinSock网络校时源码,编译完只有36KB

program TimeSync;

uses
   Windows,WinSock;

const
WM_SOCK = 1106;
NTPMaxInt = 4294967296;
NTPFileDiffer = 9435484800;
ConNTP = 10000000;

var
  i : Word;
  FSockAccept : TSockAddrIn;
  AcceptSock : LongWord;
  BuffSnd : array[0..47] of byte;
  BuffRcv : array[0..47] of byte;
  BuffLen : Word;
  Flen : LongInt;
  IDHandle: DWORD;
  TempWSAData: TWSAData;
  SysTime : SYSTEMTIME;
  FilTime : FILETIME;
  Int64Time : Int64;
  FileTimeSe : Int64;
  FileTimeNm : Int64;
  SNTPTimeH : DWORD;
  SNTPTimeL : DWORD;
  TimeInt64H : Int64;
  TimeInt64L : Int64;
  FOriginateTime: Int64;     //T1   客户端请求报文时客户端的时间
  FReceiveTime: Int64;       //T2   服务端收到报文时服务端的时间
  FTransmitTime: Int64;      //T3   服务端发送报文时服务端的时间
  FDestinationTime: Int64;   //T4   客户端收到报文时客户端的时间
  FRoundTripDelay: Int64;    //T5  ((T4 - T1) - (T3 - T2))/2//网络延时
  FTrueTime: Int64;          //T6    =T3+T5 修正过的时间
  HostList : Array [0..5] of AnsiString;
function BuffToWord(FBytes : PTBYTE; FPosition : Word):DWORD;
begin
  Move(FBytes[FPosition],Result,4);
  Result := htonl(Result);
end;

procedure TTestThread();
begin
  Flen := sizeof(FSockAccept);
  BuffLen := recvfrom(AcceptSock, BuffRcv, 48, 0, FSockAccept, Flen);
  if BuffLen = 48 then
  begin
    TimeInt64H := BuffToWord(BuffRcv,24);
    TimeInt64L := BuffToWord(BuffRcv,28);
    FOriginateTime := (TimeInt64H+NTPFileDiffer)*ConNTP + round((TimeInt64L*ConNTP) / NTPMaxInt); //T1
    TimeInt64H := BuffToWord(BuffRcv,32);
    TimeInt64L := BuffToWord(BuffRcv,36);
    FReceiveTime := (TimeInt64H+NTPFileDiffer)*ConNTP + round((TimeInt64L*ConNTP) / NTPMaxInt); //T2
    TimeInt64H := BuffToWord(BuffRcv,40);
    TimeInt64L := BuffToWord(BuffRcv,44);
    FTransmitTime := (TimeInt64H+NTPFileDiffer)*ConNTP + round((TimeInt64L*ConNTP) / NTPMaxInt);//T3
    GetSystemTime(SysTime);
    SystemTimeToFileTime(SysTime,FilTime);
    FDestinationTime := FilTime.dwHighDateTime * NTPMaxInt + FilTime.dwLowDateTime;           //T4
    FRoundTripDelay := round((FDestinationTime-FOriginateTime+FReceiveTime-FTransmitTime)/2);//T5 = ((T4 - T1)-(T3 - T2))/2//网络延时
    FTrueTime := FTransmitTime + FRoundTripDelay;
    FilTime.dwHighDateTime := FTrueTime div NTPMaxInt;
    FilTime.dwLowDateTime  := FTrueTime mod NTPMaxInt;
    FileTimeToSystemTime(FilTime,SysTime);
    SetSystemTime(SysTime);
  end;
  CloseSocket(AcceptSock); //关闭socket
  WSACleanup;
  ExitProcess(0);
end;

{始化SOCKET}
function WinSockInital():Boolean;
begin
  result := false;
  if WSAStartup(2, TempWSAData) = 1 then  //2表示启用winsock2
    exit;
  AcceptSock:=Socket(AF_INET,SOCK_DGRAM,0);//UDP通信
  if AcceptSock = SOCKET_ERROR then
    exit;
  //FD_READ 在读就绪的时候, 产生WM_SOCK 自定义消息号
  WSAAsyncSelect(AcceptSock, 0 , WM_SOCK, FD_READ);
  Result:=true;
end;

{$R *.res}

begin
  if not WinSockInital then    //初始化
    exit;
  FillChar(BuffSnd , 48, $00);
  //FillByte(BuffSnd , 48, $00);//以00填充报文
  BuffSnd[0] := $1B;          //报文头
  HostList[0] := '61.164.36.105';
  HostList[1] := '64.250.229.100';
  HostList[2] := '209.81.9.7';
  HostList[3] := '149.20.64.28';
  HostList[4] := '108.61.73.243';
  FSockAccept.sin_family:=AF_INET;
  FSockAccept.sin_port:= htons(123);
  for i := 0 to 4 do
  begin
    FSockAccept.SIn_Addr.S_addr := inet_addr(PAnsiChar(HostList[i]));
    GetSystemTime(SysTime);
    SystemTimeToFileTime(SysTime,FilTime);
    Int64Time := FilTime.dwHighDateTime*NTPMaxInt + FilTime.dwLowDateTime;
    FileTimeSe := trunc(Int64Time/ConNTP) ;
    FileTimeNm := (Int64Time- FileTimeSe*ConNTP);
    SNTPTimeH := FileTimeSe-NTPFileDiffer;
    SNTPTimeL := trunc((FileTimeNm * NTPMaxInt)/ConNTP);
    SNTPTimeH := htonl(SNTPTimeH);
    SNTPTimeL := htonl(SNTPTimeL);
    Move(SNTPTimeH,BuffSnd[40],4);
    Move(SNTPTimeL,BuffSnd[44],4);
    sendto(AcceptSock, BuffSnd,48, 0, FSockAccept, sizeof(FSockAccept));//发送报文
    if i = 0 then
     CreateThread(nil, 0, @TTestThread, nil, 0, IDHandle);//开启端口监听线程
    Sleep(100);
  end;
  sleep(2000);//延时2秒，超过自动关闭程序
end.            

Rockan

请问楼主，这段代码能用于Wince不？

talince

按道理来说是可以的，估计要稍微修改下。