diff options
author | hajny <hajny@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2020-11-23 01:08:39 +0000 |
---|---|---|
committer | hajny <hajny@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2020-11-23 01:08:39 +0000 |
commit | 04b07c10a39b9a7306c0e4557acc43043d7b90ef (patch) | |
tree | cf90c4d3762ac0ab7004bde1465be3e2697313db /rtl/objpas | |
parent | 5eec9ad8672e76e1d43818cf5b6138fd308a1eab (diff) | |
download | fpc-04b07c10a39b9a7306c0e4557acc43043d7b90ef.tar.gz |
+ added TZ variable based offset calculation
git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@47535 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'rtl/objpas')
-rw-r--r-- | rtl/objpas/sysutils/tzenv.inc | 916 |
1 files changed, 916 insertions, 0 deletions
diff --git a/rtl/objpas/sysutils/tzenv.inc b/rtl/objpas/sysutils/tzenv.inc new file mode 100644 index 0000000000..a61047e9d3 --- /dev/null +++ b/rtl/objpas/sysutils/tzenv.inc @@ -0,0 +1,916 @@ +{ + 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; |