+ 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
+ if (tzh_timecnt <> 0) then begin\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
+ end else begin\r
+ index := 0;\r
+ end;\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
+{$endif} //unix\r
+\r
+function tzgetoffset:integer;\r
lcore.org gitweb / lcore.git / blobdiff