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