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

Annotation of /trunk/btime.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide annotations)
Fri Mar 28 02:26:58 2008 UTC (13 years, 2 months ago) by plugwash
File size: 8471 byte(s)
initial import

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     unit btime;
11    
12     interface
13    
14     type
15     float=extended;
16    
17     var
18     timezone:integer;
19     timezonestr:string;
20     irctime,unixtime:integer;
21     tickcount:integer;
22     settimebias:integer;
23     qpcjump:float; {can be read out and reset for debug purpose}
24     performancecountfreq:extended;
25    
26     function irctimefloat:float;
27     function irctimeint:integer;
28    
29     function unixtimefloat:float;
30     function unixtimeint:integer;
31    
32     function wintimefloat:float;
33    
34     procedure settime(newtime:integer);
35     procedure gettimezone;
36     procedure timehandler;
37     procedure init;
38    
39     function timestring(i:integer):string;
40     function timestrshort(i:integer):string;
41    
42     function oletounixfloat(t:float):float;
43     function oletounix(t:tdatetime):integer;
44     function unixtoole(i:integer):tdatetime;
45    
46     var
47     timefloatbias:float;
48     lastunixtimefloat:float=0;
49    
50     implementation
51    
52     {$ifdef fpc}
53     {$mode delphi}
54     {$endif}
55    
56     uses
57     {$ifdef UNIX}
58     {$ifdef VER1_0}
59     linux,
60     {$else}
61     baseunix,unix,unixutil,{needed for 2.0.2}
62     {$endif}
63     {$else}
64     windows,
65     {$endif}
66     sysutils;
67    
68     {$include unixstuff.inc}
69    
70    
71     const
72     daysdifference=25569;
73    
74     function oletounixfloat(t:float):float;
75     begin
76     t := (t - daysdifference) * 86400;
77     result := t;
78     end;
79    
80     function oletounix(t:tdatetime):integer;
81     begin
82     result := trunc(oletounixfloat(t));
83     end;
84    
85     function unixtoole(i:integer):tdatetime;
86     begin
87     result := ((i)/86400)+daysdifference;
88     end;
89    
90     {$ifdef unix}
91     {-----------------------------------------*nix/freepascal code to read time }
92    
93     function unixtimefloat:float;
94     var
95     tv:ttimeval;
96     begin
97     gettimeofday(tv);
98     result := tv.tv_sec+(tv.tv_usec/1000000);
99     end;
100    
101     function wintimefloat:extended;
102     begin
103     result := unixtimefloat;
104     end;
105    
106     function unixtimeint:integer;
107     var
108     tv:ttimeval;
109     begin
110     gettimeofday(tv);
111     result := tv.tv_sec;
112     end;
113    
114     {$else} {delphi 3}
115     {------------------------------ windows/delphi code to read time}
116    
117     { free pascals tsystemtime is incomaptible with windows api calls
118     so we declare it ourselves - plugwash
119     }
120     {$ifdef fpc}
121     type
122     TSystemTime = record
123     wYear: Word;
124     wMonth: Word;
125     wDayOfWeek: Word;
126     wDay: Word;
127     wHour: Word;
128     wMinute: Word;
129     wSecond: Word;
130     wMilliseconds: Word;
131     end;
132     {$endif}
133     function Date_utc: extended;
134     var
135     SystemTime: TSystemTime;
136     begin
137     {$ifdef fpc}
138     GetsystemTime(@SystemTime);
139     {$else}
140     GetsystemTime(SystemTime);
141     {$endif}
142     with SystemTime do Result := EncodeDate(wYear, wMonth, wDay);
143     end;
144    
145     function Time_utc: extended;
146     var
147     SystemTime: TSystemTime;
148     begin
149     {$ifdef fpc}
150     GetsystemTime(@SystemTime);
151     {$else}
152     GetsystemTime(SystemTime);
153     {$endif}
154     with SystemTime do
155     Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
156     end;
157    
158     function Now_utc: extended;
159     begin
160     Result := round(Date_utc) + Time_utc;
161     end;
162    
163     const
164     highdwordconst=4294967296.0;
165    
166     function wintimefloat:extended;
167     var
168     p:packed record
169     lowpart:longint;
170     highpart:longint
171     end;
172     p2:tlargeinteger absolute p;
173     e:extended;
174     begin
175     if performancecountfreq = 0 then begin
176     QueryPerformancefrequency(p2);
177     e := p.lowpart;
178     if e < 0 then e := e + highdwordconst;
179     performancecountfreq := ((p.highpart*highdwordconst)+e);
180     end;
181     queryperformancecounter(p2);
182     e := p.lowpart;
183     if e < 0 then e := e + highdwordconst;
184     result := ((p.highpart*highdwordconst)+e)/performancecountfreq;
185     end;
186    
187     var
188     classpriority,threadpriority:integer;
189    
190     procedure settc;
191     var
192     hprocess,hthread:integer;
193     begin
194     hProcess := GetCurrentProcess;
195     hThread := GetCurrentThread;
196    
197     ClassPriority := GetPriorityClass(hProcess);
198     ThreadPriority := GetThreadPriority(hThread);
199    
200     SetPriorityClass(hProcess, REALTIME_PRIORITY_CLASS);
201     SetThreadPriority(hThread, THREAD_PRIORITY_TIME_CRITICAL);
202     end;
203    
204     procedure unsettc;
205     var
206     hprocess,hthread:integer;
207     begin
208     hProcess := GetCurrentProcess;
209     hThread := GetCurrentThread;
210    
211     SetPriorityClass(hProcess, ClassPriority);
212     SetThreadPriority(hThread, ThreadPriority);
213     end;
214    
215     function unixtimefloat:float;
216     var
217     f,g,h:float;
218     begin
219     if timefloatbias = 0 then begin
220     settc;
221     f := now_utc;
222     repeat g := now_utc; h := wintimefloat until g > f;
223     timefloatbias := oletounixfloat(g)-h;
224     unsettc;
225     end;
226     result := wintimefloat+timefloatbias;
227    
228     {
229     workaround for QPC jumps
230     (approach 2: always check "hi res" QPC unixtime against the "guaranteed" systemtime one)
231     }
232     f := result-(oletounixfloat(now_utc));
233     if abs(f) > 0.02 then begin
234     f := timefloatbias;
235     timefloatbias := 0;
236     result := unixtimefloat;
237     qpcjump := qpcjump + f - timefloatbias;
238     end;
239    
240     if (result <= lastunixtimefloat) then result := lastunixtimefloat + 0.0000001;
241     lastunixtimefloat := result;
242     end;
243    
244     function unixtimeint:integer;
245     begin
246     result := trunc(unixtimefloat);
247     end;
248    
249     {$endif}
250     {-----------------------------------------------end of platform specific}
251    
252     function irctimefloat:float;
253     begin
254     result := unixtimefloat+settimebias;
255     end;
256    
257     function irctimeint:integer;
258     begin
259     result := unixtimeint+settimebias;
260     end;
261    
262    
263     procedure settime(newtime:integer);
264     var
265     a:integer;
266     begin
267     a := irctimeint-settimebias;
268     if newtime = 0 then settimebias := 0 else settimebias := newtime-a;
269    
270     irctime := irctimeint;
271     end;
272    
273     procedure timehandler;
274     begin
275     if unixtime = 0 then init;
276     unixtime := unixtimeint;
277     irctime := irctimeint;
278     if unixtime and 63 = 0 then begin
279     {update everything, apply timezone changes, clock changes, etc}
280     gettimezone;
281     timefloatbias := 0;
282     unixtime := unixtimeint;
283     irctime := irctimeint;
284     end;
285     end;
286    
287    
288     procedure gettimezone;
289     var
290     {$ifdef UNIX}
291     {$ifndef ver1_9_4}
292     {$ifndef ver1_0}
293     {$define above194}
294     {$endif}
295     {$endif}
296     {$ifndef above194}
297     hh,mm,ss:word;
298     {$endif}
299     {$endif}
300     l:integer;
301     begin
302     {$ifdef UNIX}
303     {$ifdef above194}
304     timezone := tzseconds;
305     {$else}
306     gettime(hh,mm,ss);
307     timezone := (longint(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);
308     {$endif}
309     {$else}
310     timezone := round((now-now_utc)*86400);
311     {$endif}
312    
313     while timezone > 43200 do dec(timezone,86400);
314     while timezone < -43200 do inc(timezone,86400);
315    
316     if timezone >= 0 then timezonestr := '+' else timezonestr := '-';
317     l := abs(timezone) div 60;
318     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);
319     end;
320    
321     function timestrshort(i:integer):string;
322     const
323     weekday:array[0..6] of string[4]=('Thu','Fri','Sat','Sun','Mon','Tue','Wed');
324     month:array[0..11] of string[4]=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
325     var
326     y,m,d,h,min,sec,ms:word;
327     t:tdatetime;
328     begin
329     t := unixtoole(i+timezone);
330     decodedate(t,y,m,d);
331     decodetime(t,h,min,sec,ms);
332     result := weekday[(i+timezone) div 86400 mod 7]+' '+month[m-1]+' '+inttostr(d)+' '+
333     inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10)+' '+
334     inttostr(y);
335     end;
336    
337     function timestring(i:integer):string;
338     const
339     weekday:array[0..6] of string[10]=('Thursday','Friday','Saturday','Sunday','Monday','Tuesday','Wednesday');
340     month:array[0..11] of string[10]=('January','February','March','April','May','June','July','August','September','October','November','December');
341     var
342     y,m,d,h,min,sec,ms:word;
343     t:tdatetime;
344     begin
345     t := unixtoole(i+timezone);
346     decodedate(t,y,m,d);
347     decodetime(t,h,min,sec,ms);
348     result := weekday[(i+timezone) div 86400 mod 7]+' '+month[m-1]+' '+inttostr(d)+' '+inttostr(y)+' -- '+
349     inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10)+' '+
350     timezonestr;
351     end;
352    
353     procedure init;
354     begin
355     qpcjump := 0;
356     settimebias := 0;
357     gettimezone;
358     unixtime := unixtimeint;
359     irctime := irctimeint;
360     end;
361    
362     end.

Properties

Name Value
svn:executable

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