unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer,
  StdCtrls, IdContext, ComCtrls;

type
  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Memo2: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    DateTimePicker1: TDateTimePicker;
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Execute(AContext: TIdContext);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses IdSchedulerOfThread;



{$R *.dfm}

const maxint2 = 4294967296.0;

function tzbias : double; // 获取本地时间区与UTC时间偏差;
var
  tz : TTimeZoneInformation;
begin
  GetTimeZoneInformation(tz);
  result := tz.Bias / 1440;
end;

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;



procedure TForm1.Button1Click(Sender: TObject);
begin
  IdTCPServer1.Active := True;

  DateTimePicker1.Enabled:=False;
  button2.Enabled:= True;
  button1.Enabled:= False;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  //IdTCPServer1.Active := false;
  if IdTCPServer1.Active then
     IdTCPServer1.Active := false;

  DateTimePicker1.Enabled:=True;
  button2.Enabled:= false;
  button1.Enabled:= true;

end;

procedure TForm1.FormShow(Sender: TObject);
begin
  DateTimePicker1.Enabled:=True;
  button2.Enabled:= false;
  button1.Enabled:= true;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
   cmd : string;
   car : Cardinal;
begin
  //ShowMessage('on conncet');
  //car := AContext.Connection.IOHandler.ReadCardinal(True);
  //Memo1.Lines.Add(FloatToStr(car));
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
  var sCommand: string;
      peerIP:string;
      peerport:word;
      threadid:integer;
      car: Cardinal;
      setteddate : TDateTime;
      sec , frac : LongInt;
begin
  Memo1.Lines.Add('检测到请求');
  {
  with AContext.Connection do begin
    //sCommand := IOHandler.ReadChar;
    //memo1.Lines.Add(sCommand);
    //WriteCardinal(Trunc(extended(Now + IdGlobal.TimeZoneBias - Int(FBaseDate)) * 24 * 60 * 60));
     peerIP := AContext.Binding.PeerIP;
     peerport := AContext.Binding.PeerPort;
     threadid := TIdYarnOfThread(AContext.Yarn).Thread.ThreadID;
     car := AContext.Connection.IOHandler.ReadCardinal(True);
     Memo1.Lines.Add('客户端IP为:' + peerIP);
     //AContext.Connection.Disconnect;
  end;
  }
  setteddate := DateTimePicker1.DateTime;
  dt2ntp(setteddate , sec , frac);
  Memo1.Lines.Add('计算出来的sec为:' + FloatToStr(sec));
  Memo1.Lines.Add('计算出来的frac为:' + FloatToStr(frac));
  Memo1.Lines.Add('正在发送时间.......');
  AContext.Connection.IOHandler.Write(sec);
  AContext.Connection.Disconnect;
  Memo1.Lines.Add('发送完成，断开连接');
end;

end.