123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916 |
- {
- This file is part of the Free Pascal run time library.
- Copyright (c) 2020 by Tomas Hajny,
- member of the Free Pascal development team.
- Support routines for calculation of local timezone and DST time
- offset based on information provided in the environment variable TZ.
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- type
- DSTSpecType = (DSTMonthWeekDay, DSTMonthDay, DSTJulian, DSTJulianX);
- const
- TZEnvName = 'TZ';
- {$IFDEF OS2}
- EMXTZEnvName = 'EMXTZ';
- {$ENDIF OS2}
- MaxSecond = 86399;
- (* The following values differing from the defaults *)
- (* below are not used at the moment. *)
- USDSTStartMonth = 3;
- USDSTStartWeek = 2;
- USDSTEndMonth = 11;
- USDSTEndWeek = 1;
- EUDSTStartMonth = 3;
- EUDSTStartWeek = -1;
- (* Initialized to default values, updated after a call to InitTZ *)
- TZName: string = '';
- TZDSTName: string = '';
- TZOffset: longint = 0;
- TZOffsetMin: longint = 0;
- DSTOffset: longint = 0;
- DSTOffsetMin: longint = 0;
- DSTStartMonth: byte = 4;
- DSTStartWeek: shortint = 1;
- DSTStartDay: word = 0;
- DSTStartSec: cardinal = 7200;
- DSTEndMonth: byte = 10;
- DSTEndWeek: shortint = -1;
- DSTEndDay: word = 0;
- DSTEndSec: cardinal = 10800;
- DSTStartSpecType: DSTSpecType = DSTMonthWeekDay;
- DSTEndSpecType: DSTSpecType = DSTMonthWeekDay;
- (* The following variables are initialized after a call to InitTZ. *)
- var
- RealDSTStartMonth, RealDSTStartDay, RealDSTEndMonth, RealDSTEndDay: byte;
- const
- MonthEnds: array [1..12] of word =
- (31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365);
- function LeapDay (Year: word): byte; inline;
- begin
- if IsLeapYear (Year) then
- LeapDay := 1
- else
- LeapDay := 0;
- end;
- function FirstDay (MM: byte; Y: word; Mo: word; D: word; WD: word): byte;
- inline;
- var
- DD: longint;
- begin
- if MM < Mo then
- begin
- DD := D + MonthEnds [Pred (Mo)];
- if MM > 1 then
- Dec (DD, MonthEnds [Pred (MM)]);
- if (MM <= 2) and (Mo > 2) then
- Inc (DD, LeapDay (Y));
- end
- else
- if MM > Mo then
- begin
- DD := - MonthDays [false, Mo] + D - MonthEnds [Pred (MM)]
- + MonthEnds [Mo];
- if (Mo <= 2) and (MM > 2) then
- Dec (DD, LeapDay (Y));
- end
- else
- (* M = MM *)
- DD := D;
- DD := WD - DD mod 7 + 1;
- if DD < 0 then
- FirstDay := DD + 7
- else
- FirstDay := DD mod 7;
- end;
- procedure UpdateTimeWithOffset (var SystemTime: TSystemTime; Offset: longint);
- inline;
- var
- Y: longint;
- Mo: longint;
- D: longint;
- WD: word;
- H: longint;
- Mi: longint;
- begin
- with SystemTime do
- begin
- Y := Year;
- Mo := Month;
- D := Day;
- WD := DayOfWeek;
- H := Hour;
- Mi := Minute;
- end;
- Mi := Mi + (Offset mod 60);
- H := H + (Offset div 60);
- if Mi < 0 then
- begin
- Inc (Mi, 60);
- Dec (H);
- end;
- if H < 0 then
- begin
- Inc (H, 24);
- if WD = 0 then
- WD := 6
- else
- Dec (WD);
- if D = 1 then
- begin
- if Mo = 1 then
- begin
- Dec (Y);
- Mo := 12;
- end
- else
- Dec (Mo);
- D := MonthDays [IsLeapYear (Y), Mo];
- end
- else
- Dec (D);
- end
- else
- begin
- if Mi > 59 then
- begin
- Dec (Mi, 60);
- Inc (H);
- end;
- if H > 23 then
- begin
- Dec (H, 24);
- if WD = 6 then
- WD := 0
- else
- Inc (WD);
- if D = MonthDays [IsLeapYear (Y), Mo] then
- begin
- D := 1;
- if Mo = 12 then
- begin
- Inc (Y);
- Mo := 1;
- end
- else
- Inc (Mo);
- end
- else
- Inc (D);
- end;
- end;
- with SystemTime do
- begin
- Year := Y;
- Month := Mo;
- Day := D;
- DayOfWeek := WD;
- Hour := H;
- Minute := Mi;
- end;
- end;
- function InDST (const Time: TSystemTime; const InputIsUTC: boolean): boolean;
- var
- AfterDSTStart, BeforeDSTEnd: boolean;
- Y: longint;
- Mo: longint;
- D: longint;
- WD: longint;
- Second: longint;
- begin
- InDST := false;
- if DSTOffset <> TZOffset then
- begin
- Second := longint (Time.Hour) * 3600 + Time.Minute * 60 + Time.Second;
- Y := Time.Year;
- Mo := Time.Month;
- D := Time.Day;
- if InputIsUTC and (TZOffset <> 0) then
- begin
- Second := Second - TZOffset;
- if Second < 0 then
- begin
- Second := Second + MaxSecond + 1;
- if D = 1 then
- begin
- if Mo = 1 then
- begin
- Dec (Y);
- Mo := 12;
- end
- else
- Dec (Mo);
- D := MonthDays [IsLeapYear (Y), Mo];
- end
- else
- Dec (D);
- end
- else
- if Second > MaxSecond then
- begin
- Second := Second - MaxSecond - 1;
- if D = MonthDays [IsLeapYear (Y), Mo] then
- begin
- D := 1;
- if Mo = 12 then
- begin
- Inc (Y);
- Mo := 1;
- end
- else
- Inc (Mo);
- end
- else
- Inc (D);
- end;
- end;
- if Mo < RealDSTStartMonth then
- AfterDSTStart := false
- else
- if Mo > RealDSTStartMonth then
- AfterDSTStart := true
- else
- if D < RealDSTStartDay then
- AfterDSTStart := false
- else
- if D > RealDSTStartDay then
- AfterDSTStart := true
- else
- AfterDSTStart := Second > DSTStartSec;
- if Mo > RealDSTEndMonth then
- BeforeDSTEnd := false
- else
- if Mo < RealDSTEndMonth then
- BeforeDSTEnd := true
- else
- if D > RealDSTEndDay then
- BeforeDSTEnd := false
- else
- if D < RealDSTEndDay then
- BeforeDSTEnd := true
- else
- BeforeDSTEnd := Second < DSTEndSec;
- InDST := AfterDSTStart and BeforeDSTEnd;
- end;
- end;
- function InDST: boolean; inline;
- var
- SystemTime: TSystemTime;
- begin
- InDST := false;
- if DSTOffset <> TZOffset then
- begin
- GetLocalTime (SystemTime);
- InDST := InDST (SystemTime, false);
- end;
- end;
- procedure InitTZ0; inline;
- var
- TZ, S: string;
- I, J: byte;
- Err: longint;
- GnuFmt: boolean;
- ADSTStartMonth: byte;
- ADSTStartWeek: shortint;
- ADSTStartDay: word;
- ADSTStartSec: cardinal;
- ADSTEndMonth: byte;
- ADSTEndWeek: shortint;
- ADSTEndDay: word;
- ADSTEndSec: cardinal;
- ADSTStartSpecType: DSTSpecType;
- ADSTEndSpecType: DSTSpecType;
- ADSTChangeSec: cardinal;
- function ParseOffset (OffStr: string): longint;
- (* Parse time offset given as [-|+]HH[:MI[:SS]] and return in seconds *)
- var
- TZShiftHH, TZShiftDir: shortint;
- TZShiftMI, TZShiftSS: byte;
- N1, N2: byte;
- begin
- TZShiftHH := 0;
- TZShiftMI := 0;
- TZShiftSS := 0;
- TZShiftDir := 1;
- N1 := 1;
- while (N1 <= Length (OffStr)) and (OffStr [N1] <> ':') do
- Inc (N1);
- Val (Copy (OffStr, 1, Pred (N1)), TZShiftHH, Err);
- if (Err = 0) and (TZShiftHH >= -24) and (TZShiftHH <= 23) then
- begin
- (* Normalize the hour offset to -12..11 if necessary *)
- if TZShiftHH > 11 then
- Dec (TZShiftHH, 24) else
- if TZShiftHH < -12 then
- Inc (TZShiftHH, 24);
- if TZShiftHH < 0 then
- TZShiftDir := -1;
- if (N1 <= Length (OffStr)) then
- begin
- N2 := Succ (N1);
- while (N2 <= Length (OffStr)) and (OffStr [N2] <> ':') do
- Inc (N2);
- Val (Copy (OffStr, Succ (N1), N2 - N1), TZShiftMI, Err);
- if (Err = 0) and (TZShiftMI <= 59) then
- begin
- if (N2 <= Length (OffStr)) then
- begin
- Val (Copy (OffStr, Succ (N2), Length (OffStr) - N2), TZShiftSS, Err);
- if (Err <> 0) or (TZShiftSS > 59) then
- TZShiftSS := 0;
- end
- end
- else
- TZShiftMI := 0;
- end;
- end
- else
- TZShiftHH := 0;
- ParseOffset := longint (TZShiftHH) * 3600 +
- TZShiftDir * (longint (TZShiftMI) * 60 + TZShiftSS);
- end;
- begin
- TZ := GetEnvironmentVariable (TZEnvName);
- {$IFDEF OS2}
- if TZ = '' then
- TZ := GetEnvironmentVariable (EMXTZEnvName);
- {$ENDIF OS2}
- if TZ <> '' then
- begin
- TZ := Upcase (TZ);
- (* Timezone name *)
- I := 1;
- while (I <= Length (TZ)) and (TZ [I] in ['A'..'Z']) do
- Inc (I);
- TZName := Copy (TZ, 1, Pred (I));
- if I <= Length (TZ) then
- begin
- (* Timezone shift *)
- J := Succ (I);
- while (J <= Length (TZ)) and not (TZ [J] in ['A'..'Z']) do
- Inc (J);
- TZOffset := ParseOffset (Copy (TZ, I, J - I));
- (* DST timezone name *)
- I := J;
- while (J <= Length (TZ)) and (TZ [J] in ['A'..'Z']) do
- Inc (J);
- if J > I then
- begin
- TZDSTName := Copy (TZ, I, J - I);
- (* DST timezone name provided; if equal to the standard timezone *)
- (* name then DSTOffset is set to be equal to TZOffset by default, *)
- (* otherwise it is set to TZOffset - 3600 seconds. *)
- if TZDSTName <> TZName then
- DSTOffset := -3600 + TZOffset
- else
- DSTOffset := TZOffset;
- end
- else
- begin
- TZDSTName := TZName;
- (* No DST timezone name provided => DSTOffset is equal to TZOffset *)
- DSTOffset := TZOffset;
- end;
- if J <= Length (TZ) then
- begin
- (* Check if DST offset is specified here; *)
- (* if not, default value set above is used. *)
- if TZ [J] <> ',' then
- begin
- I := J;
- Inc (J);
- while (J <= Length (TZ)) and (TZ [J] <> ',') do
- Inc (J);
- DSTOffset := ParseOffset (Copy (TZ, I, J - I));
- end;
- if J < Length (TZ) then
- begin
- Inc (J);
- (* DST switching details *)
- case TZ [J] of
- 'M':
- begin
- (* Mmonth.week.dayofweek[/StartHour] *)
- ADSTStartSpecType := DSTMonthWeekDay;
- if J >= Length (TZ) then
- Exit;
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and not (TZ [J] in ['.', ',', '/']) do
- Inc (J);
- if (J >= Length (TZ)) or (TZ [J] <> '.') then
- Exit;
- Val (Copy (TZ, I, J - I), ADSTStartMonth, Err);
- if (Err > 0) or (ADSTStartMonth > 12) then
- Exit;
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and not (TZ [J] in ['.', ',', '/']) do
- Inc (J);
- if (J >= Length (TZ)) or (TZ [J] <> '.') then
- Exit;
- Val (Copy (TZ, I, J - I), ADSTStartWeek, Err);
- if (Err > 0) or (ADSTStartWeek < 1) or (ADSTStartWeek > 5) then
- Exit;
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and not (TZ [J] in [',', '/']) do
- Inc (J);
- Val (Copy (TZ, I, J - I), ADSTStartDay, Err);
- if (Err > 0) or (ADSTStartDay > 6) or (J >= Length (TZ)) then
- Exit;
- if TZ [J] = '/' then
- begin
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and (TZ [J] <> ',') do
- Inc (J);
- Val (Copy (TZ, I, J - I), ADSTStartSec, Err);
- if (Err > 0) or (ADSTStartSec > MaxSecond) or (J >= Length (TZ))
- then
- Exit
- else
- ADSTStartSec := ADSTStartSec * 3600;
- end
- else
- (* Use the preset default *)
- ADSTStartSec := DSTStartSec;
- Inc (J);
- end;
- 'J':
- begin
- (* Jjulianday[/StartHour] *)
- ADSTStartSpecType := DSTJulianX;
- if J >= Length (TZ) then
- Exit;
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and not (TZ [J] in [',', '/']) do
- Inc (J);
- Val (Copy (TZ, I, J - I), ADSTStartDay, Err);
- if (Err > 0) or (ADSTStartDay = 0) or (ADSTStartDay > 365)
- or (J >= Length (TZ)) then
- Exit;
- if TZ [J] = '/' then
- begin
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and (TZ [J] <> ',') do
- Inc (J);
- Val (Copy (TZ, I, J - I), ADSTStartSec, Err);
- if (Err > 0) or (ADSTStartSec > MaxSecond) or (J >= Length (TZ))
- then
- Exit
- else
- ADSTStartSec := ADSTStartSec * 3600;
- end
- else
- (* Use the preset default *)
- ADSTStartSec := DSTStartSec;
- Inc (J);
- end
- else
- begin
- (* Check the used format first - GNU libc / GCC / EMX expect *)
- (* "NameOffsetDstname[Dstoffset],Start[/StartHour],End[/EndHour]"; *)
- (* if more than one comma (',') is found, the following format is assumed: *)
- (* "NameOffsetDstname[Dstoffset],StartMonth,StartWeek,StartDay,StartSecond, *)
- (* EndMonth,EndWeek,EndDay,EndSecond,DSTDifference". *)
- I := J;
- while (J <= Length (TZ)) and (TZ [J] <> ',') do
- Inc (J);
- S := Copy (TZ, I, J - I);
- if J < Length (TZ) then
- begin
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and (TZ [J] <> ',') do
- Inc (J);
- GnuFmt := J > Length (TZ);
- end
- else
- Exit;
- if GnuFmt then
- begin
- ADSTStartSpecType := DSTJulian;
- J := Pos ('/', S);
- if J = 0 then
- begin
- Val (S, ADSTStartDay, Err);
- if (Err > 0) or (ADSTStartDay > 365) then
- Exit;
- (* Use the preset default *)
- ADSTStartSec := DSTStartSec;
- end
- else
- begin
- if J = Length (S) then
- Exit;
- Val (Copy (S, 1, Pred (J)), ADSTStartDay, Err);
- if (Err > 0) or (ADSTStartDay > 365) then
- Exit;
- Val (Copy (S, Succ (J), Length (S) - J), ADSTStartSec, Err);
- if (Err > 0) or (ADSTStartSec > MaxSecond) then
- Exit
- else
- ADSTStartSec := ADSTStartSec * 3600;
- end;
- J := I;
- end
- else
- begin
- Val (S, ADSTStartMonth, Err);
- if (Err > 0) or (ADSTStartMonth > 12) then
- Exit;
- Val (Copy (TZ, I, J - I), ADSTStartWeek, Err);
- if (Err > 0) or (ADSTStartWeek < -1) or (ADSTStartWeek > 5) or
- (J >= Length (TZ)) then
- Exit;
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and (TZ [J] <> ',') do
- Inc (J);
- Val (Copy (TZ, I, J - I), ADSTStartDay, Err);
- if (DSTStartWeek = 0) then
- begin
- if (Err > 0) or (ADSTStartDay < 1) or (ADSTStartDay > 31)
- or (ADSTStartDay > 30) and (ADSTStartMonth in [4, 6, 9, 11])
- or (ADSTStartMonth = 2) and (ADSTStartDay > 29) then
- Exit;
- ADSTStartSpecType := DSTMonthDay;
- end
- else
- begin
- if (Err > 0) or (ADSTStartDay > 6) then
- Exit;
- ADSTStartSpecType := DSTMonthWeekDay;
- end;
- if J >= Length (TZ) then
- Exit;
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and (TZ [J] <> ',') do
- Inc (J);
- Val (Copy (TZ, I, J - I), ADSTStartSec, Err);
- if (Err > 0) or (ADSTStartSec > MaxSecond) or
- (J >= Length (TZ)) then
- Exit;
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and (TZ [J] <> ',') do
- Inc (J);
- Val (Copy (TZ, I, J - I), ADSTEndMonth, Err);
- if (Err > 0) or (ADSTEndMonth > 12) or (J >= Length (TZ)) then
- Exit;
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and (TZ [J] <> ',') do
- Inc (J);
- Val (Copy (TZ, I, J - I), ADSTEndWeek, Err);
- if (Err > 0) or (ADSTEndWeek < -1) or (ADSTEndWeek > 5)
- or (J >= Length (TZ)) then
- Exit;
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and (TZ [J] <> ',') do
- Inc (J);
- Val (Copy (TZ, I, J - I), ADSTEndDay, Err);
- if (DSTEndWeek = 0) then
- begin
- if (Err > 0) or (ADSTEndDay < 1) or (ADSTEndDay > 31)
- or (ADSTEndDay > 30) and (ADSTEndMonth in [4, 6, 9, 11])
- or (ADSTEndMonth = 2) and (ADSTEndDay > 29) then
- Exit;
- ADSTEndSpecType := DSTMonthDay;
- end
- else
- begin
- if (Err > 0) or (ADSTEndDay > 6) then
- Exit;
- ADSTEndSpecType := DSTMonthWeekDay;
- end;
- if J >= Length (TZ) then
- Exit;
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and (TZ [J] <> ',') do
- Inc (J);
- Val (Copy (TZ, I, J - I), ADSTEndSec, Err);
- if (Err > 0) or (ADSTEndSec > MaxSecond) or
- (J >= Length (TZ)) then
- Exit;
- Val (Copy (TZ, Succ (J), Length (TZ) - J), ADSTChangeSec, Err);
- if (Err = 0) and (ADSTChangeSec < 86400) then
- begin
- (* Format complete, all checks successful => accept the parsed values. *)
- DSTStartMonth := ADSTStartMonth;
- DSTStartWeek := ADSTStartWeek;
- DSTStartDay := ADSTStartDay;
- DSTStartSec := ADSTStartSec;
- DSTEndMonth := ADSTEndMonth;
- DSTEndWeek := ADSTEndWeek;
- DSTEndDay := ADSTEndDay;
- DSTEndSec := ADSTEndSec;
- DSTStartSpecType := ADSTStartSpecType;
- DSTEndSpecType := ADSTEndSpecType;
- DSTOffset := TZOffset - ADSTChangeSec;
- end;
- (* Parsing finished *)
- Exit;
- end;
- end;
- end;
- (* GnuFmt - DST end specification *)
- if TZ [J] = 'M' then
- begin
- (* Mmonth.week.dayofweek *)
- ADSTEndSpecType := DSTMonthWeekDay;
- if J >= Length (TZ) then
- Exit;
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and not (TZ [J] in ['.', ',', '/']) do
- Inc (J);
- if (J >= Length (TZ)) or (TZ [J] <> '.') then
- Exit;
- Val (Copy (TZ, I, J - I), ADSTEndMonth, Err);
- if (Err > 0) or (ADSTEndMonth > 12) then
- Exit;
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and not (TZ [J] in ['.', ',', '/']) do
- Inc (J);
- if (J >= Length (TZ)) or (TZ [J] <> '.') then
- Exit;
- Val (Copy (TZ, I, J - I), ADSTEndWeek, Err);
- if (Err > 0) or (ADSTEndWeek < 1) or (ADSTEndWeek > 5) then
- Exit;
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and (TZ [J] <> '/') do
- Inc (J);
- Val (Copy (TZ, I, J - I), ADSTEndDay, Err);
- if (Err > 0) or (ADSTEndDay > 6) then
- Exit;
- end
- else
- begin
- if TZ [J] = 'J' then
- begin
- (* Jjulianday *)
- if J = Length (TZ) then
- Exit;
- Inc (J);
- ADSTEndSpecType := DSTJulianX
- end
- else
- ADSTEndSpecType := DSTJulian;
- if J >= Length (TZ) then
- Exit;
- Inc (J);
- I := J;
- while (J <= Length (TZ)) and (TZ [J] <> '/') do
- Inc (J);
- Val (Copy (TZ, I, J - I), ADSTEndDay, Err);
- if (Err > 0) or (ADSTEndDay = 0) and (ADSTEndSpecType = DSTJulianX)
- or (ADSTEndDay > 365) then
- Exit;
- end;
- if (J <= Length (TZ)) and (TZ [J] = '/') then
- begin
- if J = Length (TZ) then
- Exit;
- Val (Copy (TZ, Succ (J), Length (TZ) - J), ADSTEndSec, Err);
- if (Err > 0) or (ADSTEndSec > MaxSecond) then
- Exit
- else
- ADSTEndSec := ADSTEndSec * 3600;
- end
- else
- (* Use the preset default *)
- ADSTEndSec := DSTEndSec;
- (* Format complete, all checks successful => accept the parsed values. *)
- if ADSTStartSpecType = DSTMonthWeekDay then
- begin
- DSTStartMonth := ADSTStartMonth;
- DSTStartWeek := ADSTStartWeek;
- end;
- DSTStartDay := ADSTStartDay;
- DSTStartSec := ADSTStartSec;
- if ADSTStartSpecType = DSTMonthWeekDay then
- begin
- DSTEndMonth := ADSTEndMonth;
- DSTEndWeek := ADSTEndWeek;
- end;
- DSTEndDay := ADSTEndDay;
- DSTEndSec := ADSTEndSec;
- DSTStartSpecType := ADSTStartSpecType;
- DSTEndSpecType := ADSTEndSpecType;
- end;
- end
- else
- DSTOffset := -3600 + TZOffset;
- end;
- end;
- end;
- procedure InitTZ;
- var
- L: longint;
- SystemTime: TSystemTime;
- Y: word absolute SystemTime.Year;
- Mo: word absolute SystemTime.Month;
- D: word absolute SystemTime.Day;
- WD: word absolute SystemTime.DayOfWeek;
- begin
- InitTZ0;
- TZOffsetMin := TZOffset div 60;
- DSTOffsetMin := DSTOffset div 60;
- if DSTOffset <> TZOffset then
- begin
- GetLocalTime (SystemTime);
- if (DSTStartSpecType = DSTMonthWeekDay) or (DSTStartSpecType = DSTMonthDay)
- then
- begin
- RealDSTStartMonth := DSTStartMonth;
- if DSTStartSpecType = DSTMonthDay then
- RealDSTStartDay := DSTStartDay
- else
- begin
- RealDSTStartDay := FirstDay (DSTStartMonth, Y, Mo, D, WD);
- if (DSTStartWeek >= 1) and (DSTStartWeek <= 4) then
- if DSTStartDay < RealDSTStartDay then
- RealDSTStartDay := DSTStartWeek * 7 + DSTStartDay - RealDSTStartDay
- + 1
- else
- RealDSTStartDay := Pred (DSTStartWeek) * 7 + DSTStartDay
- - RealDSTStartDay + 1
- else
- (* Last week in month *)
- begin
- RealDSTStartDay := RealDSTStartDay
- + MonthDays [false, RealDSTStartMonth] - 1;
- if RealDSTStartMonth = 2 then
- Inc (RealDSTStartDay, LeapDay (Y));
- RealDSTStartDay := RealDSTStartDay mod 7;
- if RealDSTStartDay < DSTStartDay then
- RealDSTStartDay := RealDSTStartDay + 7 - DSTStartDay
- else
- RealDSTStartDay := RealDSTStartDay - DSTStartDay;
- RealDSTStartDay := MonthDays [false, RealDSTStartMonth]
- - RealDSTStartDay;
- end;
- end;
- end
- else
- begin
- (* Julian day *)
- L := DSTStartDay;
- if (DSTStartSpecType = DSTJulian) then
- (* 0-based *)
- if (L + LeapDay (Y) <= 59) then
- Inc (L)
- else
- L := L + 1 - LeapDay (Y);
- if L <= 31 then
- begin
- RealDSTStartMonth := 1;
- RealDSTStartDay := L;
- end
- else
- if (L <= 59) or
- (DSTStartSpecType = DSTJulian) and (L - LeapDay (Y) <= 59) then
- begin
- RealDSTStartMonth := 2;
- RealDSTStartDay := DSTStartDay - 31;
- end
- else
- begin
- RealDSTStartMonth := 3;
- while (RealDSTStartMonth < 12) and (MonthEnds [RealDSTStartMonth] > L)
- do
- Inc (RealDSTStartMonth);
- RealDSTStartDay := L - MonthEnds [Pred (RealDSTStartMonth)];
- end;
- end;
- if (DSTEndSpecType = DSTMonthWeekDay) or (DSTEndSpecType = DSTMonthDay) then
- begin
- RealDSTEndMonth := DSTEndMonth;
- if DSTEndSpecType = DSTMonthDay then
- RealDSTEndDay := DSTEndDay
- else
- begin
- RealDSTEndDay := FirstDay (DSTEndMonth, Y, Mo, D, WD);
- if (DSTEndWeek >= 1) and (DSTEndWeek <= 4) then
- if DSTEndDay < RealDSTEndDay then
- RealDSTEndDay := DSTEndWeek * 7 + DSTEndDay - RealDSTEndDay + 1
- else
- RealDSTEndDay := Pred (DSTEndWeek) * 7 + DSTEndDay - RealDSTEndDay
- + 1
- else
- (* Last week in month *)
- begin
- RealDSTEndDay := RealDSTEndDay + MonthDays [false, RealDSTEndMonth]
- - 1;
- if RealDSTEndMonth = 2 then
- Inc (RealDSTEndDay, LeapDay (Y));
- RealDSTEndDay := RealDSTEndDay mod 7;
- if RealDSTEndDay < DSTEndDay then
- RealDSTEndDay := RealDSTEndDay + 7 - DSTEndDay
- else
- RealDSTEndDay := RealDSTEndDay - DSTEndDay;
- RealDSTEndDay := MonthDays [false, RealDSTEndMonth] - RealDSTEndDay;
- end;
- end;
- end
- else
- begin
- (* Julian day *)
- L := DSTEndDay;
- if (DSTEndSpecType = DSTJulian) then
- (* 0-based *)
- if (L + LeapDay (Y) <= 59) then
- Inc (L)
- else
- L := L + 1 - LeapDay (Y);
- if L <= 31 then
- begin
- RealDSTEndMonth := 1;
- RealDSTEndDay := L;
- end
- else
- if (L <= 59) or
- (DSTEndSpecType = DSTJulian) and (L - LeapDay (Y) <= 59) then
- begin
- RealDSTEndMonth := 2;
- RealDSTEndDay := DSTEndDay - 31;
- end
- else
- begin
- RealDSTEndMonth := 3;
- while (RealDSTEndMonth < 12) and (MonthEnds [RealDSTEndMonth] > L) do
- Inc (RealDSTEndMonth);
- RealDSTEndDay := L - MonthEnds [Pred (RealDSTEndMonth)];
- end;
- end;
- end;
- end;
- {$IFNDEF HAS_DUAL_TZHANDLING}
- function GetUniversalTime (var SystemTime: TSystemTime): boolean;
- begin
- GetLocalTime (SystemTime);
- UpdateTimeWithOffset (SystemTime, GetLocalTimeOffset);
- GetUniversalTime := true;
- end;
- function GetLocalTimeOffset: integer;
- begin
- if InDST then
- GetLocalTimeOffset := DSTOffsetMin
- else
- GetLocalTimeOffset := TZOffsetMin;
- end;
- {$ENDIF HAS_DUAL_TZHANDLING}
- function GetLocalTimeOffset(const DateTime: TDateTime; const InputIsUTC: boolean; out Offset: integer): boolean;
- var
- SystemTime: TSystemTime;
- begin
- DateTimeToSystemTime (DateTime, SystemTime);
- if InDST (SystemTime, InputIsUTC) then
- Offset := DSTOffsetMin
- else
- Offset := TZOffsetMin;
- GetLocalTimeOffset := true;
- end;
|