tzenv.inc 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2020 by Tomas Hajny,
  4. member of the Free Pascal development team.
  5. Support routines for calculation of local timezone and DST time
  6. offset based on information provided in the environment variable TZ.
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. type
  14. DSTSpecType = (DSTMonthWeekDay, DSTMonthDay, DSTJulian, DSTJulianX);
  15. const
  16. TZEnvName = 'TZ';
  17. {$IFDEF OS2}
  18. EMXTZEnvName = 'EMXTZ';
  19. {$ENDIF OS2}
  20. MaxSecond = 86399;
  21. (* The following values differing from the defaults *)
  22. (* below are not used at the moment. *)
  23. USDSTStartMonth = 3;
  24. USDSTStartWeek = 2;
  25. USDSTEndMonth = 11;
  26. USDSTEndWeek = 1;
  27. EUDSTStartMonth = 3;
  28. EUDSTStartWeek = -1;
  29. (* Initialized to default values, updated after a call to InitTZ *)
  30. TZName: string = '';
  31. TZDSTName: string = '';
  32. TZOffset: longint = 0;
  33. TZOffsetMin: longint = 0;
  34. DSTOffset: longint = 0;
  35. DSTOffsetMin: longint = 0;
  36. DSTStartMonth: byte = 4;
  37. DSTStartWeek: shortint = 1;
  38. DSTStartDay: word = 0;
  39. DSTStartSec: cardinal = 7200;
  40. DSTEndMonth: byte = 10;
  41. DSTEndWeek: shortint = -1;
  42. DSTEndDay: word = 0;
  43. DSTEndSec: cardinal = 10800;
  44. DSTStartSpecType: DSTSpecType = DSTMonthWeekDay;
  45. DSTEndSpecType: DSTSpecType = DSTMonthWeekDay;
  46. (* The following variables are initialized after a call to InitTZ. *)
  47. var
  48. RealDSTStartMonth, RealDSTStartDay, RealDSTEndMonth, RealDSTEndDay: byte;
  49. const
  50. MonthEnds: array [1..12] of word =
  51. (31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365);
  52. function LeapDay (Year: word): byte; inline;
  53. begin
  54. if IsLeapYear (Year) then
  55. LeapDay := 1
  56. else
  57. LeapDay := 0;
  58. end;
  59. function FirstDay (MM: byte; Y: word; Mo: word; D: word; WD: word): byte;
  60. inline;
  61. var
  62. DD: longint;
  63. begin
  64. if MM < Mo then
  65. begin
  66. DD := D + MonthEnds [Pred (Mo)];
  67. if MM > 1 then
  68. Dec (DD, MonthEnds [Pred (MM)]);
  69. if (MM <= 2) and (Mo > 2) then
  70. Inc (DD, LeapDay (Y));
  71. end
  72. else
  73. if MM > Mo then
  74. begin
  75. DD := - MonthDays [false, Mo] + D - MonthEnds [Pred (MM)]
  76. + MonthEnds [Mo];
  77. if (Mo <= 2) and (MM > 2) then
  78. Dec (DD, LeapDay (Y));
  79. end
  80. else
  81. (* M = MM *)
  82. DD := D;
  83. DD := WD - DD mod 7 + 1;
  84. if DD < 0 then
  85. FirstDay := DD + 7
  86. else
  87. FirstDay := DD mod 7;
  88. end;
  89. procedure UpdateTimeWithOffset (var SystemTime: TSystemTime; Offset: longint);
  90. inline;
  91. var
  92. Y: longint;
  93. Mo: longint;
  94. D: longint;
  95. WD: word;
  96. H: longint;
  97. Mi: longint;
  98. begin
  99. with SystemTime do
  100. begin
  101. Y := Year;
  102. Mo := Month;
  103. D := Day;
  104. WD := DayOfWeek;
  105. H := Hour;
  106. Mi := Minute;
  107. end;
  108. Mi := Mi + (Offset mod 60);
  109. H := H + (Offset div 60);
  110. if Mi < 0 then
  111. begin
  112. Inc (Mi, 60);
  113. Dec (H);
  114. end;
  115. if H < 0 then
  116. begin
  117. Inc (H, 24);
  118. if WD = 0 then
  119. WD := 6
  120. else
  121. Dec (WD);
  122. if D = 1 then
  123. begin
  124. if Mo = 1 then
  125. begin
  126. Dec (Y);
  127. Mo := 12;
  128. end
  129. else
  130. Dec (Mo);
  131. D := MonthDays [IsLeapYear (Y), Mo];
  132. end
  133. else
  134. Dec (D);
  135. end
  136. else
  137. begin
  138. if Mi > 59 then
  139. begin
  140. Dec (Mi, 60);
  141. Inc (H);
  142. end;
  143. if H > 23 then
  144. begin
  145. Dec (H, 24);
  146. if WD = 6 then
  147. WD := 0
  148. else
  149. Inc (WD);
  150. if D = MonthDays [IsLeapYear (Y), Mo] then
  151. begin
  152. D := 1;
  153. if Mo = 12 then
  154. begin
  155. Inc (Y);
  156. Mo := 1;
  157. end
  158. else
  159. Inc (Mo);
  160. end
  161. else
  162. Inc (D);
  163. end;
  164. end;
  165. with SystemTime do
  166. begin
  167. Year := Y;
  168. Month := Mo;
  169. Day := D;
  170. DayOfWeek := WD;
  171. Hour := H;
  172. Minute := Mi;
  173. end;
  174. end;
  175. function InDST (const Time: TSystemTime; const InputIsUTC: boolean): boolean;
  176. var
  177. AfterDSTStart, BeforeDSTEnd: boolean;
  178. Y: longint;
  179. Mo: longint;
  180. D: longint;
  181. WD: longint;
  182. Second: longint;
  183. begin
  184. InDST := false;
  185. if DSTOffset <> TZOffset then
  186. begin
  187. Second := longint (Time.Hour) * 3600 + Time.Minute * 60 + Time.Second;
  188. Y := Time.Year;
  189. Mo := Time.Month;
  190. D := Time.Day;
  191. if InputIsUTC and (TZOffset <> 0) then
  192. begin
  193. Second := Second - TZOffset;
  194. if Second < 0 then
  195. begin
  196. Second := Second + MaxSecond + 1;
  197. if D = 1 then
  198. begin
  199. if Mo = 1 then
  200. begin
  201. Dec (Y);
  202. Mo := 12;
  203. end
  204. else
  205. Dec (Mo);
  206. D := MonthDays [IsLeapYear (Y), Mo];
  207. end
  208. else
  209. Dec (D);
  210. end
  211. else
  212. if Second > MaxSecond then
  213. begin
  214. Second := Second - MaxSecond - 1;
  215. if D = MonthDays [IsLeapYear (Y), Mo] then
  216. begin
  217. D := 1;
  218. if Mo = 12 then
  219. begin
  220. Inc (Y);
  221. Mo := 1;
  222. end
  223. else
  224. Inc (Mo);
  225. end
  226. else
  227. Inc (D);
  228. end;
  229. end;
  230. if Mo < RealDSTStartMonth then
  231. AfterDSTStart := false
  232. else
  233. if Mo > RealDSTStartMonth then
  234. AfterDSTStart := true
  235. else
  236. if D < RealDSTStartDay then
  237. AfterDSTStart := false
  238. else
  239. if D > RealDSTStartDay then
  240. AfterDSTStart := true
  241. else
  242. AfterDSTStart := Second > DSTStartSec;
  243. if Mo > RealDSTEndMonth then
  244. BeforeDSTEnd := false
  245. else
  246. if Mo < RealDSTEndMonth then
  247. BeforeDSTEnd := true
  248. else
  249. if D > RealDSTEndDay then
  250. BeforeDSTEnd := false
  251. else
  252. if D < RealDSTEndDay then
  253. BeforeDSTEnd := true
  254. else
  255. BeforeDSTEnd := Second < DSTEndSec;
  256. InDST := AfterDSTStart and BeforeDSTEnd;
  257. end;
  258. end;
  259. function InDST: boolean; inline;
  260. var
  261. SystemTime: TSystemTime;
  262. begin
  263. InDST := false;
  264. if DSTOffset <> TZOffset then
  265. begin
  266. GetLocalTime (SystemTime);
  267. InDST := InDST (SystemTime, false);
  268. end;
  269. end;
  270. procedure InitTZ0; inline;
  271. var
  272. TZ, S: string;
  273. I, J: byte;
  274. Err: longint;
  275. GnuFmt: boolean;
  276. ADSTStartMonth: byte;
  277. ADSTStartWeek: shortint;
  278. ADSTStartDay: word;
  279. ADSTStartSec: cardinal;
  280. ADSTEndMonth: byte;
  281. ADSTEndWeek: shortint;
  282. ADSTEndDay: word;
  283. ADSTEndSec: cardinal;
  284. ADSTStartSpecType: DSTSpecType;
  285. ADSTEndSpecType: DSTSpecType;
  286. ADSTChangeSec: cardinal;
  287. function ParseOffset (OffStr: string): longint;
  288. (* Parse time offset given as [-|+]HH[:MI[:SS]] and return in seconds *)
  289. var
  290. TZShiftHH, TZShiftDir: shortint;
  291. TZShiftMI, TZShiftSS: byte;
  292. N1, N2: byte;
  293. begin
  294. TZShiftHH := 0;
  295. TZShiftMI := 0;
  296. TZShiftSS := 0;
  297. TZShiftDir := 1;
  298. N1 := 1;
  299. while (N1 <= Length (OffStr)) and (OffStr [N1] <> ':') do
  300. Inc (N1);
  301. Val (Copy (OffStr, 1, Pred (N1)), TZShiftHH, Err);
  302. if (Err = 0) and (TZShiftHH >= -24) and (TZShiftHH <= 23) then
  303. begin
  304. (* Normalize the hour offset to -12..11 if necessary *)
  305. if TZShiftHH > 11 then
  306. Dec (TZShiftHH, 24) else
  307. if TZShiftHH < -12 then
  308. Inc (TZShiftHH, 24);
  309. if TZShiftHH < 0 then
  310. TZShiftDir := -1;
  311. if (N1 <= Length (OffStr)) then
  312. begin
  313. N2 := Succ (N1);
  314. while (N2 <= Length (OffStr)) and (OffStr [N2] <> ':') do
  315. Inc (N2);
  316. Val (Copy (OffStr, Succ (N1), N2 - N1), TZShiftMI, Err);
  317. if (Err = 0) and (TZShiftMI <= 59) then
  318. begin
  319. if (N2 <= Length (OffStr)) then
  320. begin
  321. Val (Copy (OffStr, Succ (N2), Length (OffStr) - N2), TZShiftSS, Err);
  322. if (Err <> 0) or (TZShiftSS > 59) then
  323. TZShiftSS := 0;
  324. end
  325. end
  326. else
  327. TZShiftMI := 0;
  328. end;
  329. end
  330. else
  331. TZShiftHH := 0;
  332. ParseOffset := longint (TZShiftHH) * 3600 +
  333. TZShiftDir * (longint (TZShiftMI) * 60 + TZShiftSS);
  334. end;
  335. begin
  336. TZ := GetEnvironmentVariable (TZEnvName);
  337. {$IFDEF OS2}
  338. if TZ = '' then
  339. TZ := GetEnvironmentVariable (EMXTZEnvName);
  340. {$ENDIF OS2}
  341. if TZ <> '' then
  342. begin
  343. TZ := Upcase (TZ);
  344. (* Timezone name *)
  345. I := 1;
  346. while (I <= Length (TZ)) and (TZ [I] in ['A'..'Z']) do
  347. Inc (I);
  348. TZName := Copy (TZ, 1, Pred (I));
  349. if I <= Length (TZ) then
  350. begin
  351. (* Timezone shift *)
  352. J := Succ (I);
  353. while (J <= Length (TZ)) and not (TZ [J] in ['A'..'Z']) do
  354. Inc (J);
  355. TZOffset := ParseOffset (Copy (TZ, I, J - I));
  356. (* DST timezone name *)
  357. I := J;
  358. while (J <= Length (TZ)) and (TZ [J] in ['A'..'Z']) do
  359. Inc (J);
  360. if J > I then
  361. begin
  362. TZDSTName := Copy (TZ, I, J - I);
  363. (* DST timezone name provided; if equal to the standard timezone *)
  364. (* name then DSTOffset is set to be equal to TZOffset by default, *)
  365. (* otherwise it is set to TZOffset - 3600 seconds. *)
  366. if TZDSTName <> TZName then
  367. DSTOffset := -3600 + TZOffset
  368. else
  369. DSTOffset := TZOffset;
  370. end
  371. else
  372. begin
  373. TZDSTName := TZName;
  374. (* No DST timezone name provided => DSTOffset is equal to TZOffset *)
  375. DSTOffset := TZOffset;
  376. end;
  377. if J <= Length (TZ) then
  378. begin
  379. (* Check if DST offset is specified here; *)
  380. (* if not, default value set above is used. *)
  381. if TZ [J] <> ',' then
  382. begin
  383. I := J;
  384. Inc (J);
  385. while (J <= Length (TZ)) and (TZ [J] <> ',') do
  386. Inc (J);
  387. DSTOffset := ParseOffset (Copy (TZ, I, J - I));
  388. end;
  389. if J < Length (TZ) then
  390. begin
  391. Inc (J);
  392. (* DST switching details *)
  393. case TZ [J] of
  394. 'M':
  395. begin
  396. (* Mmonth.week.dayofweek[/StartHour] *)
  397. ADSTStartSpecType := DSTMonthWeekDay;
  398. if J >= Length (TZ) then
  399. Exit;
  400. Inc (J);
  401. I := J;
  402. while (J <= Length (TZ)) and not (TZ [J] in ['.', ',', '/']) do
  403. Inc (J);
  404. if (J >= Length (TZ)) or (TZ [J] <> '.') then
  405. Exit;
  406. Val (Copy (TZ, I, J - I), ADSTStartMonth, Err);
  407. if (Err > 0) or (ADSTStartMonth > 12) then
  408. Exit;
  409. Inc (J);
  410. I := J;
  411. while (J <= Length (TZ)) and not (TZ [J] in ['.', ',', '/']) do
  412. Inc (J);
  413. if (J >= Length (TZ)) or (TZ [J] <> '.') then
  414. Exit;
  415. Val (Copy (TZ, I, J - I), ADSTStartWeek, Err);
  416. if (Err > 0) or (ADSTStartWeek < 1) or (ADSTStartWeek > 5) then
  417. Exit;
  418. Inc (J);
  419. I := J;
  420. while (J <= Length (TZ)) and not (TZ [J] in [',', '/']) do
  421. Inc (J);
  422. Val (Copy (TZ, I, J - I), ADSTStartDay, Err);
  423. if (Err > 0) or (ADSTStartDay > 6) or (J >= Length (TZ)) then
  424. Exit;
  425. if TZ [J] = '/' then
  426. begin
  427. Inc (J);
  428. I := J;
  429. while (J <= Length (TZ)) and (TZ [J] <> ',') do
  430. Inc (J);
  431. Val (Copy (TZ, I, J - I), ADSTStartSec, Err);
  432. if (Err > 0) or (ADSTStartSec > MaxSecond) or (J >= Length (TZ))
  433. then
  434. Exit
  435. else
  436. ADSTStartSec := ADSTStartSec * 3600;
  437. end
  438. else
  439. (* Use the preset default *)
  440. ADSTStartSec := DSTStartSec;
  441. Inc (J);
  442. end;
  443. 'J':
  444. begin
  445. (* Jjulianday[/StartHour] *)
  446. ADSTStartSpecType := DSTJulianX;
  447. if J >= Length (TZ) then
  448. Exit;
  449. Inc (J);
  450. I := J;
  451. while (J <= Length (TZ)) and not (TZ [J] in [',', '/']) do
  452. Inc (J);
  453. Val (Copy (TZ, I, J - I), ADSTStartDay, Err);
  454. if (Err > 0) or (ADSTStartDay = 0) or (ADSTStartDay > 365)
  455. or (J >= Length (TZ)) then
  456. Exit;
  457. if TZ [J] = '/' then
  458. begin
  459. Inc (J);
  460. I := J;
  461. while (J <= Length (TZ)) and (TZ [J] <> ',') do
  462. Inc (J);
  463. Val (Copy (TZ, I, J - I), ADSTStartSec, Err);
  464. if (Err > 0) or (ADSTStartSec > MaxSecond) or (J >= Length (TZ))
  465. then
  466. Exit
  467. else
  468. ADSTStartSec := ADSTStartSec * 3600;
  469. end
  470. else
  471. (* Use the preset default *)
  472. ADSTStartSec := DSTStartSec;
  473. Inc (J);
  474. end
  475. else
  476. begin
  477. (* Check the used format first - GNU libc / GCC / EMX expect *)
  478. (* "NameOffsetDstname[Dstoffset],Start[/StartHour],End[/EndHour]"; *)
  479. (* if more than one comma (',') is found, the following format is assumed: *)
  480. (* "NameOffsetDstname[Dstoffset],StartMonth,StartWeek,StartDay,StartSecond, *)
  481. (* EndMonth,EndWeek,EndDay,EndSecond,DSTDifference". *)
  482. I := J;
  483. while (J <= Length (TZ)) and (TZ [J] <> ',') do
  484. Inc (J);
  485. S := Copy (TZ, I, J - I);
  486. if J < Length (TZ) then
  487. begin
  488. Inc (J);
  489. I := J;
  490. while (J <= Length (TZ)) and (TZ [J] <> ',') do
  491. Inc (J);
  492. GnuFmt := J > Length (TZ);
  493. end
  494. else
  495. Exit;
  496. if GnuFmt then
  497. begin
  498. ADSTStartSpecType := DSTJulian;
  499. J := Pos ('/', S);
  500. if J = 0 then
  501. begin
  502. Val (S, ADSTStartDay, Err);
  503. if (Err > 0) or (ADSTStartDay > 365) then
  504. Exit;
  505. (* Use the preset default *)
  506. ADSTStartSec := DSTStartSec;
  507. end
  508. else
  509. begin
  510. if J = Length (S) then
  511. Exit;
  512. Val (Copy (S, 1, Pred (J)), ADSTStartDay, Err);
  513. if (Err > 0) or (ADSTStartDay > 365) then
  514. Exit;
  515. Val (Copy (S, Succ (J), Length (S) - J), ADSTStartSec, Err);
  516. if (Err > 0) or (ADSTStartSec > MaxSecond) then
  517. Exit
  518. else
  519. ADSTStartSec := ADSTStartSec * 3600;
  520. end;
  521. J := I;
  522. end
  523. else
  524. begin
  525. Val (S, ADSTStartMonth, Err);
  526. if (Err > 0) or (ADSTStartMonth > 12) then
  527. Exit;
  528. Val (Copy (TZ, I, J - I), ADSTStartWeek, Err);
  529. if (Err > 0) or (ADSTStartWeek < -1) or (ADSTStartWeek > 5) or
  530. (J >= Length (TZ)) then
  531. Exit;
  532. Inc (J);
  533. I := J;
  534. while (J <= Length (TZ)) and (TZ [J] <> ',') do
  535. Inc (J);
  536. Val (Copy (TZ, I, J - I), ADSTStartDay, Err);
  537. if (DSTStartWeek = 0) then
  538. begin
  539. if (Err > 0) or (ADSTStartDay < 1) or (ADSTStartDay > 31)
  540. or (ADSTStartDay > 30) and (ADSTStartMonth in [4, 6, 9, 11])
  541. or (ADSTStartMonth = 2) and (ADSTStartDay > 29) then
  542. Exit;
  543. ADSTStartSpecType := DSTMonthDay;
  544. end
  545. else
  546. begin
  547. if (Err > 0) or (ADSTStartDay > 6) then
  548. Exit;
  549. ADSTStartSpecType := DSTMonthWeekDay;
  550. end;
  551. if J >= Length (TZ) then
  552. Exit;
  553. Inc (J);
  554. I := J;
  555. while (J <= Length (TZ)) and (TZ [J] <> ',') do
  556. Inc (J);
  557. Val (Copy (TZ, I, J - I), ADSTStartSec, Err);
  558. if (Err > 0) or (ADSTStartSec > MaxSecond) or
  559. (J >= Length (TZ)) then
  560. Exit;
  561. Inc (J);
  562. I := J;
  563. while (J <= Length (TZ)) and (TZ [J] <> ',') do
  564. Inc (J);
  565. Val (Copy (TZ, I, J - I), ADSTEndMonth, Err);
  566. if (Err > 0) or (ADSTEndMonth > 12) or (J >= Length (TZ)) then
  567. Exit;
  568. Inc (J);
  569. I := J;
  570. while (J <= Length (TZ)) and (TZ [J] <> ',') do
  571. Inc (J);
  572. Val (Copy (TZ, I, J - I), ADSTEndWeek, Err);
  573. if (Err > 0) or (ADSTEndWeek < -1) or (ADSTEndWeek > 5)
  574. or (J >= Length (TZ)) then
  575. Exit;
  576. Inc (J);
  577. I := J;
  578. while (J <= Length (TZ)) and (TZ [J] <> ',') do
  579. Inc (J);
  580. Val (Copy (TZ, I, J - I), ADSTEndDay, Err);
  581. if (DSTEndWeek = 0) then
  582. begin
  583. if (Err > 0) or (ADSTEndDay < 1) or (ADSTEndDay > 31)
  584. or (ADSTEndDay > 30) and (ADSTEndMonth in [4, 6, 9, 11])
  585. or (ADSTEndMonth = 2) and (ADSTEndDay > 29) then
  586. Exit;
  587. ADSTEndSpecType := DSTMonthDay;
  588. end
  589. else
  590. begin
  591. if (Err > 0) or (ADSTEndDay > 6) then
  592. Exit;
  593. ADSTEndSpecType := DSTMonthWeekDay;
  594. end;
  595. if J >= Length (TZ) then
  596. Exit;
  597. Inc (J);
  598. I := J;
  599. while (J <= Length (TZ)) and (TZ [J] <> ',') do
  600. Inc (J);
  601. Val (Copy (TZ, I, J - I), ADSTEndSec, Err);
  602. if (Err > 0) or (ADSTEndSec > MaxSecond) or
  603. (J >= Length (TZ)) then
  604. Exit;
  605. Val (Copy (TZ, Succ (J), Length (TZ) - J), ADSTChangeSec, Err);
  606. if (Err = 0) and (ADSTChangeSec < 86400) then
  607. begin
  608. (* Format complete, all checks successful => accept the parsed values. *)
  609. DSTStartMonth := ADSTStartMonth;
  610. DSTStartWeek := ADSTStartWeek;
  611. DSTStartDay := ADSTStartDay;
  612. DSTStartSec := ADSTStartSec;
  613. DSTEndMonth := ADSTEndMonth;
  614. DSTEndWeek := ADSTEndWeek;
  615. DSTEndDay := ADSTEndDay;
  616. DSTEndSec := ADSTEndSec;
  617. DSTStartSpecType := ADSTStartSpecType;
  618. DSTEndSpecType := ADSTEndSpecType;
  619. DSTOffset := TZOffset - ADSTChangeSec;
  620. end;
  621. (* Parsing finished *)
  622. Exit;
  623. end;
  624. end;
  625. end;
  626. (* GnuFmt - DST end specification *)
  627. if TZ [J] = 'M' then
  628. begin
  629. (* Mmonth.week.dayofweek *)
  630. ADSTEndSpecType := DSTMonthWeekDay;
  631. if J >= Length (TZ) then
  632. Exit;
  633. Inc (J);
  634. I := J;
  635. while (J <= Length (TZ)) and not (TZ [J] in ['.', ',', '/']) do
  636. Inc (J);
  637. if (J >= Length (TZ)) or (TZ [J] <> '.') then
  638. Exit;
  639. Val (Copy (TZ, I, J - I), ADSTEndMonth, Err);
  640. if (Err > 0) or (ADSTEndMonth > 12) then
  641. Exit;
  642. Inc (J);
  643. I := J;
  644. while (J <= Length (TZ)) and not (TZ [J] in ['.', ',', '/']) do
  645. Inc (J);
  646. if (J >= Length (TZ)) or (TZ [J] <> '.') then
  647. Exit;
  648. Val (Copy (TZ, I, J - I), ADSTEndWeek, Err);
  649. if (Err > 0) or (ADSTEndWeek < 1) or (ADSTEndWeek > 5) then
  650. Exit;
  651. Inc (J);
  652. I := J;
  653. while (J <= Length (TZ)) and (TZ [J] <> '/') do
  654. Inc (J);
  655. Val (Copy (TZ, I, J - I), ADSTEndDay, Err);
  656. if (Err > 0) or (ADSTEndDay > 6) then
  657. Exit;
  658. end
  659. else
  660. begin
  661. if TZ [J] = 'J' then
  662. begin
  663. (* Jjulianday *)
  664. if J = Length (TZ) then
  665. Exit;
  666. Inc (J);
  667. ADSTEndSpecType := DSTJulianX
  668. end
  669. else
  670. ADSTEndSpecType := DSTJulian;
  671. if J >= Length (TZ) then
  672. Exit;
  673. Inc (J);
  674. I := J;
  675. while (J <= Length (TZ)) and (TZ [J] <> '/') do
  676. Inc (J);
  677. Val (Copy (TZ, I, J - I), ADSTEndDay, Err);
  678. if (Err > 0) or (ADSTEndDay = 0) and (ADSTEndSpecType = DSTJulianX)
  679. or (ADSTEndDay > 365) then
  680. Exit;
  681. end;
  682. if (J <= Length (TZ)) and (TZ [J] = '/') then
  683. begin
  684. if J = Length (TZ) then
  685. Exit;
  686. Val (Copy (TZ, Succ (J), Length (TZ) - J), ADSTEndSec, Err);
  687. if (Err > 0) or (ADSTEndSec > MaxSecond) then
  688. Exit
  689. else
  690. ADSTEndSec := ADSTEndSec * 3600;
  691. end
  692. else
  693. (* Use the preset default *)
  694. ADSTEndSec := DSTEndSec;
  695. (* Format complete, all checks successful => accept the parsed values. *)
  696. if ADSTStartSpecType = DSTMonthWeekDay then
  697. begin
  698. DSTStartMonth := ADSTStartMonth;
  699. DSTStartWeek := ADSTStartWeek;
  700. end;
  701. DSTStartDay := ADSTStartDay;
  702. DSTStartSec := ADSTStartSec;
  703. if ADSTStartSpecType = DSTMonthWeekDay then
  704. begin
  705. DSTEndMonth := ADSTEndMonth;
  706. DSTEndWeek := ADSTEndWeek;
  707. end;
  708. DSTEndDay := ADSTEndDay;
  709. DSTEndSec := ADSTEndSec;
  710. DSTStartSpecType := ADSTStartSpecType;
  711. DSTEndSpecType := ADSTEndSpecType;
  712. end;
  713. end
  714. else
  715. DSTOffset := -3600 + TZOffset;
  716. end;
  717. end;
  718. end;
  719. procedure InitTZ;
  720. var
  721. L: longint;
  722. SystemTime: TSystemTime;
  723. Y: word absolute SystemTime.Year;
  724. Mo: word absolute SystemTime.Month;
  725. D: word absolute SystemTime.Day;
  726. WD: word absolute SystemTime.DayOfWeek;
  727. begin
  728. InitTZ0;
  729. TZOffsetMin := TZOffset div 60;
  730. DSTOffsetMin := DSTOffset div 60;
  731. if DSTOffset <> TZOffset then
  732. begin
  733. GetLocalTime (SystemTime);
  734. if (DSTStartSpecType = DSTMonthWeekDay) or (DSTStartSpecType = DSTMonthDay)
  735. then
  736. begin
  737. RealDSTStartMonth := DSTStartMonth;
  738. if DSTStartSpecType = DSTMonthDay then
  739. RealDSTStartDay := DSTStartDay
  740. else
  741. begin
  742. RealDSTStartDay := FirstDay (DSTStartMonth, Y, Mo, D, WD);
  743. if (DSTStartWeek >= 1) and (DSTStartWeek <= 4) then
  744. if DSTStartDay < RealDSTStartDay then
  745. RealDSTStartDay := DSTStartWeek * 7 + DSTStartDay - RealDSTStartDay
  746. + 1
  747. else
  748. RealDSTStartDay := Pred (DSTStartWeek) * 7 + DSTStartDay
  749. - RealDSTStartDay + 1
  750. else
  751. (* Last week in month *)
  752. begin
  753. RealDSTStartDay := RealDSTStartDay
  754. + MonthDays [false, RealDSTStartMonth] - 1;
  755. if RealDSTStartMonth = 2 then
  756. Inc (RealDSTStartDay, LeapDay (Y));
  757. RealDSTStartDay := RealDSTStartDay mod 7;
  758. if RealDSTStartDay < DSTStartDay then
  759. RealDSTStartDay := RealDSTStartDay + 7 - DSTStartDay
  760. else
  761. RealDSTStartDay := RealDSTStartDay - DSTStartDay;
  762. RealDSTStartDay := MonthDays [false, RealDSTStartMonth]
  763. - RealDSTStartDay;
  764. end;
  765. end;
  766. end
  767. else
  768. begin
  769. (* Julian day *)
  770. L := DSTStartDay;
  771. if (DSTStartSpecType = DSTJulian) then
  772. (* 0-based *)
  773. if (L + LeapDay (Y) <= 59) then
  774. Inc (L)
  775. else
  776. L := L + 1 - LeapDay (Y);
  777. if L <= 31 then
  778. begin
  779. RealDSTStartMonth := 1;
  780. RealDSTStartDay := L;
  781. end
  782. else
  783. if (L <= 59) or
  784. (DSTStartSpecType = DSTJulian) and (L - LeapDay (Y) <= 59) then
  785. begin
  786. RealDSTStartMonth := 2;
  787. RealDSTStartDay := DSTStartDay - 31;
  788. end
  789. else
  790. begin
  791. RealDSTStartMonth := 3;
  792. while (RealDSTStartMonth < 12) and (MonthEnds [RealDSTStartMonth] > L)
  793. do
  794. Inc (RealDSTStartMonth);
  795. RealDSTStartDay := L - MonthEnds [Pred (RealDSTStartMonth)];
  796. end;
  797. end;
  798. if (DSTEndSpecType = DSTMonthWeekDay) or (DSTEndSpecType = DSTMonthDay) then
  799. begin
  800. RealDSTEndMonth := DSTEndMonth;
  801. if DSTEndSpecType = DSTMonthDay then
  802. RealDSTEndDay := DSTEndDay
  803. else
  804. begin
  805. RealDSTEndDay := FirstDay (DSTEndMonth, Y, Mo, D, WD);
  806. if (DSTEndWeek >= 1) and (DSTEndWeek <= 4) then
  807. if DSTEndDay < RealDSTEndDay then
  808. RealDSTEndDay := DSTEndWeek * 7 + DSTEndDay - RealDSTEndDay + 1
  809. else
  810. RealDSTEndDay := Pred (DSTEndWeek) * 7 + DSTEndDay - RealDSTEndDay
  811. + 1
  812. else
  813. (* Last week in month *)
  814. begin
  815. RealDSTEndDay := RealDSTEndDay + MonthDays [false, RealDSTEndMonth]
  816. - 1;
  817. if RealDSTEndMonth = 2 then
  818. Inc (RealDSTEndDay, LeapDay (Y));
  819. RealDSTEndDay := RealDSTEndDay mod 7;
  820. if RealDSTEndDay < DSTEndDay then
  821. RealDSTEndDay := RealDSTEndDay + 7 - DSTEndDay
  822. else
  823. RealDSTEndDay := RealDSTEndDay - DSTEndDay;
  824. RealDSTEndDay := MonthDays [false, RealDSTEndMonth] - RealDSTEndDay;
  825. end;
  826. end;
  827. end
  828. else
  829. begin
  830. (* Julian day *)
  831. L := DSTEndDay;
  832. if (DSTEndSpecType = DSTJulian) then
  833. (* 0-based *)
  834. if (L + LeapDay (Y) <= 59) then
  835. Inc (L)
  836. else
  837. L := L + 1 - LeapDay (Y);
  838. if L <= 31 then
  839. begin
  840. RealDSTEndMonth := 1;
  841. RealDSTEndDay := L;
  842. end
  843. else
  844. if (L <= 59) or
  845. (DSTEndSpecType = DSTJulian) and (L - LeapDay (Y) <= 59) then
  846. begin
  847. RealDSTEndMonth := 2;
  848. RealDSTEndDay := DSTEndDay - 31;
  849. end
  850. else
  851. begin
  852. RealDSTEndMonth := 3;
  853. while (RealDSTEndMonth < 12) and (MonthEnds [RealDSTEndMonth] > L) do
  854. Inc (RealDSTEndMonth);
  855. RealDSTEndDay := L - MonthEnds [Pred (RealDSTEndMonth)];
  856. end;
  857. end;
  858. end;
  859. end;
  860. {$IFNDEF HAS_DUAL_TZHANDLING}
  861. function GetUniversalTime (var SystemTime: TSystemTime): boolean;
  862. begin
  863. GetLocalTime (SystemTime);
  864. UpdateTimeWithOffset (SystemTime, GetLocalTimeOffset);
  865. GetUniversalTime := true;
  866. end;
  867. function GetLocalTimeOffset: integer;
  868. begin
  869. if InDST then
  870. GetLocalTimeOffset := DSTOffsetMin
  871. else
  872. GetLocalTimeOffset := TZOffsetMin;
  873. end;
  874. {$ENDIF HAS_DUAL_TZHANDLING}
  875. function GetLocalTimeOffset(const DateTime: TDateTime; const InputIsUTC: boolean; out Offset: integer): boolean;
  876. var
  877. SystemTime: TSystemTime;
  878. begin
  879. DateTimeToSystemTime (DateTime, SystemTime);
  880. if InDST (SystemTime, InputIsUTC) then
  881. Offset := DSTOffsetMin
  882. else
  883. Offset := TZOffsetMin;
  884. GetLocalTimeOffset := true;
  885. end;