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

Annotation of /trunk/btime.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 158 - (hide 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 plugwash 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 beware 2
11 plugwash 1 unit btime;
12 plugwash 149 {$ifdef fpc}
13     {$mode delphi}
14     {$endif}
15 beware 150
16     {$include lcoreconfig.inc}
17    
18 plugwash 1 interface
19    
20 beware 127 {$ifdef mswindows}
21 beware 84 uses
22     ltimevalstuff;
23     {$endif}
24    
25 plugwash 1 type
26     float=extended;
27 beware 118 tunixtimeint={$ifdef ver100}longint;{$else}int64;{$endif}
28 plugwash 1
29 beware 2 const
30     colorburst=39375000/11; {3579545.4545....}
31    
32 plugwash 1 var
33     timezone:integer;
34     timezonestr:string;
35 beware 118 irctime,unixtime:tunixtimeint;
36 plugwash 1 tickcount:integer;
37 beware 118 settimebias:tunixtimeint;
38 plugwash 1 performancecountfreq:extended;
39 beware 152 btimenowin8:boolean;
40 plugwash 1
41     function irctimefloat:float;
42 beware 118 function irctimeint:tunixtimeint;
43 plugwash 1
44 beware 118 //unix timestamp (UTC) float seconds
45 plugwash 1 function unixtimefloat:float;
46 beware 118 function unixtimeint:tunixtimeint;
47 plugwash 1
48 beware 118 //monotonic float seconds
49     function monotimefloat:float;
50    
51     //monotonic (alias, old function name)
52 plugwash 1 function wintimefloat:float;
53    
54 beware 118 procedure settime(newtime:tunixtimeint);
55 plugwash 1 procedure gettimezone;
56     procedure timehandler;
57     procedure init;
58    
59 beware 119 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 plugwash 1
64 beware 150 procedure beginhightimerrate;
65     procedure endhightimerrate;
66    
67 beware 127 {$ifdef mswindows}
68 beware 2 function unixtimefloat_systemtime:float;
69     {$endif}
70    
71 plugwash 1 function oletounixfloat(t:float):float;
72 beware 118 function oletounix(t:tdatetime):tunixtimeint;
73 beware 88 function unixtoole(i:float):tdatetime;
74 plugwash 1
75 beware 127 {$ifdef mswindows}
76 beware 2 function mmtimefloat:float;
77     function qpctimefloat:float;
78     {$endif}
79    
80 beware 127 {$ifdef mswindows}
81 beware 84 procedure gettimeofday(var tv:ttimeval);
82     {$endif}
83    
84    
85 beware 2 const
86     mmtime_driftavgsize=32;
87     mmtime_warmupnum=4;
88     mmtime_warmupcyclelength=15;
89 plugwash 1 var
90 beware 2 //this flag is to be set when btime has been running long enough to stabilise
91     warmup_finished:boolean;
92    
93 plugwash 1 timefloatbias:float;
94 beware 2 ticks_freq:float=0;
95     ticks_freq2:float=0;
96     ticks_freq_known:boolean=false;
97 plugwash 1 lastunixtimefloat:float=0;
98 beware 2 lastsynctime:float=0;
99     lastsyncbias:float=0;
100 plugwash 1
101 beware 2 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 plugwash 1 implementation
116    
117    
118 plugwash 149
119 plugwash 1 uses
120     {$ifdef UNIX}
121     {$ifdef VER1_0}
122     linux,
123     {$else}
124 beware 157 {$ifdef linux}linux,{$endif} //for clock_gettime
125     {$ifdef freebsd}freebsd,{$endif} //for clock_gettime
126 plugwash 60 baseunix,unix,unixutil,sockets, {unixutil and sockets needed by unixstuff.inc on some compiler versions}
127 plugwash 1 {$endif}
128     {$else}
129 beware 2 windows,unitsettc,mmsystem,
130 plugwash 1 {$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 beware 118 function oletounix(t:tdatetime):tunixtimeint;
146 plugwash 1 begin
147 beware 144 result := round(oletounixfloat(t));
148 plugwash 1 end;
149    
150 beware 88 function unixtoole(i:float):tdatetime;
151 plugwash 1 begin
152     result := ((i)/86400)+daysdifference;
153     end;
154    
155 beware 2 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 plugwash 1 {$ifdef unix}
173     {-----------------------------------------*nix/freepascal code to read time }
174    
175     function unixtimefloat:float;
176     var
177     tv:ttimeval;
178 beware 155 sec:tunixtimeint;
179 plugwash 1 begin
180     gettimeofday(tv);
181 beware 155 sec := tv.tv_sec;
182     {$ifndef cpu64}
183 beware 157 if (sec < -1) then inc(sec,$100000000); //tv_sec is 32 bits. allow -1 for invalid result
184 beware 155 {$endif}
185     result := sec+(tv.tv_usec/1000000);
186 plugwash 1 end;
187    
188 beware 157 {$ifdef linux}{$define have_clock_gettime}{$endif}
189     {$ifdef freebsd}{$define have_clock_gettime}{$endif}
190    
191     {$ifdef have_clock_gettime}
192 beware 118 {$define monotimefloat_implemented}
193 plugwash 1
194 beware 118 function monotimefloat:float;
195     var
196 beware 157 ts: ttimespec;
197 beware 118 begin
198 beware 157 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 beware 118 end;
203     //fallback
204     result := unixtimefloat;
205     end;
206    
207    
208 beware 157 {$endif}
209 beware 118
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 plugwash 1 var
252     tv:ttimeval;
253 beware 155 sec:tunixtimeint;
254 plugwash 1 begin
255     gettimeofday(tv);
256 beware 155 sec := tv.tv_sec;
257     {$ifndef cpu64}
258 beware 158 if (sec < -1) then inc(sec,$100000000); //tv_sec is 32 bits. allow -1 for invalid result
259 beware 155 {$endif}
260     result := sec;
261 plugwash 1 end;
262    
263 beware 118 {------------------------------ end of *nix/freepascal section}
264    
265 plugwash 1 {$else} {delphi 3}
266     {------------------------------ windows/delphi code to read time}
267    
268 beware 84
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 beware 2 {
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 beware 118 temp:float;
300 beware 2 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 beware 118 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 beware 2 end;
320    
321     procedure measure_ticks_freq;
322     var
323     f,g:float;
324     o:tosversioninfo;
325     isnt:boolean;
326 beware 94 { is9x:boolean;}
327 beware 118 adjust1,adjust2:cardinal;
328     adjustbool:longbool;
329 beware 2 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 beware 94 { is9x := o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS;}
342 beware 2
343     ticks_freq2 := f;
344     mmtime_synchedqpc := false;
345 beware 117
346 beware 118 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 beware 117 end;
354 beware 2 end;
355    
356     {9x}
357 beware 117 if (performancecountfreq = 1193182) and (f >= 0.050) and (f <= 0.060) then begin
358 beware 2 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 beware 94 { jump:float;}
410     mm,f,qpc,newdrift:float;
411 beware 2 qpcjumped:boolean;
412 beware 94 a,b:integer;
413     { retrycount:integer;}
414 beware 2 begin
415     if not ticks_freq_known then measure_ticks_freq;
416 beware 94 { retrycount := maxretries;}
417 beware 2
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 beware 94 { dec(retrycount);}
434 beware 2 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 beware 94 a := 5;
465 beware 2 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 beware 94 {f := (qpc - mmtime_prev_lastsyncqpc) * mmtime_prev_drift + mmtime_prev_lastsyncmm;
484 beware 2 jump := result-f;
485 beware 94 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 beware 2
487     f := result;
488     end;
489    
490     result := f;
491    
492 beware 116 if (result < mmtime_lastresult) then result := mmtime_lastresult;
493 beware 2 mmtime_lastresult := result;
494     end;
495    
496 beware 136 { free pascals tsystemtime is incompatible with windows api calls
497 plugwash 1 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 beware 2 function unixtimefloat_systemtime:float;
543 plugwash 1 begin
544 beware 2 {result := oletounixfloat(now_utc);}
545 plugwash 1
546 beware 2 {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 plugwash 1 end;
549    
550 beware 118 function monotimefloat:extended;
551 plugwash 1 begin
552 beware 2 result := mmqpctimefloat;
553 plugwash 1 end;
554    
555 beware 140
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 plugwash 1 function unixtimefloat:float;
589 beware 2 const
590     margin = 0.0012;
591 plugwash 1 var
592     f,g,h:float;
593     begin
594 beware 152 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 beware 140 end;
601    
602 beware 118 result := monotimefloat+timefloatbias;
603 beware 2 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 plugwash 1 settc;
608 beware 118 repeat g := unixtimefloat_systemtime; h := monotimefloat until g > f;
609 plugwash 1 unsettc;
610 beware 2 timefloatbias := g-h;
611 plugwash 1 result := unixtimefloat;
612     end;
613    
614 beware 2 {for small changes backwards, guarantee no steps backwards}
615     if (result <= lastunixtimefloat) and (result > lastunixtimefloat-1.5) then result := lastunixtimefloat + 0.0000001;
616 plugwash 1 lastunixtimefloat := result;
617     end;
618    
619 beware 118 function unixtimeint:tunixtimeint;
620 plugwash 1 begin
621     result := trunc(unixtimefloat);
622     end;
623    
624     {$endif}
625     {-----------------------------------------------end of platform specific}
626    
627 beware 118 function wintimefloat:float;
628     begin
629     result := monotimefloat;
630     end;
631    
632 plugwash 1 function irctimefloat:float;
633     begin
634     result := unixtimefloat+settimebias;
635     end;
636    
637 beware 118 function irctimeint:tunixtimeint;
638 plugwash 1 begin
639     result := unixtimeint+settimebias;
640     end;
641    
642    
643 beware 118 procedure settime(newtime:tunixtimeint);
644 plugwash 1 var
645 beware 118 a:tunixtimeint;
646 plugwash 1 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 beware 118 function timestrshort(i:tunixtimeint):string;
702 plugwash 1 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 beware 118 function timestring(i:tunixtimeint):string;
718 plugwash 1 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 beware 119 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 beware 150 procedure beginhightimerrate;
767     begin
768     {$ifdef mswindows}timebeginperiod(1);{$endif}
769     end;
770 beware 119
771 beware 150 procedure endhightimerrate;
772     begin
773     {$ifdef mswindows}timeendperiod(1);{$endif}
774     end;
775    
776 plugwash 1 procedure init;
777     begin
778 beware 150 {$ifdef btimehighrate}beginhightimerrate;{$endif}
779 beware 2 fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0);
780 plugwash 1 settimebias := 0;
781     gettimezone;
782     unixtime := unixtimeint;
783     irctime := irctimeint;
784     end;
785    
786 beware 2 initialization init;
787    
788 plugwash 1 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