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