btime.pas

   1 { Copyright (C) 2005 Bas Steendijk and Peter Green\r
   2   For conditions of distribution and use, see copyright notice in zlib_license.txt\r
   3   which is included in the package\r
   4   ----------------------------------------------------------------------------- }\r
   5 {\r
   6 this unit returns unix timestamp with seconds and microseconds (as float)\r
   7 works on windows/delphi, and on freepascal on unix.\r
   8 }\r
   9 \r
  10 \r
  11 unit btime;\r
  12 \r
  13 interface\r
  14 \r
  15 {$ifdef mswindows}\r
  16 uses\r
  17   ltimevalstuff;\r
  18 {$endif}  \r
  19 \r
  20 type\r
  21   float=extended;\r
  22   tunixtimeint={$ifdef ver100}longint;{$else}int64;{$endif}\r
  23 \r
  24 const\r
  25   colorburst=39375000/11;  {3579545.4545....}\r
  26 \r
  27 var\r
  28   timezone:integer;\r
  29   timezonestr:string;\r
  30   irctime,unixtime:tunixtimeint;\r
  31   tickcount:integer;\r
  32   settimebias:tunixtimeint;\r
  33   performancecountfreq:extended;\r
  34 \r
  35 function irctimefloat:float;\r
  36 function irctimeint:tunixtimeint;\r
  37 \r
  38 //unix timestamp (UTC) float seconds\r
  39 function unixtimefloat:float;\r
  40 function unixtimeint:tunixtimeint;\r
  41 \r
  42 //monotonic float seconds\r
  43 function monotimefloat:float;\r
  44 \r
  45 //monotonic (alias, old function name)\r
  46 function wintimefloat:float;\r
  47 \r
  48 procedure settime(newtime:tunixtimeint);\r
  49 procedure gettimezone;\r
  50 procedure timehandler;\r
  51 procedure init;\r
  52 \r
  53 function timestring(i:tunixtimeint):string;      // Wednesday August 15 2012 -- 16:21:09 +02:00\r
  54 function timestrshort(i:tunixtimeint):string;    // Wed Aug 15 16:21:09 2012\r
  55 function timestriso(i:tunixtimeint):string;      // 2012-08-15 16:21:09\r
  56 function timestrisoutc(i:float):string;          // 2012-08-15T14:21:09.255553Z\r
  57 \r
  58 {$ifdef mswindows}\r
  59 function unixtimefloat_systemtime:float;\r
  60 {$endif}\r
  61 \r
  62 function oletounixfloat(t:float):float;\r
  63 function oletounix(t:tdatetime):tunixtimeint;\r
  64 function unixtoole(i:float):tdatetime;\r
  65 \r
  66 {$ifdef mswindows}\r
  67 function mmtimefloat:float;\r
  68 function qpctimefloat:float;\r
  69 {$endif}\r
  70 \r
  71 {$ifdef mswindows}\r
  72 procedure gettimeofday(var tv:ttimeval);\r
  73 {$endif}\r
  74 \r
  75 \r
  76 const\r
  77   mmtime_driftavgsize=32;\r
  78   mmtime_warmupnum=4;\r
  79   mmtime_warmupcyclelength=15;\r
  80 var\r
  81   //this flag is to be set when btime has been running long enough to stabilise\r
  82   warmup_finished:boolean;\r
  83 \r
  84   timefloatbias:float;\r
  85   ticks_freq:float=0;\r
  86   ticks_freq2:float=0;\r
  87   ticks_freq_known:boolean=false;\r
  88   lastunixtimefloat:float=0;\r
  89   lastsynctime:float=0;\r
  90   lastsyncbias:float=0;\r
  91 \r
  92   mmtime_last:integer=0;\r
  93   mmtime_wrapadd:float;\r
  94   mmtime_lastsyncmm:float=0;\r
  95   mmtime_lastsyncqpc:float=0;\r
  96   mmtime_drift:float=1;\r
  97   mmtime_lastresult:float;\r
  98   mmtime_nextdriftcorrection:float;\r
  99   mmtime_driftavg:array[0..mmtime_driftavgsize] of float;\r
 100   mmtime_synchedqpc:boolean;\r
 101 \r
 102   mmtime_prev_drift:float;\r
 103   mmtime_prev_lastsyncmm:float;\r
 104   mmtime_prev_lastsyncqpc:float;\r
 105 \r
 106 implementation\r
 107 \r
 108 {$ifdef fpc}\r
 109   {$mode delphi}\r
 110 {$endif}\r
 111 \r
 112 uses\r
 113   {$ifdef UNIX}\r
 114     {$ifdef VER1_0}\r
 115       linux,\r
 116     {$else}\r
 117       baseunix,unix,unixutil,sockets, {unixutil and sockets needed by unixstuff.inc on some compiler versions}\r
 118     {$endif}\r
 119     {$ifdef linux}\r
 120       dl,\r
 121     {$endif}\r
 122   {$else}\r
 123     windows,unitsettc,mmsystem,\r
 124   {$endif}\r
 125   sysutils;\r
 126 \r
 127   {$include unixstuff.inc}\r
 128 \r
 129 \r
 130 const\r
 131   daysdifference=25569;\r
 132 \r
 133 function oletounixfloat(t:float):float;\r
 134 begin\r
 135   t := (t - daysdifference) * 86400;\r
 136   result := t;\r
 137 end;\r
 138 \r
 139 function oletounix(t:tdatetime):tunixtimeint;\r
 140 begin\r
 141   result := trunc(oletounixfloat(t));\r
 142 end;\r
 143 \r
 144 function unixtoole(i:float):tdatetime;\r
 145 begin\r
 146   result := ((i)/86400)+daysdifference;\r
 147 end;\r
 148 \r
 149 const\r
 150   highdwordconst=65536.0 * 65536.0;\r
 151 \r
 152 function utrunc(f:float):integer;\r
 153 {converts float to integer, in 32 bits unsigned range}\r
 154 begin\r
 155   if f >= (highdwordconst/2) then f := f - highdwordconst;\r
 156   result := trunc(f);\r
 157 end;\r
 158 \r
 159 function uinttofloat(i:integer):float;\r
 160 {converts 32 bits unsigned integer to float}\r
 161 begin\r
 162   result := i;\r
 163   if result < 0 then result := result + highdwordconst;\r
 164 end;\r
 165 \r
 166 {$ifdef unix}\r
 167 {-----------------------------------------*nix/freepascal code to read time }\r
 168 \r
 169 function unixtimefloat:float;\r
 170 var\r
 171   tv:ttimeval;\r
 172 begin\r
 173   gettimeofday(tv);\r
 174   result := tv.tv_sec+(tv.tv_usec/1000000);\r
 175 end;\r
 176 \r
 177 {$ifdef linux}\r
 178   {$define monotimefloat_implemented}\r
 179   const\r
 180     CLOCK_MONOTONIC = 1;\r
 181   type \r
 182     ptimeval = ^ttimeval;\r
 183     tclock_gettime = function(clk_id: integer; tp: ptimeval): integer; cdecl;\r
 184 \r
 185   var\r
 186     librt_handle:pointer;\r
 187     librt_inited:boolean;\r
 188     clock_gettime: tclock_gettime;\r
 189 \r
 190   function monotimefloat:float;\r
 191   var\r
 192     ts: ttimeval;\r
 193   begin\r
 194     if not librt_inited then begin\r
 195       librt_inited := true;\r
 196       clock_gettime := nil;\r
 197       librt_handle := dlopen('librt.so', RTLD_LAZY);\r
 198       if assigned(librt_handle) then begin\r
 199         clock_gettime := dlsym(librt_handle, 'clock_gettime');\r
 200       end;\r
 201     end;\r
 202     if assigned(clock_gettime) then begin\r
 203       if clock_gettime(CLOCK_MONOTONIC, @ts) = 0 then begin\r
 204         //note this really returns nanoseconds\r
 205         result := ts.tv_sec + ts.tv_usec / 1000000000.0;\r
 206         exit;\r
 207       end;\r
 208     end;\r
 209     //fallback\r
 210     result := unixtimefloat;\r
 211   end;\r
 212 \r
 213 \r
 214 {$endif} {linux}\r
 215 \r
 216 {$ifdef darwin} {mac OS X}\r
 217 {$define monotimefloat_implemented}\r
 218 \r
 219   type\r
 220     tmach_timebase_info = packed record\r
 221       numer: longint;\r
 222       denom: longint;\r
 223     end;\r
 224     pmach_timebase_info = ^tmach_timebase_info;\r
 225      \r
 226     function mach_absolute_time: int64; cdecl; external;\r
 227     function mach_timebase_info(info: pmach_timebase_info): integer; cdecl; external;\r
 228 \r
 229   var\r
 230     timebase_info: tmach_timebase_info;\r
 231 \r
 232   function monotimefloat:float;\r
 233   var\r
 234     i:int64;\r
 235   begin\r
 236     if timebase_info.denom = 0 then begin\r
 237       mach_timebase_info(@timebase_info);\r
 238     end;\r
 239     i := mach_absolute_time;\r
 240     result := (i * timebase_info.numer div timebase_info.denom) / 1000000000.0;\r
 241   end;\r
 242 \r
 243 {$endif} {darwin, mac OS X}\r
 244 \r
 245 \r
 246 {$ifndef monotimefloat_implemented} {fallback}\r
 247   \r
 248   function monotimefloat:extended;\r
 249   begin\r
 250     result := unixtimefloat;\r
 251   end;\r
 252 \r
 253 {$endif} {monotimefloat fallback}\r
 254 \r
 255 \r
 256 function unixtimeint:tunixtimeint;\r
 257 var\r
 258   tv:ttimeval;\r
 259 begin\r
 260   gettimeofday(tv);\r
 261   result := tv.tv_sec;\r
 262 end;\r
 263 \r
 264 {------------------------------ end of *nix/freepascal section}\r
 265 \r
 266 {$else} {delphi 3}\r
 267 {------------------------------ windows/delphi code to read time}\r
 268 \r
 269 \r
 270 {simulate gettimeofday on windows so one can always use gettimeofday if preferred}\r
 271 \r
 272 procedure gettimeofday(var tv:ttimeval);\r
 273 var\r
 274   e:extended;\r
 275 begin\r
 276   e := unixtimefloat;\r
 277   tv.tv_sec := round(int(e));\r
 278   tv.tv_usec := trunc(frac(e)*1000000);\r
 279   {just in case}\r
 280   if (tv.tv_usec < 0) then tv.tv_usec := 0;\r
 281   if (tv.tv_usec > 999999) then tv.tv_usec := 999999;\r
 282 end;\r
 283 \r
 284 \r
 285 {\r
 286 time float: gettickcount\r
 287 resolution: 9x: ~55 ms NT: 1/64th of a second\r
 288 guarantees: continuous without any jumps\r
 289 frequency base: same as system clock.\r
 290 epoch: system boot\r
 291 note: if called more than once per 49.7 days, 32 bits wrapping is compensated for and it keeps going on.\r
 292 note: i handle the timestamp as signed integer, but with the wrap compensation that works as well, and is faster\r
 293 }\r
 294 \r
 295 function mmtimefloat:float;\r
 296 const\r
 297   wrapduration=highdwordconst * 0.001;\r
 298 var\r
 299   i:integer;\r
 300   temp:float;\r
 301 begin\r
 302   i := gettickcount; {timegettime}\r
 303   if i < mmtime_last then begin\r
 304     mmtime_wrapadd := mmtime_wrapadd + wrapduration;\r
 305   end;\r
 306   mmtime_last := i;\r
 307   result := mmtime_wrapadd + i * 0.001;\r
 308 \r
 309   if (ticks_freq <> 0) and ticks_freq_known then begin\r
 310     {the value we get is rounded to 1 ms, but the ticks are not a multiple of 1 ms\r
 311     this makes the value noisy. use the known ticks frequency to restore the original value}\r
 312     temp := int((result / ticks_freq)+0.5) * ticks_freq;\r
 313 \r
 314     {if the known ticks freq is wrong (can happen), disable the un-rounding behavior\r
 315     this will be a bit less accurate but it prevents problems}\r
 316     if abs(temp - result) > 0.002 then begin\r
 317       ticks_freq := 0;\r
 318     end else result := temp;\r
 319   end;\r
 320 end;\r
 321 \r
 322 procedure measure_ticks_freq;\r
 323 var\r
 324   f,g:float;\r
 325   o:tosversioninfo;\r
 326   isnt:boolean;\r
 327 {  is9x:boolean;}\r
 328   adjust1,adjust2:cardinal;\r
 329   adjustbool:longbool;\r
 330 begin\r
 331   if (performancecountfreq = 0) then qpctimefloat;\r
 332   ticks_freq_known := false;\r
 333   settc;\r
 334   f := mmtimefloat;\r
 335   repeat g := mmtimefloat until g > f;\r
 336   unsettc;\r
 337   f := g - f;\r
 338   fillchar(o,sizeof(o),0);\r
 339   o.dwOSVersionInfoSize := sizeof(o);\r
 340   getversionex(o);\r
 341   isnt := o.dwPlatformId = VER_PLATFORM_WIN32_NT;\r
 342 {  is9x := o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS;}\r
 343 \r
 344   ticks_freq2 := f;\r
 345   mmtime_synchedqpc := false;\r
 346 \r
 347   if (isnt and (o.dwMajorVersion >= 5)) then begin\r
 348     {windows 2000 and later: query tick rate from OS in 100 ns units\r
 349     typical rates: XP: 156250 or 100144, windows 7: 156001}\r
 350     if GetSystemTimeAdjustment(adjust1,adjust2,adjustbool) then begin\r
 351       ticks_freq := adjust1 / 10000000.0;\r
 352       ticks_freq_known := true;\r
 353       mmtime_synchedqpc := false;\r
 354     end;\r
 355   end;\r
 356 \r
 357   {9x}\r
 358   if (performancecountfreq = 1193182) and (f >= 0.050) and (f <= 0.060) then begin\r
 359     ticks_freq_known := true;\r
 360     ticks_freq := 65536 / (colorburst / 3);\r
 361     mmtime_synchedqpc := true;\r
 362   end;\r
 363   ticks_freq_known := true;\r
 364   if ticks_freq <> 0 then ticks_freq2 := ticks_freq;\r
 365 //  writeln(formatfloat('0.000000',ticks_freq));\r
 366 end;\r
 367 \r
 368 {\r
 369 time float: QueryPerformanceCounter\r
 370 resolution: <1us\r
 371 guarantees: can have forward jumps depending on hardware. can have forward and backwards jitter on dual core.\r
 372 frequency base: on NT, not the system clock, drifts compared to it.\r
 373 epoch: system boot\r
 374 }\r
 375 function qpctimefloat:extended;\r
 376 var\r
 377   p:packed record\r
 378     lowpart:longint;\r
 379     highpart:longint\r
 380   end;\r
 381   p2:tlargeinteger absolute p;\r
 382   e:extended;\r
 383 begin\r
 384   if performancecountfreq = 0 then begin\r
 385     QueryPerformancefrequency(p2);\r
 386     e := p.lowpart;\r
 387     if e < 0 then e := e + highdwordconst;\r
 388     performancecountfreq := ((p.highpart*highdwordconst)+e);\r
 389   end;\r
 390   queryperformancecounter(p2);\r
 391   e := p.lowpart;\r
 392   if e < 0 then e := e + highdwordconst;\r
 393 \r
 394   result := ((p.highpart*highdwordconst)+e)/performancecountfreq;\r
 395 end;\r
 396 \r
 397 {\r
 398 time float: QPC locked to gettickcount\r
 399 resolution: <1us\r
 400 guarantees: continuous without any jumps\r
 401 frequency base: same as system clock.\r
 402 epoch: system boot\r
 403 }\r
 404 \r
 405 function mmqpctimefloat:float;\r
 406 const\r
 407   maxretries=5;\r
 408   margin=0.002;\r
 409 var\r
 410 {  jump:float;}\r
 411   mm,f,qpc,newdrift:float;\r
 412   qpcjumped:boolean;\r
 413   a,b:integer;\r
 414 {  retrycount:integer;}\r
 415 begin\r
 416   if not ticks_freq_known then measure_ticks_freq;\r
 417 {  retrycount := maxretries;}\r
 418 \r
 419   qpc := qpctimefloat;\r
 420   mm := mmtimefloat;\r
 421   f := (qpc - mmtime_lastsyncqpc) * mmtime_drift + mmtime_lastsyncmm;\r
 422   //writeln('XXXX ',formatfloat('0.000000',qpc-mm));\r
 423   qpcjumped := ((f-mm) > ticks_freq2+margin) or ((f-mm) < -margin);\r
 424 //  if qpcjumped then writeln('qpc jumped ',(f-mm));\r
 425   if ((qpc > mmtime_nextdriftcorrection) and not mmtime_synchedqpc) or qpcjumped then begin\r
 426 \r
 427     mmtime_nextdriftcorrection := qpc + 1;\r
 428     repeat\r
 429       mmtime_prev_drift := mmtime_drift;\r
 430       mmtime_prev_lastsyncmm := mmtime_lastsyncmm;\r
 431       mmtime_prev_lastsyncqpc := mmtime_lastsyncqpc;\r
 432 \r
 433       mm := mmtimefloat;\r
 434     {  dec(retrycount);}\r
 435       settc;\r
 436       result := qpctimefloat;\r
 437       f := mmtimefloat;\r
 438       repeat\r
 439         if f = mm then result := qpctimefloat;\r
 440         f := mmtimefloat\r
 441       until f > mm;\r
 442       qpc := qpctimefloat;\r
 443 \r
 444       unsettc;\r
 445       if (qpc > result + 0.0001) then begin\r
 446         continue;\r
 447       end;\r
 448       mm := f;\r
 449 \r
 450       if (mmtime_lastsyncqpc <> 0) and not qpcjumped then begin\r
 451         newdrift := (mm - mmtime_lastsyncmm) / (qpc - mmtime_lastsyncqpc);\r
 452         mmtime_drift := newdrift;\r
 453      {   writeln('raw drift: ',formatfloat('0.00000000',mmtime_drift));}\r
 454         move(mmtime_driftavg[0],mmtime_driftavg[1],sizeof(mmtime_driftavg[0])*high(mmtime_driftavg));\r
 455         mmtime_driftavg[0] := mmtime_drift;\r
 456 \r
 457 {        write('averaging drift ',formatfloat('0.00000000',mmtime_drift),' -> ');}\r
 458 {        mmtime_drift := 0;}\r
 459         b := 0;\r
 460         for a := 0 to high(mmtime_driftavg) do begin\r
 461           if mmtime_driftavg[a] <> 0 then inc(b);\r
 462 {          mmtime_drift := mmtime_drift + mmtime_driftavg[a];}\r
 463         end;\r
 464 {        mmtime_drift := mmtime_drift / b;}\r
 465         a := 5;\r
 466         if (b = 1) then a := 5 else if (b = 2) then a := 15 else if (b = 3) then a := 30 else if (b = 4) then a := 60 else if (b = 5) then a := 120 else if (b >= 5) then a := 120;\r
 467         mmtime_nextdriftcorrection := qpc + a;\r
 468         if (b >= 2) then warmup_finished := true;\r
 469 {        writeln(formatfloat('0.00000000',mmtime_drift));}\r
 470        if mmtime_synchedqpc then mmtime_drift := 1;\r
 471       end;\r
 472 \r
 473       mmtime_lastsyncqpc := qpc;\r
 474       mmtime_lastsyncmm := mm;\r
 475   {   writeln(formatfloat('0.00000000',mmtime_drift));}\r
 476       break;\r
 477     until false;\r
 478 \r
 479 \r
 480     qpc := qpctimefloat;\r
 481 \r
 482     result := (qpc - mmtime_lastsyncqpc) * mmtime_drift + mmtime_lastsyncmm;\r
 483 \r
 484     {f := (qpc - mmtime_prev_lastsyncqpc) * mmtime_prev_drift + mmtime_prev_lastsyncmm;\r
 485     jump := result-f;\r
 486     writeln('jump ',formatfloat('0.000000',jump),'   drift ',formatfloat('0.00000000',mmtime_drift),' duration ',formatfloat('0.000',(mmtime_lastsyncqpc-mmtime_prev_lastsyncqpc)),' ',formatfloat('0.00000000',jump/(mmtime_lastsyncqpc-mmtime_prev_lastsyncqpc)));}\r
 487 \r
 488     f := result;\r
 489   end;\r
 490 \r
 491   result := f;\r
 492 \r
 493   if (result < mmtime_lastresult) then result := mmtime_lastresult;\r
 494   mmtime_lastresult := result;\r
 495 end;\r
 496 \r
 497 { free pascals tsystemtime is incompatible with windows api calls\r
 498  so we declare it ourselves - plugwash\r
 499 }\r
 500 {$ifdef fpc}\r
 501 type\r
 502   TSystemTime = record\r
 503      wYear: Word;\r
 504      wMonth: Word;\r
 505      wDayOfWeek: Word;\r
 506      wDay: Word;\r
 507      wHour: Word;\r
 508      wMinute: Word;\r
 509      wSecond: Word;\r
 510      wMilliseconds: Word;\r
 511   end;\r
 512  {$endif}\r
 513 function Date_utc: extended;\r
 514 var\r
 515   SystemTime: TSystemTime;\r
 516 begin\r
 517   {$ifdef fpc}\r
 518     GetsystemTime(@SystemTime);\r
 519   {$else}\r
 520     GetsystemTime(SystemTime);\r
 521   {$endif}\r
 522   with SystemTime do Result := EncodeDate(wYear, wMonth, wDay);\r
 523 end;\r
 524 \r
 525 function Time_utc: extended;\r
 526 var\r
 527   SystemTime: TSystemTime;\r
 528 begin\r
 529   {$ifdef fpc}\r
 530     GetsystemTime(@SystemTime);\r
 531   {$else}\r
 532     GetsystemTime(SystemTime);\r
 533   {$endif}\r
 534   with SystemTime do\r
 535     Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);\r
 536 end;\r
 537 \r
 538 function Now_utc: extended;\r
 539 begin\r
 540   Result := round(Date_utc) + Time_utc;\r
 541 end;\r
 542 \r
 543 function unixtimefloat_systemtime:float;\r
 544 begin\r
 545   {result := oletounixfloat(now_utc);}\r
 546 \r
 547   {this method gives exactly the same result with extended precision, but is less sensitive to float rounding in theory}\r
 548   result := oletounixfloat(int(date_utc+0.5))+time_utc*86400;\r
 549 end;\r
 550 \r
 551 function monotimefloat:extended;\r
 552 begin\r
 553   result := mmqpctimefloat;\r
 554 end;\r
 555 \r
 556 \r
 557 \r
 558 var\r
 559   GetSystemTimePreciseAsFileTime:procedure(var v:tfiletime); stdcall;\r
 560   win8inited:boolean;\r
 561 \r
 562 procedure initwin8;\r
 563 var\r
 564   dllhandle:thandle;\r
 565 \r
 566 begin\r
 567   win8inited := true;\r
 568   dllhandle := loadlibrary('kernel32.dll');\r
 569   if (dllhandle <> 0) then begin\r
 570     GetSystemTimePreciseAsFileTime := getprocaddress(dllhandle,'GetSystemTimePreciseAsFileTime');\r
 571   end;\r
 572 end;\r
 573 \r
 574 \r
 575 function unixtimefloat_win8:float;\r
 576 var\r
 577   ft:tfiletime;\r
 578   i:int64 absolute ft;\r
 579 begin\r
 580   GetSystemTimePreciseAsFileTime(ft);\r
 581   {change from windows 1601-01-01 to unix 1970-01-01.\r
 582   use integer math for this, to preserve precision}\r
 583   dec(i, 116444736000000000);\r
 584   result := (i / 10000000);\r
 585 end;\r
 586 \r
 587 \r
 588 \r
 589 function unixtimefloat:float;\r
 590 const\r
 591   margin = 0.0012;\r
 592 var\r
 593   f,g,h:float;\r
 594 begin\r
 595   if not win8inited then initwin8;\r
 596   if assigned(@GetSystemTimePreciseAsFileTime) then begin\r
 597     result := unixtimefloat_win8;\r
 598     exit;\r
 599   end;\r
 600 \r
 601   result := monotimefloat+timefloatbias;\r
 602   f := result-unixtimefloat_systemtime;\r
 603   if ((f > ticks_freq2+margin) or (f < -margin)) or (timefloatbias = 0) then begin\r
 604 //    writeln('unixtimefloat init');\r
 605     f := unixtimefloat_systemtime;\r
 606     settc;\r
 607     repeat g := unixtimefloat_systemtime; h := monotimefloat until g > f;\r
 608     unsettc;\r
 609     timefloatbias := g-h;\r
 610     result := unixtimefloat;\r
 611   end;\r
 612 \r
 613   {for small changes backwards, guarantee no steps backwards}\r
 614   if (result <= lastunixtimefloat) and (result > lastunixtimefloat-1.5) then result := lastunixtimefloat + 0.0000001;\r
 615   lastunixtimefloat := result;\r
 616 end;\r
 617 \r
 618 function unixtimeint:tunixtimeint;\r
 619 begin\r
 620   result := trunc(unixtimefloat);\r
 621 end;\r
 622 \r
 623 {$endif}\r
 624 {-----------------------------------------------end of platform specific}\r
 625 \r
 626 function wintimefloat:float;\r
 627 begin\r
 628   result := monotimefloat;\r
 629 end;\r
 630 \r
 631 function irctimefloat:float;\r
 632 begin\r
 633   result := unixtimefloat+settimebias;\r
 634 end;\r
 635 \r
 636 function irctimeint:tunixtimeint;\r
 637 begin\r
 638   result := unixtimeint+settimebias;\r
 639 end;\r
 640 \r
 641 \r
 642 procedure settime(newtime:tunixtimeint);\r
 643 var\r
 644   a:tunixtimeint;\r
 645 begin\r
 646   a := irctimeint-settimebias;\r
 647   if newtime = 0 then settimebias := 0 else settimebias := newtime-a;\r
 648 \r
 649   irctime := irctimeint;\r
 650 end;\r
 651 \r
 652 procedure timehandler;\r
 653 begin\r
 654   if unixtime = 0 then init;\r
 655   unixtime := unixtimeint;\r
 656   irctime := irctimeint;\r
 657   if unixtime and 63 = 0 then begin\r
 658     {update everything, apply timezone changes, clock changes, etc}\r
 659     gettimezone;\r
 660     timefloatbias := 0;\r
 661     unixtime := unixtimeint;\r
 662     irctime := irctimeint;\r
 663   end;\r
 664 end;\r
 665 \r
 666 \r
 667 procedure gettimezone;\r
 668 var\r
 669   {$ifdef UNIX}\r
 670     {$ifndef ver1_9_4}\r
 671       {$ifndef ver1_0}\r
 672         {$define above194}\r
 673       {$endif}\r
 674     {$endif}\r
 675     {$ifndef above194}\r
 676       hh,mm,ss:word;\r
 677     {$endif}\r
 678   {$endif}\r
 679   l:integer;\r
 680 begin\r
 681   {$ifdef UNIX}\r
 682     {$ifdef above194}\r
 683       timezone := tzseconds;\r
 684     {$else}\r
 685       gettime(hh,mm,ss);\r
 686       timezone := (longint(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);\r
 687     {$endif}\r
 688   {$else}\r
 689   timezone := round((now-now_utc)*86400);\r
 690   {$endif}\r
 691 \r
 692   while timezone > 43200 do dec(timezone,86400);\r
 693   while timezone < -43200 do inc(timezone,86400);\r
 694 \r
 695   if timezone >= 0 then timezonestr := '+' else timezonestr := '-';\r
 696   l := abs(timezone) div 60;\r
 697   timezonestr := timezonestr + char(l div 600 mod 10+48)+char(l div 60 mod 10+48)+':'+char(l div 10 mod 6+48)+char(l mod 10+48);\r
 698 end;\r
 699 \r
 700 function timestrshort(i:tunixtimeint):string;\r
 701 const\r
 702   weekday:array[0..6] of string[4]=('Thu','Fri','Sat','Sun','Mon','Tue','Wed');\r
 703   month:array[0..11] of string[4]=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');\r
 704 var\r
 705   y,m,d,h,min,sec,ms:word;\r
 706   t:tdatetime;\r
 707 begin\r
 708   t := unixtoole(i+timezone);\r
 709   decodedate(t,y,m,d);\r
 710   decodetime(t,h,min,sec,ms);\r
 711   result := weekday[(i+timezone) div 86400 mod 7]+' '+month[m-1]+' '+inttostr(d)+' '+\r
 712   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
 713   inttostr(y);\r
 714 end;\r
 715 \r
 716 function timestring(i:tunixtimeint):string;\r
 717 const\r
 718   weekday:array[0..6] of string[10]=('Thursday','Friday','Saturday','Sunday','Monday','Tuesday','Wednesday');\r
 719   month:array[0..11] of string[10]=('January','February','March','April','May','June','July','August','September','October','November','December');\r
 720 var\r
 721   y,m,d,h,min,sec,ms:word;\r
 722   t:tdatetime;\r
 723 begin\r
 724   t := unixtoole(i+timezone);\r
 725   decodedate(t,y,m,d);\r
 726   decodetime(t,h,min,sec,ms);\r
 727   result := weekday[(i+timezone) div 86400 mod 7]+' '+month[m-1]+' '+inttostr(d)+' '+inttostr(y)+' -- '+\r
 728   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
 729   timezonestr;\r
 730 end;\r
 731 \r
 732 function timestriso(i:tunixtimeint):string;\r
 733 var\r
 734   y,m,d,h,min,sec,ms:word;\r
 735   t:tdatetime;\r
 736 begin\r
 737   t := unixtoole(i+timezone);\r
 738   decodedate(t,y,m,d);\r
 739   decodetime(t,h,min,sec,ms);\r
 740   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
 741 end;\r
 742 \r
 743 function timestrisoutc(i:float):string;\r
 744 var\r
 745   y,m,d,h,min,sec,ms:word;\r
 746   t:tdatetime;\r
 747   fr:float;\r
 748 begin\r
 749   t := unixtoole(i);\r
 750   decodedate(t,y,m,d);\r
 751   decodetime(t,h,min,sec,ms);\r
 752   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
 753   fr := frac(i);\r
 754 \r
 755   result := result + '.'+\r
 756   inttostr(trunc(fr*10) mod 10)+\r
 757   inttostr(trunc(fr*100) mod 10)+\r
 758   inttostr(trunc(fr*1000) mod 10)+\r
 759   inttostr(trunc(fr*10000) mod 10)+\r
 760   inttostr(trunc(fr*100000) mod 10)+\r
 761   inttostr(trunc(fr*1000000) mod 10)+'Z';\r
 762 \r
 763 end;\r
 764 \r
 765 \r
 766 procedure init;\r
 767 begin\r
 768   {$ifdef mswindows}timebeginperiod(1);{$endif} //ensure stable unchanging clock\r
 769   fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0);\r
 770   settimebias := 0;\r
 771   gettimezone;\r
 772   unixtime := unixtimeint;\r
 773   irctime := irctimeint;\r
 774 end;\r
 775 \r
 776 initialization init;\r
 777 \r
 778 end.\r