tzenv.inc 28 KB

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