procedure beginhightimerrate;\r
procedure endhightimerrate;\r
\r
+procedure tzinvalidate;\r
+\r
+{$ifdef unix}\r
+function tzgetoffsetforts(ts:tunixtimeint):integer;\r
+{$endif}\r
+\r
{$ifdef mswindows}\r
function unixtimefloat_systemtime:float;\r
{$endif}\r
\r
{------------------------------ end of *nix/freepascal section}\r
\r
-{$else} {delphi 3}\r
+{$else} {windows}\r
{------------------------------ windows/delphi code to read time}\r
\r
\r
+procedure tzinvalidate;\r
+begin\r
+ gettimezone;\r
+end;\r
+\r
{simulate gettimeofday on windows so one can always use gettimeofday if preferred}\r
\r
procedure gettimeofday(var tv:ttimeval);\r
end;\r
\r
\r
+{$ifdef unix}\r
+\r
+var\r
+ tzerror:boolean;\r
+ tzfile:ansistring;\r
+\r
+function tzgetfilename:ansistring;\r
+var\r
+ t:textfile;\r
+\r
+ s,tz,tzdir:ansistring;\r
+begin\r
+ result := '';\r
+ filemode := 0;\r
+ {$ifdef unix}\r
+ tz := getenv('TZ');\r
+\r
+ if (copy(tz,1,1) = ':') then begin\r
+ tz := copy(tz,2,99999);\r
+\r
+ if (copy(tz,1,1) <> '/') then begin\r
+ tzdir := getenv('TZDIR');\r
+ if (tzdir = '') then begin\r
+ tzdir := '/usr/share/zoneinfo/';\r
+ end else begin\r
+ if (copy(tzdir,length(tzdir),1) <> '/') then tzdir := tzdir + '/';\r
+ end;\r
+ tz := tzdir + tz;\r
+ end;\r
+\r
+ assignfile(t,tz);\r
+ {$i-}reset(t);{$i+}\r
+ if (ioresult = 0) then begin\r
+ closefile(t);\r
+ result := tz;\r
+ exit;\r
+ end;\r
+\r
+ end;\r
+ {$endif}\r
+ \r
+ assignfile(t,'/etc/localtime');\r
+ {$i-}reset(t);{$i+}\r
+ if (ioresult = 0) then begin\r
+ closefile(t);\r
+ result := '/etc/localtime';\r
+ exit;\r
+ end;\r
+\r
+ assignfile(t,'/etc/timezone');\r
+\r
+ s := '';\r
+ {$i-}reset(t);{$i+}\r
+ if (ioresult = 0) then begin\r
+ readln(t,s);\r
+ closefile(t);\r
+ if (s <> '') then begin\r
+ result := '/usr/share/zoneinfo/'+s;\r
+ exit;\r
+ end;\r
+ end;\r
+end;\r
+\r
+type\r
+ dvar=array[0..65535] of byte;\r
+ pdvar=^dvar;\r
+\r
+var\r
+ tzcache:pdvar;\r
+ tzsize:integer;\r
+\r
+procedure tzinvalidate;\r
+begin\r
+ if assigned(tzcache) then freemem(tzcache);\r
+ tzcache := nil;\r
+ tzsize := 0;\r
+ tzfile := '';\r
+ gettimezone;\r
+end;\r
+\r
+\r
+function tzgetoffsetforts(ts:tunixtimeint):integer;\r
+var\r
+ f:file;\r
+ buf:pdvar;\r
+ fs:integer;\r
+ ofs,ofs2:integer;\r
+ mode64:boolean;\r
+ has64:boolean;\r
+ a,index:integer;\r
+ //tzstrofs:integer;\r
+ t:int64;\r
+ tzh_ttisgmtcnt:integer;\r
+ tzh_ttisstdcnt:integer;\r
+ tzh_leapcnt:integer;\r
+ tzh_timecnt:integer;\r
+ tzh_typecnt:integer;\r
+ tzh_charcnt:integer;\r
+\r
+\r
+function getint:integer;\r
+begin\r
+ if (ofs < 0) or ((ofs + 4) > fs) then raise exception.create('getint');\r
+ result := (buf[ofs] shl 24) + (buf[ofs+1] shl 16) + (buf[ofs+2] shl 8) + buf[ofs+3];\r
+ inc(ofs,4);\r
+end;\r
+\r
+function getint64:int64;\r
+begin\r
+ if (ofs < 0) or ((ofs + 8) > fs) then raise exception.create('getint64');\r
+ result := int64(getint) shl 32;\r
+ inc(result,cardinal(getint));\r
+end;\r
+\r
+\r
+function getbyte:byte;\r
+begin\r
+ if (ofs < 0) or ((ofs + 1) > fs) then raise exception.create('getbyte');\r
+ result := buf[ofs];\r
+ inc(ofs);\r
+end;\r
+\r
+begin\r
+ result := 0;\r
+ tzerror := true;\r
+\r
+ if not assigned(tzcache) then begin\r
+\r
+ if (tzfile = '') then tzfile := tzgetfilename;\r
+\r
+ if (tzfile = '') then exit;\r
+\r
+ assignfile(f,tzfile);\r
+ filemode := 0;\r
+ {$i-}reset(f,1);{$i+}\r
+ if (ioresult <> 0) then begin\r
+ exit;\r
+ end;\r
+ tzsize := filesize(f);\r
+ if (tzsize > 65536) then tzsize := 65536;\r
+ getmem(tzcache,tzsize);\r
+ blockread(f,tzcache^,tzsize);\r
+ closefile(f);\r
+ end;\r
+ fs := tzsize;\r
+ buf := tzcache;\r
+ ofs := 0;\r
+ mode64 := false;\r
+\r
+ try\r
+ repeat\r
+ if (getint <> $545a6966) then exit; // 'TZif'\r
+ has64 := getbyte >= $32; // '2'\r
+\r
+ inc(ofs,15);\r
+\r
+ tzh_ttisgmtcnt := getint;\r
+ tzh_ttisstdcnt := getint;\r
+ tzh_leapcnt := getint;\r
+ tzh_timecnt := getint;\r
+ tzh_typecnt := getint;\r
+ tzh_charcnt := getint;\r
+\r
+ if mode64 or (not has64) then break;\r
+ inc(ofs, 5 * tzh_timecnt + 6 * tzh_typecnt + 8 * tzh_leapcnt + tzh_ttisstdcnt + tzh_ttisgmtcnt + tzh_charcnt);\r
+ mode64 := true;\r
+ until false;\r
+ index := 0;\r
+\r
+ if (tzh_timecnt < 0) or (tzh_timecnt > fs) then raise exception.create('tzh_timecnt');\r
+ ofs2 := ofs;\r
+\r
+ for a := 0 to tzh_timecnt -1 do begin\r
+ if mode64 then t := getint64 else t := getint;\r
+ if (t > ts) then begin\r
+ index := a - 1;\r
+ break;\r
+ end;\r
+ if (a = tzh_timecnt -1) and (ts >= t) then index := a;\r
+ end;\r
+ ofs := ofs2 + tzh_timecnt * (1 + ord(mode64)) * 4;\r
+\r
+ if (cardinal(ofs + index) >= fs) or (index < 0) then raise exception.create('index');\r
+ index := buf[ofs+index];\r
+ inc(ofs,tzh_timecnt);\r
+\r
+ if (index >= tzh_typecnt) then raise exception.create('type');\r
+ ofs2 := ofs;\r
+ // writeln('ofs2 ',inttohex(ofs2,8));\r
+ inc(ofs,6 * index);\r
+ result := getint;\r
+\r
+ //tzisdst := getbyte;\r
+\r
+ //the abbreviation string\r
+ { tzstrofs := getbyte;\r
+ tzstr := '';\r
+ ofs := ofs2 + 6 * tzh_typecnt;\r
+ inc(ofs, tzstrofs);\r
+\r
+ repeat\r
+ a := getbyte;\r
+ if (a <> 0) then tzstr := tzstr + chr(a);\r
+ until (a = 0); }\r
+\r
+ tzerror := false;\r
+ except\r
+\r
+ end;\r
+end;\r
+\r
+function tzgetoffset:integer;\r
+begin\r
+ tzgetoffsetforts(unixtimeint);\r
+end;\r
+\r
+\r
+{$endif}\r
+\r
+\r
procedure gettimezone;\r
var\r
{$ifdef UNIX}\r
begin\r
{$ifdef UNIX}\r
{$ifdef above194}\r
- timezone := tzseconds;\r
+ timezone := tzgetoffset;\r
+ //freepascal tzseconds is not 2038 safe\r
{$else}\r
gettime(hh,mm,ss);\r
timezone := (longint(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);\r
timezone := round((now-now_utc)*86400);\r
{$endif}\r
\r
- while timezone > 43200 do dec(timezone,86400);\r
- while timezone < -43200 do inc(timezone,86400);\r
+ while timezone > 50400 do dec(timezone,86400);\r
+ while timezone < -50400 do inc(timezone,86400);\r
\r
if timezone >= 0 then timezonestr := '+' else timezonestr := '-';\r
l := abs(timezone) div 60;\r
lcore.org gitweb / lcore.git / blobdiff