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

Contents of /trunk/btime.pas

Parent Directory Parent Directory | Revision Log Revision Log


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