时间同步

(从ntp服务器，获得一个格林威治的时间)然后转化成本地时间，

使用该类，就可以不管本地电脑时间，永远得到真正的时间。InternetDateTime 可以不停的读取，效率很高的（只到服务器取一次）。

const
  ATimeSvr: array[0..10] of record
    Host: String;
    Addr: String;
  end = (
    (Host: 'utcnist.colorado.edu'; Addr: '128.138.140.44';),
    (Host: 'time-a.timefreq.bldrdoc.gov'; Addr: '132.163.4.101';),
    (Host: 'time-b.timefreq.bldrdoc.gov'; Addr: '132.163.4.102';),
    (Host: 'time-c.timefreq.bldrdoc.gov'; Addr: '132.163.4.103';),
    (Host: 'nist1.datum.com'; Addr: '209.0.72.7';),
    (Host: 'time.nist.gov'; Addr: '192.43.244.18';),
    (Host: 'time-a.nist.gov'; Addr: '129.6.15.28';),
    (Host: 'time-b.nist.gov'; Addr: '129.6.15.29';),
    (Host: 'time-nw.nist.gov'; Addr: '131.107.1.10';),
    (Host: 'time.windows.com'; Addr: '207.46.130.100';),
    (Host: 'nist1.nyc.certifiedtime.com'; Addr: '208.184.49.129';)
  );

unit InternetDateTime;

interface

uses
  Windows,  Classes,SysUtils,IdDayTime;
type
  TOnRecvDateTime = procedure (Sender : Tobject ; DateTime : TdateTime ;url : String) of object ;
  TOnGetDateTimeError = procedure  (sender : Tobject ; url : String) of object ;

  TimeSync = class(TThread)
  private
    SysTime: TSystemTime;
    FURLIndex : integer ;
    FOnDataRecv: TThreadMethod ;
    FonDateError : TThreadMethod ;
    FOnRecvDateTime: TOnRecvDateTime;
    FOnGetDateTimeError: TOnGetDateTimeError;
    procedure doFOnDataRecv ;
    procedure DoFOnDateError ;
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;
    property OnRecvDateTime: TOnRecvDateTime  read FOnRecvDateTime write FOnRecvDateTime;
    property OnGetDateTimeError: TOnGetDateTimeError  read FOnGetDateTimeError write FOnGetDateTimeError;
    procedure Stop;
  end;

  TInternetDateTime = class(TComponent)
  private
    Fts : TimeSync ;
    FRecvTime : TdateTime ;
    FrecvTick : Cardinal ;
    function GetdateTime(): TdateTime ;
  protected
    procedure OnRecvDateTime(sender : Tobject ; newTime : TDateTime; url : String); virtual;
    procedure OnGetDateTimeError(sender : Tobject ; url : String) ; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property InternetDateTime : TdateTime  Read GetDateTime ;  //如果还没有成功获取到，则返回系统时间
  end;

implementation

{$I TimeSvrs.inc}
{ TimeSync }
constructor TimeSync.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  FOnDataRecv := doFOnDataRecv ;

end;

destructor TimeSync.Destroy;
begin
  inherited;
end;

procedure TimeSync.doFOnDataRecv();
begin
  if Assigned(FOnRecvDateTime) then
    FOnRecvDateTime(self,SystemTimeToDateTime(SysTime),ATimeSvr[FURLIndex].Host );
end;

procedure TimeSync.DoFOnDateError;
begin
  if Assigned(FOnGetDateTimeError) then
    FOnGetDateTimeError(self,ATimeSvr[FURLIndex].Host );
end;

procedure TimeSync.Execute;
var
  TempIdDayTime : TIdDayTime;
  i ,hBias,mBias :integer ;
  TimeStr : String ;
  tzInfo: Time_Zone_Information;
begin
  inherited;
  GetTimeZoneInformation(tzInfo);   //获取当地时区和格林威治的时间差
  hBias:=tzInfo.Bias div 60;
  mBias:=tzInfo.Bias mod 60;
  TempIdDayTime := TIdDayTime.Create(nil);
  try
    for i := low(ATimeSvr) to high(ATimeSvr) do
    begin
      try
        if Terminated  then exit ;
        TempIdDayTime.Host := ATimeSvr[i].Host;
        TimeStr:=Trim(TempIdDayTime.DayTimeStr);
        if Terminated  then exit ;
        SysTime.wYear:=StrToInt(Copy(TimeStr,7,2));
        SysTime.wMonth:=StrToInt(Copy(TimeStr,10,2));
        SysTime.wDay:=StrToInt(Copy(TimeStr,13,2));
        SysTime.wHour:=StrToInt(Copy(TimeStr,16,2));
        SysTime.wMinute:=StrToInt(Copy(TimeStr,19,2));
        SysTime.wSecond:=StrToInt(Copy(TimeStr,22,2));
        SysTime.wMilliseconds:=StrToInt(Copy(TimeStr,32,3));
        SysTime.wYear:=SysTime.wYear+2000;   //对获取的时间进行修正
        SysTime.wHour:=SysTime.wHour-hBias;
        SysTime.wMinute:=SysTime.wMinute-mBias;
        if Assigned( FOnDataRecv) then
        begin
          FURLIndex := i ;
          Synchronize(FOnDataRecv);
        end;
        break ;
      except
        if Assigned( FonDateError) then
        begin
          FURLIndex := i ;
          Synchronize(FonDateError);
        end;
      end;
    end;
  finally
    TempIdDayTime.Free ;
  end;

end;


procedure TimeSync.Stop;
begin
  WaitFor ;
end;

{ TInternetDateTime }

constructor TInternetDateTime.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FrecvTick := GetTickCount ;
  FRecvTime := Now ;

  Fts := TimeSync.Create(true) ;
  Fts.OnRecvDateTime := OnRecvDateTime ;
  Fts.OnGetDateTimeError := OnGetDateTimeError ;
  Fts.Start ;
end;

destructor TInternetDateTime.Destroy;
begin
  Fts.Terminate ;
  fts.Stop ;
  fts.Free ;
  inherited;
end;

function TInternetDateTime.GetdateTime: TdateTime;
begin
  Result := FRecvTime + (GetTickCount -  FrecvTick) / 1000 /60 /60 /24 ;
end;

procedure TInternetDateTime.OnGetDateTimeError(sender: Tobject; url: String);
begin

end;

procedure TInternetDateTime.OnRecvDateTime(sender: Tobject; newTime: TDateTime; url : String);
begin
  FrecvTick := GetTickCount ;
  FRecvTime := newTime ;
end;

end.

使用方法：

procedure TMainFrm.Button2Click(Sender: TObject);
var
  s : string ;
begin
  s := FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',Itt.InternetDateTime) ;
  Memo1.Lines.Add(format('本机时间%s,真正时间%s',[FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',now),s])) ;
end;

procedure TMainFrm.FormCreate(Sender: TObject);
begin
  itt := TInternetDateTime.Create(self);
end;

procedure TMainFrm.FormDestroy(Sender: TObject);
begin
  if  Assigned (Itt) then
    FreeAndNil( itt) ;
end;