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

Contents of /trunk/btime.pas

Parent Directory Parent Directory | Revision Log Revision Log


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