Replace obsolete/broken lcoregtklaz with new lcorelazarus

[lcore.git] / btime.pas

diff --git a/btime.pas b/btime.pas
index e0b0c4bde6059feade1a457b8da0523a6d9b83c5..8218e6415a97bf63f25a278f6c75ceb0ad95280c 100644 (file)
--- a/btime.pas
+++ b/btime.pas
@@ -9,10 +9,12 @@ works on windows/delphi, and on freepascal on unix.
 \r
 \r
 unit btime;\r
-\r
+{$ifdef fpc}\r
+  {$mode delphi}\r
+{$endif}\r
 interface\r
 \r
-{$ifdef win32}\r
+{$ifdef mswindows}\r
 uses\r
   ltimevalstuff;\r
 {$endif}  \r
@@ -50,10 +52,12 @@ procedure gettimezone;
 procedure timehandler;\r
 procedure init;\r
 \r
-function timestring(i:tunixtimeint):string;\r
-function timestrshort(i:tunixtimeint):string;\r
+function timestring(i:tunixtimeint):string;      // Wednesday August 15 2012 -- 16:21:09 +02:00\r
+function timestrshort(i:tunixtimeint):string;    // Wed Aug 15 16:21:09 2012\r
+function timestriso(i:tunixtimeint):string;      // 2012-08-15 16:21:09\r
+function timestrisoutc(i:float):string;          // 2012-08-15T14:21:09.255553Z\r
 \r
-{$ifdef win32}\r
+{$ifdef mswindows}\r
 function unixtimefloat_systemtime:float;\r
 {$endif}\r
 \r
@@ -61,12 +65,12 @@ function oletounixfloat(t:float):float;
 function oletounix(t:tdatetime):tunixtimeint;\r
 function unixtoole(i:float):tdatetime;\r
 \r
-{$ifdef win32}\r
+{$ifdef mswindows}\r
 function mmtimefloat:float;\r
 function qpctimefloat:float;\r
 {$endif}\r
 \r
-{$ifdef win32}\r
+{$ifdef mswindows}\r
 procedure gettimeofday(var tv:ttimeval);\r
 {$endif}\r
 \r
@@ -103,9 +107,7 @@ var
 \r
 implementation\r
 \r
-{$ifdef fpc}\r
-  {$mode delphi}\r
-{$endif}\r
+\r
 \r
 uses\r
   {$ifdef UNIX}\r
@@ -136,7 +138,7 @@ end;
 \r
 function oletounix(t:tdatetime):tunixtimeint;\r
 begin\r
-  result := trunc(oletounixfloat(t));\r
+  result := round(oletounixfloat(t));\r
 end;\r
 \r
 function unixtoole(i:float):tdatetime;\r
@@ -492,7 +494,7 @@ begin
   mmtime_lastresult := result;\r
 end;\r
 \r
-{ free pascals tsystemtime is incomaptible with windows api calls\r
+{ free pascals tsystemtime is incompatible with windows api calls\r
  so we declare it ourselves - plugwash\r
 }\r
 {$ifdef fpc}\r
@@ -551,12 +553,51 @@ begin
   result := mmqpctimefloat;\r
 end;\r
 \r
+\r
+\r
+var\r
+  GetSystemTimePreciseAsFileTime:procedure(var v:tfiletime); stdcall;\r
+  win8inited:boolean;\r
+\r
+procedure initwin8;\r
+var\r
+  dllhandle:thandle;\r
+\r
+begin\r
+  win8inited := true;\r
+  dllhandle := loadlibrary('kernel32.dll');\r
+  if (dllhandle <> 0) then begin\r
+    GetSystemTimePreciseAsFileTime := getprocaddress(dllhandle,'GetSystemTimePreciseAsFileTime');\r
+  end;\r
+end;\r
+\r
+\r
+function unixtimefloat_win8:float;\r
+var\r
+  ft:tfiletime;\r
+  i:int64 absolute ft;\r
+begin\r
+  GetSystemTimePreciseAsFileTime(ft);\r
+  {change from windows 1601-01-01 to unix 1970-01-01.\r
+  use integer math for this, to preserve precision}\r
+  dec(i, 116444736000000000);\r
+  result := (i / 10000000);\r
+end;\r
+\r
+\r
+\r
 function unixtimefloat:float;\r
 const\r
   margin = 0.0012;\r
 var\r
   f,g,h:float;\r
 begin\r
+  if not win8inited then initwin8;\r
+  if assigned(@GetSystemTimePreciseAsFileTime) then begin\r
+    result := unixtimefloat_win8;\r
+    exit;\r
+  end;\r
+\r
   result := monotimefloat+timefloatbias;\r
   f := result-unixtimefloat_systemtime;\r
   if ((f > ticks_freq2+margin) or (f < -margin)) or (timefloatbias = 0) then begin\r
@@ -688,9 +729,43 @@ begin
   timezonestr;\r
 end;\r
 \r
+function timestriso(i:tunixtimeint):string;\r
+var\r
+  y,m,d,h,min,sec,ms:word;\r
+  t:tdatetime;\r
+begin\r
+  t := unixtoole(i+timezone);\r
+  decodedate(t,y,m,d);\r
+  decodetime(t,h,min,sec,ms);\r
+  result := inttostr(y)+'-'+inttostr(m div 10)+inttostr(m mod 10)+'-'+inttostr(d div 10)+inttostr(d mod 10)+' '+inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10);\r
+end;\r
+\r
+function timestrisoutc(i:float):string;\r
+var\r
+  y,m,d,h,min,sec,ms:word;\r
+  t:tdatetime;\r
+  fr:float;\r
+begin\r
+  t := unixtoole(i);\r
+  decodedate(t,y,m,d);\r
+  decodetime(t,h,min,sec,ms);\r
+  result := inttostr(y)+'-'+inttostr(m div 10)+inttostr(m mod 10)+'-'+inttostr(d div 10)+inttostr(d mod 10)+'T'+inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10);\r
+  fr := frac(i);\r
+\r
+  result := result + '.'+\r
+  inttostr(trunc(fr*10) mod 10)+\r
+  inttostr(trunc(fr*100) mod 10)+\r
+  inttostr(trunc(fr*1000) mod 10)+\r
+  inttostr(trunc(fr*10000) mod 10)+\r
+  inttostr(trunc(fr*100000) mod 10)+\r
+  inttostr(trunc(fr*1000000) mod 10)+'Z';\r
+\r
+end;\r
+\r
+\r
 procedure init;\r
 begin\r
-  {$ifdef win32}timebeginperiod(1);{$endif} //ensure stable unchanging clock\r
+  {$ifdef mswindows}timebeginperiod(1);{$endif} //ensure stable unchanging clock\r
   fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0);\r
   settimebias := 0;\r
   gettimezone;\r