X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/b3b93191002f92b19c069b9815a8261d6edbc5ec..51075d051580863ca073aa91883357410b358e40:/btime.pas?ds=sidebyside diff --git a/btime.pas b/btime.pas index 2a4b267..ff77de9 100644 --- a/btime.pas +++ b/btime.pas @@ -12,7 +12,7 @@ unit btime; interface -{$ifdef win32} +{$ifdef mswindows} uses ltimevalstuff; {$endif} @@ -55,7 +55,7 @@ function timestrshort(i:tunixtimeint):string; // Wed Aug 15 16:21:09 2012 function timestriso(i:tunixtimeint):string; // 2012-08-15 16:21:09 function timestrisoutc(i:float):string; // 2012-08-15T14:21:09.255553Z -{$ifdef win32} +{$ifdef mswindows} function unixtimefloat_systemtime:float; {$endif} @@ -63,12 +63,12 @@ function oletounixfloat(t:float):float; function oletounix(t:tdatetime):tunixtimeint; function unixtoole(i:float):tdatetime; -{$ifdef win32} +{$ifdef mswindows} function mmtimefloat:float; function qpctimefloat:float; {$endif} -{$ifdef win32} +{$ifdef mswindows} procedure gettimeofday(var tv:ttimeval); {$endif} @@ -138,7 +138,7 @@ end; function oletounix(t:tdatetime):tunixtimeint; begin - result := trunc(oletounixfloat(t)); + result := round(oletounixfloat(t)); end; function unixtoole(i:float):tdatetime; @@ -494,7 +494,7 @@ begin mmtime_lastresult := result; end; -{ free pascals tsystemtime is incomaptible with windows api calls +{ free pascals tsystemtime is incompatible with windows api calls so we declare it ourselves - plugwash } {$ifdef fpc} @@ -553,12 +553,51 @@ begin result := mmqpctimefloat; end; + + +var + GetSystemTimePreciseAsFileTime:procedure(var v:tfiletime); stdcall; + win8inited:boolean; + +procedure initwin8; +var + dllhandle:thandle; + +begin + win8inited := true; + dllhandle := loadlibrary('kernel32.dll'); + if (dllhandle <> 0) then begin + GetSystemTimePreciseAsFileTime := getprocaddress(dllhandle,'GetSystemTimePreciseAsFileTime'); + end; +end; + + +function unixtimefloat_win8:float; +var + ft:tfiletime; + i:int64 absolute ft; +begin + GetSystemTimePreciseAsFileTime(ft); + {change from windows 1601-01-01 to unix 1970-01-01. + use integer math for this, to preserve precision} + dec(i, 116444736000000000); + result := (i / 10000000); +end; + + + function unixtimefloat:float; const margin = 0.0012; var f,g,h:float; begin + if not win8inited then initwin8; + if assigned(@GetSystemTimePreciseAsFileTime) then begin + result := unixtimefloat_win8; + exit; + end; + result := monotimefloat+timefloatbias; f := result-unixtimefloat_systemtime; if ((f > ticks_freq2+margin) or (f < -margin)) or (timefloatbias = 0) then begin @@ -726,7 +765,7 @@ end; procedure init; begin - {$ifdef win32}timebeginperiod(1);{$endif} //ensure stable unchanging clock + {$ifdef mswindows}timebeginperiod(1);{$endif} //ensure stable unchanging clock fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0); settimebias := 0; gettimezone;