Browse Source

+ added TZ variable based offset calculation

git-svn-id: trunk@47535 -
(cherry picked from commit 95394d7f988e4ce245c1069ba4415e52c2844394)
Tomas Hajny 4 years ago
parent
commit
2cf6115789
2 changed files with 996 additions and 0 deletions
  1. 916 0
      rtl/objpas/sysutils/tzenv.inc
  2. 80 0
      rtl/os2/sysutils.pp

+ 916 - 0
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;

+ 80 - 0
rtl/os2/sysutils.pp

@@ -56,6 +56,7 @@ threadvar
 {$DEFINE FPC_FEXPAND_GETENV_PCHAR}
 {$DEFINE FPC_FEXPAND_GETENV_PCHAR}
 {$DEFINE HAS_GETTICKCOUNT}
 {$DEFINE HAS_GETTICKCOUNT}
 {$DEFINE HAS_GETTICKCOUNT64}
 {$DEFINE HAS_GETTICKCOUNT64}
+{$DEFINE HAS_LOCALTIMEZONEOFFSET}
 
 
 { Include platform independent implementation part }
 { Include platform independent implementation part }
 {$i sysutils.inc}
 {$i sysutils.inc}
@@ -549,6 +550,21 @@ end;
                               Time Functions
                               Time Functions
 ****************************************************************************}
 ****************************************************************************}
 
 
+{$DEFINE HAS_DUAL_TZHANDLING}
+{$I tzenv.inc}
+
+var
+  TZAlwaysFromEnv: boolean;
+
+procedure InitTZ2; inline;
+var
+  DT: DosCalls.TDateTime;
+begin
+  DosGetDateTime (DT);
+  TZAlwaysFromEnv := DT.TimeZone = -1;
+end;
+
+
 procedure GetLocalTime (var SystemTime: TSystemTime);
 procedure GetLocalTime (var SystemTime: TSystemTime);
 var
 var
   DT: DosCalls.TDateTime;
   DT: DosCalls.TDateTime;
@@ -567,6 +583,68 @@ begin
   end;
   end;
 end;
 end;
 
 
+
+function GetUniversalTime (var SystemTime: TSystemTime): boolean;
+var
+  DT: DosCalls.TDateTime;
+  Offset: longint;
+begin
+  if TZAlwaysFromEnv then
+   begin
+    GetLocalTime (SystemTime);
+    Offset := GetLocalTimeOffset;
+   end
+  else
+   begin
+    DosGetDateTime (DT);
+    with SystemTime do
+     begin
+      Year := DT.Year;
+      Month := DT.Month;
+      Day := DT.Day;
+      DayOfWeek := DT.WeekDay;
+      Hour := DT.Hour;
+      Minute := DT.Minute;
+      Second := DT.Second;
+      MilliSecond := DT.Sec100 * 10;
+     end;
+    if DT.TimeZone = -1 then
+     Offset := GetLocalTimeOffset
+    else
+     Offset := DT.TimeZone;
+   end;
+  UpdateTimeWithOffset (SystemTime, Offset);
+  GetUniversalTime := true;
+end;
+
+
+function GetLocalTimeOffset: integer;
+var
+  DT: DosCalls.TDateTime;
+begin
+  if TZAlwaysFromEnv then
+   begin
+    if InDST then
+     GetLocalTimeOffset := DSTOffsetMin
+    else
+     GetLocalTimeOffset := TZOffsetMin;
+   end
+  else
+   begin
+    DosGetDateTime (DT);
+    if DT.TimeZone <> -1 then
+     GetLocalTimeOffset := DT.TimeZone
+    else
+     begin
+      if InDST then
+       GetLocalTimeOffset := DSTOffsetMin
+      else
+       GetLocalTimeOffset := TZOffsetMin;
+     end;
+   end;
+end;
+
+
 {****************************************************************************
 {****************************************************************************
                               Misc Functions
                               Misc Functions
 ****************************************************************************}
 ****************************************************************************}
@@ -998,6 +1076,8 @@ Initialization
   OnBeep:=@SysBeep;
   OnBeep:=@SysBeep;
   LastOSError := 0;
   LastOSError := 0;
   OrigOSErrorWatch := TOSErrorWatch (SetOSErrorTracking (@TrackLastOSError));
   OrigOSErrorWatch := TOSErrorWatch (SetOSErrorTracking (@TrackLastOSError));
+  InitTZ;
+  InitTZ2;
 Finalization
 Finalization
   FreeTerminateProcs;
   FreeTerminateProcs;
   DoneExceptions;
   DoneExceptions;