(从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;interfaceuses 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);beginend;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;
转载于:https://www.cnblogs.com/fishzhm/archive/2011/10/20/2219074.html
