/[lcore]/trunk/btime.pas
ViewVC logotype

Contents of /trunk/btime.pas

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:eol-style CRLF

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.22