OS/2 support by Tomas Hajny

git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@171 7c85be65-684b-0410-a082-b2ed4fbef004

ssl_openssl_lib.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 003.007.001 |
+| Project : Ararat Synapse                                       | 003.007.002 |
 |==============================================================================|
 | Content: SSL support by OpenSSL                                              |
 |==============================================================================|
-| Copyright (c)1999-2012, Lukas Gebauer                                        |
+| Copyright (c)1999-2013, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,11 +33,12 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2002-2012.                |
+| Portions created by Lukas Gebauer are Copyright (c)2002-2013.                |
 | Portions created by Petr Fejfar are Copyright (c)2011-2012.                  |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
+|   Tomas Hajny (OS2 support)                                                  |
 |==============================================================================|
 | History: see HISTORY.HTM from distribution package                           |
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
@@ -87,10 +88,13 @@ uses
   synafpc,
 {$IFNDEF MSWINDOWS}
   {$IFDEF FPC}
-  BaseUnix, SysUtils;
+   {$IFDEF UNIX}
+  BaseUnix,
+   {$ENDIF UNIX}
   {$ELSE}
-   Libc, SysUtils;
+   Libc,
   {$ENDIF}
+  SysUtils;
 {$ELSE}
   Windows;
 {$ENDIF}
@@ -112,8 +116,18 @@ var
     DLLSSLName: string = 'libssl.dylib';
     DLLUtilName: string = 'libcrypto.dylib';
     {$ELSE}
+     {$IFDEF OS2}
+      {$IFDEF OS2GCC}
+    DLLSSLName: string = 'kssl.dll';
+    DLLUtilName: string = 'kcrypto.dll';
+      {$ELSE OS2GCC}
+    DLLSSLName: string = 'ssl.dll';
+    DLLUtilName: string = 'crypto.dll';
+      {$ENDIF OS2GCC}
+     {$ELSE OS2}
     DLLSSLName: string = 'libssl.so';
     DLLUtilName: string = 'libcrypto.so';
+     {$ENDIF OS2}
     {$ENDIF}
   {$ELSE}
   DLLSSLName: string = 'ssleay32.dll';
@@ -799,7 +813,11 @@ var
 
 implementation
 
-uses SyncObjs;
+uses
+{$IFDEF OS2}
+  Sockets,
+{$ENDIF OS2}
+  SyncObjs;
 
 {$IFNDEF CIL}
 type
@@ -1950,8 +1968,12 @@ begin
         if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then
           InitLocks;
 {$ENDIF}
-        Result := True;
         SSLloaded := True;
+{$IFDEF OS2}
+        Result := InitEMXHandles;
+{$ELSE OS2}
+        Result := True;
+{$ENDIF OS2}
       end
       else
       begin

synafpc.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.003.000 |
+| Project : Ararat Synapse                                       | 001.003.001 |
 |==============================================================================|
 | Content: Utils for FreePascal compatibility                                  |
 |==============================================================================|
-| Copyright (c)1999-2012, Lukas Gebauer                                        |
+| Copyright (c)1999-2013, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,10 +33,11 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2003-2012.                |
+| Portions created by Lukas Gebauer are Copyright (c)2003-2013.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
+|   Tomas Hajny (OS2 support)                                                  |
 |==============================================================================|
 | History: see HISTORY.HTM from distribution package                           |
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
@@ -115,7 +116,11 @@ end;
 
 function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer;
 begin
+{$IFDEF OS2GCC}
+  Result := dynlibs.GetProcedureAddress(Module, '_' + Proc);
+{$ELSE OS2GCC}
   Result := dynlibs.GetProcedureAddress(Module, Proc);
+{$ENDIF OS2GCC}
 end;
 
 function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer;

synaicnv.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.001 |
+| Project : Ararat Synapse                                       | 001.001.002 |
 |==============================================================================|
-| Content: ICONV support for Win32, Linux and .NET                             |
+| Content: ICONV support for Win32, OS/2, Linux and .NET                       |
 |==============================================================================|
-| Copyright (c)2004-2010, Lukas Gebauer                                        |
+| Copyright (c)2004-2013, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,10 +33,11 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2004-2010.                |
+| Portions created by Lukas Gebauer are Copyright (c)2004-2013.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
+|   Tomas Hajny (OS2 support)                                                  |
 |==============================================================================|
 | History: see HISTORY.HTM from distribution package                           |
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
@@ -81,7 +82,11 @@ uses
 
 const
   {$IFNDEF MSWINDOWS}
+   {$IFDEF OS2}
+  DLLIconvName = 'iconv.dll';
+   {$ELSE OS2}
   DLLIconvName = 'libiconv.so';
+   {$ENDIF OS2}
   {$ELSE}
   DLLIconvName = 'iconv.dll';
   {$ENDIF}

synautil.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 004.015.002 |
+| Project : Ararat Synapse                                       | 004.015.003 |
 |==============================================================================|
 | Content: support procedures and functions                                    |
 |==============================================================================|
-| Copyright (c)1999-2012, Lukas Gebauer                                        |
+| Copyright (c)1999-2013, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,13 +33,14 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2012.               |
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2013.               |
 | Portions created by Hernan Sanchez are Copyright (c) 2000.                   |
 | Portions created by Petr Fejfar are Copyright (c)2011-2012.                  |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
 |   Hernan Sanchez (hernan.sanchez@iname.com)                                  |
+|   Tomas Hajny (OS2 support)                                                  |
 |==============================================================================|
 | History: see HISTORY.HTM from distribution package                           |
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
@@ -66,10 +67,14 @@ interface
 uses
 {$IFDEF MSWINDOWS}
   Windows,
-{$ELSE}
+{$ELSE MSWINDOWS}
   {$IFDEF FPC}
+    {$IFDEF OS2}
+    Dos, TZUtil,
+    {$ELSE OS2}
     UnixUtil, Unix, BaseUnix,
-  {$ELSE}
+    {$ENDIF OS2}
+  {$ELSE FPC}
     Libc,
   {$ENDIF}
 {$ENDIF}
@@ -763,21 +768,31 @@ begin
   st.Millisecond := stw.wMilliseconds;
   result := SystemTimeToDateTime(st);
 {$ENDIF}
-{$ELSE}
+{$ELSE MSWINDOWS}
 {$IFNDEF FPC}
 var
   TV: TTimeVal;
 begin
   gettimeofday(TV, nil);
   Result := UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400;
-{$ELSE}
+{$ELSE FPC}
+ {$IFDEF UNIX}
 var
   TV: TimeVal;
 begin
   fpgettimeofday(@TV, nil);
   Result := UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400;
-{$ENDIF}
-{$ENDIF}
+ {$ELSE UNIX}
+  {$IFDEF OS2}
+var
+  ST: TSystemTime;
+begin
+  GetLocalTime (ST);
+  Result := SystemTimeToDateTime (ST);
+  {$ENDIF OS2}
+ {$ENDIF UNIX}
+{$ENDIF FPC}
+{$ENDIF MSWINDOWS}
 end;
 
 {==============================================================================}
@@ -805,7 +820,7 @@ begin
   stw.wMilliseconds := st.Millisecond;
   Result := SetSystemTime(stw);
 {$ENDIF}
-{$ELSE}
+{$ELSE MSWINDOWS}
 {$IFNDEF FPC}
 var
   TV: TTimeVal;
@@ -821,7 +836,8 @@ begin
   TV.tv_sec := trunc(d);
   TV.tv_usec := trunc(frac(d) * 1000000);
   Result := settimeofday(TV, TZ) <> -1;
-{$ELSE}
+{$ELSE FPC}
+ {$IFDEF UNIX}
 var
   TV: TimeVal;
   d: double;
@@ -830,8 +846,18 @@ begin
   TV.tv_sec := trunc(d);
   TV.tv_usec := trunc(frac(d) * 1000000);
   Result := fpsettimeofday(@TV, nil) <> -1;
-{$ENDIF}
-{$ENDIF}
+ {$ELSE UNIX}
+  {$IFDEF OS2}
+var
+  ST: TSystemTime;
+begin
+  DateTimeToSystemTime (NewDT, ST);
+  SetTime (ST.Hour, ST.Minute, ST.Second, ST.Millisecond div 10);
+  Result := true;
+  {$ENDIF OS2}
+ {$ENDIF UNIX}
+{$ENDIF FPC}
+{$ENDIF MSWINDOWS}
 end;
 
 {==============================================================================}

synsock.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 005.002.001 |
+| Project : Ararat Synapse                                       | 005.002.002 |
 |==============================================================================|
 | Content: Socket Independent Platform Layer                                   |
 |==============================================================================|
-| Copyright (c)1999-2011, Lukas Gebauer                                        |
+| Copyright (c)1999-2013, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,10 +33,11 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2001-2011.                |
+| Portions created by Lukas Gebauer are Copyright (c)2001-2013.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
+|   Tomas Hajny (OS2 support)                                                  |
 |==============================================================================|
 | History: see HISTORY.HTM from distribution package                           |
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
@@ -65,7 +66,11 @@ unit synsock;
       {$I sswin32.inc}  //not complete yet!
     {$ELSE}
       {$IFDEF FPC}
+       {$IFDEF OS2}
+         {$I ssos2ws1.inc}
+       {$ELSE OS2}
         {$I ssfpc.inc}
+       {$ENDIF OS2}
       {$ELSE}
         {$I sslinux.inc}
       {$ENDIF}

tzutil.pas

@@ -0,0 +1,702 @@
+//Unit with timezone support for some Freepascal platforms.
+//Tomas Hajny
+
+unit tzutil;
+
+
+interface
+
+type
+ DSTSpecType = (DSTMonthWeekDay, DSTMonthDay, DSTJulian, DSTJulianX);
+
+(* Initialized to default values *)
+const
+  TZName: string = '';
+  TZDSTName: string = '';
+  TZOffset: longint = 0;
+  DSTOffset: 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;
+
+function TZSeconds: longint;
+(* Return current offset from UTC in seconds while respecting DST *)
+
+implementation
+
+uses
+  Dos;
+
+function TZSeconds: longint;
+const
+  MonthDays: array [1..12] of byte =
+                              (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+  MonthEnds: array [1..12] of word =
+                     (31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365);
+var
+  Y, Mo, D, WD, H, Mi, S, S100: word;
+  MS, DS, ME, DE: byte;
+  L: longint;
+  Second: cardinal;
+  AfterDSTStart, BeforeDSTEnd: boolean;
+
+function LeapDay: byte;
+begin
+ if (Y mod 400 = 0) or (Y mod 100 <> 0) and (Y mod 4 = 0) then
+  LeapDay := 1
+ else
+  LeapDay := 0;
+end;
+
+function FirstDay (MM: byte): byte;
+(* What day of week (0-6) is the first day of month MM? *)
+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);
+  end
+ else
+  if MM > Mo then
+   begin
+    DD := - MonthDays [Mo] + D - MonthEnds [Pred (MM)] + MonthEnds [Mo];
+    if (Mo <= 2) and (MM > 2) then
+     Dec (DD, LeapDay);
+   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;
+
+begin
+ TZSeconds := TZOffset;
+ if DSTOffset <> TZOffset then
+  begin
+   GetDate (Y, Mo, D, WD);
+   GetTime (H, Mi, S, S100);
+   Second := cardinal (H) * 3600 + Mi * 60 + S;
+
+   if (DSTStartSpecType = DSTMonthWeekDay) or (DSTStartSpecType = DSTMonthDay)
+                                                                           then
+    begin
+     MS := DSTStartMonth;
+     if DSTStartSpecType = DSTMonthDay then
+      DS := DSTStartDay
+     else
+      begin
+       DS := FirstDay (DSTStartMonth);
+       if (DSTStartWeek >= 1) and (DSTStartWeek <= 4) then
+        if DSTStartDay < DS then
+         DS := DSTStartWeek * 7 + DSTStartDay - DS + 1
+        else
+         DS := Pred (DSTStartWeek) * 7 + DSTStartDay - DS + 1
+       else
+(* Last week in month *)
+        begin
+         DS := DS + MonthDays [MS] - 1;
+         if MS = 2 then
+          Inc (DS, LeapDay);
+         DS := DS mod 7;
+         if DS < DSTStartDay then
+          DS := DS + 7 - DSTStartDay
+         else
+          DS := DS - DSTStartDay;
+         DS := MonthDays [MS] - DS;
+        end;
+      end;
+    end
+   else
+    begin
+(* Julian day *)
+     L := DSTStartDay;
+     if (DSTStartSpecType = DSTJulian) then
+(* 0-based *)
+      if (L + LeapDay <= 59) then
+       Inc (L)
+      else
+       L := L + 1 - LeapDay;
+     if L <= 31 then
+      begin
+       MS := 1;
+       DS := L;
+      end
+     else
+      if (L <= 59) or
+                    (DSTStartSpecType = DSTJulian) and (L - LeapDay <= 59) then
+       begin
+        MS := 2;
+        DS := DSTStartDay - 31;
+       end
+      else
+       begin
+        MS := 3;
+        while (MS < 12) and (MonthEnds [MS] > L) do
+         Inc (MS);
+        DS := L - MonthEnds [Pred (MS)];
+       end;
+    end;
+
+   if (DSTEndSpecType = DSTMonthWeekDay) or (DSTEndSpecType = DSTMonthDay) then
+    begin
+     ME := DSTEndMonth;
+     if DSTEndSpecType = DSTMonthDay then
+      DE := DSTEndDay
+     else
+      begin
+       DE := FirstDay (DSTEndMonth);
+       if (DSTEndWeek >= 1) and (DSTEndWeek <= 4) then
+        if DSTEndDay < DE then
+         DE := DSTEndWeek * 7 + DSTEndDay - DE + 1
+        else
+         DE := Pred (DSTEndWeek) * 7 + DSTEndDay - DE + 1
+       else
+(* Last week in month *)
+        begin
+         DE := DE + MonthDays [ME] - 1;
+         if ME = 2 then
+          Inc (DE, LeapDay);
+         DE := DE mod 7;
+         if DE < DSTEndDay then
+          DE := DE + 7 - DSTEndDay
+         else
+          DE := DE - DSTEndDay;
+         DE := MonthDays [ME] - DE;
+        end;
+      end;
+    end
+   else
+    begin
+(* Julian day *)
+     L := DSTEndDay;
+     if (DSTEndSpecType = DSTJulian) then
+(* 0-based *)
+      if (L + LeapDay <= 59) then
+       Inc (L)
+      else
+       L := L + 1 - LeapDay;
+     if L <= 31 then
+      begin
+       ME := 1;
+       DE := L;
+      end
+     else
+      if (L <= 59) or
+                      (DSTEndSpecType = DSTJulian) and (L - LeapDay <= 59) then
+       begin
+        ME := 2;
+        DE := DSTEndDay - 31;
+       end
+      else
+       begin
+        ME := 3;
+        while (ME < 12) and (MonthEnds [ME] > L) do
+         Inc (ME);
+        DE := L - MonthEnds [Pred (ME)];
+       end;
+    end;
+
+   if Mo < MS then
+    AfterDSTStart := false
+   else
+    if Mo > MS then
+     AfterDSTStart := true
+    else
+     if D < DS then
+      AfterDSTStart := false
+     else
+      if D > DS then
+       AfterDSTStart := true
+      else
+       AfterDSTStart := Second > DSTStartSec;
+   if Mo > ME then
+    BeforeDSTEnd := false
+   else
+    if Mo < ME then
+     BeforeDSTEnd := true
+    else
+     if D > DE then
+      BeforeDSTEnd := false
+     else
+      if D < DE then
+       BeforeDSTEnd := true
+      else
+       BeforeDSTEnd := Second < DSTEndSec;
+   if AfterDSTStart and BeforeDSTEnd then
+    TZSeconds := DSTOffset;
+  end;
+end;
+
+procedure InitTZ;
+const
+  TZEnvName = 'TZ';
+  EMXTZEnvName = 'EMXTZ';
+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 := GetEnv (TZEnvName);
+  if TZ = '' then
+   TZ := GetEnv (EMXTZEnvName);
+  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 < 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 > 86399) 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 > 86399) 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 > 86399) 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 < 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 > 86399) 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 < 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 > 86399) 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 < 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 > 86399) 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;
+
+
+begin
+  InitTZ;
+end.