{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q+,R+,S-,T-,U-,V+,W-,X+,Y+,Z1}
{$MINSTACKSIZE $00004000}
{$MAXSTACKSIZE $00100000}
{$IMAGEBASE $00400000}              
{$APPTYPE GUI}
                                



unit DateUtys ;

interface

uses Windows ;

const DateUtysID =
  ' Delphi Unit DateUtys, (c) J R Stockton 2008-02-13 to >= 2008-03-06' ;

{ Supplement to Turbo Delphi 2006 DateUtils ; Delphi 6 compatible. }

{ In Turbo Delphi 2006 unit DateUtils, routines DateTimeToJulianDate,
  JulianDateToDateTime, and DecodeDateWeek (and probably
  DecodeDateMonthWeek) are inefficient; and they are incorrect for
  some or all dates before 1900 if the time is non-zero.  Routines
  that call them inherit those errors.
  DateUtils.TryEncodeDateWeek, DateUtils.TryEncodeDateMonthWeek
  look slightly inefficient but OK.
  DateUtils.TryRecodeDateTime can exceed last day of month?

  Some relevant routines are not provided in DateUtils.

  SysUtils.TDateTime is implicitly local time; therefore it cannot be
  directly converted to JD or MJD, which are GMT-based.

  +----------------------------------------------+
  |   JD 0.0 = Julian BC 4713-01-01 12:00:00 GMT |
  |  CJD 0.0 = Julian BC 4713-01-01 00:00:00 LCT |
  |  MJD 0.0 = Gregorian 1858-11-17 00:00:00 GMT |
  | CMJD 0.0 = Gregorian 1858-11-17 00:00:00 LCT |
  |                                              | 
  | GMT is Greenwich Mean Time (or UT),          |
  | LCT is Local Civil Time.                     |
  | CMJD is Chronological Modified Julian Date,  |
  | JD, MJD & CJD are now obvious.               |
  | UTC, needing Leap Seconds, is not used.      |
  +----------------------------------------------+

  This Supplement is to address those problems, in particular by
  using CJD and CMJD and efficient algorithms, and adds new features.

  Supplement routines are ISO 8601 compatible, where applicable.
  The Proleptic Gregorian Calendar, with Astronomers' Notation
  before A.D. 1, is used throughout.  Julian B.C. 4713-01-01 is
  Astronomers' Proleptic Gregorian -4713-11-24.
  CMJD 50000 is 1995-10-10 everywhere.

  Only two of the URLs given in DateUtils are now of any use :
    <http://tycho.usno.navy.mil/mjd.html>
    <http://www.treasure-troves.com/astro>.

  Other URLs can be found on my Web site, but I'd rather not have
  my site cited directly in a widely-distributed unit.

  URLs checked at 2008-02-19 :-

  The Full Standard ISO 8601:2004 is at
  <http://isotc.iso.org/livelink/livelink/4021199/ISO_8601_2004_E.zip?
  func=doc.Fetch&nodeid=4021199> ISO 8601:2004(E) (zip-pdf, 228KB).

  <http://isotc.iso.org/livelink/livelink/fetch/2000/2122/138351/138352/
  customview.html?func=ll&objId=138352&objAction=browse&sort=name>
  Technical Committee ISO/TC 154, Processes, data elements and
  documents in commerce, industry and administration.

  All ISO weeks have 7 days, DN being Monday = 1 to Sunday = 7.
  The ISO YN and WN of any Date are those of its nearest Thursday.
  Weeks are numbered 01 to 52/53, week-dates are written as yyyy-Www-d.
  Definition: Week 01 of YN has the first Thursday of Calendar Year YN .
  Therefore, Year January 4th of Y is in Week 01 of YN = Year.

  I have derived Week Number routines from ISO principles.
  The routines are here called YWDfromDouble and DoublefromYWD.
  See also Report <http://qc.codegear.com/wc/qcmain.aspx?d=57477>.

  Round is faster than Trunc (JH ?).

  Try <http://msdn2.microsoft.com/en-us/library/aa139672.aspx> for
  API information.


  SysUtils.TryEncodeDate determines Leap Year even for month = 1 or 2 !
  SysUtils.DecodeDateFully has loops where DivMod should do !
  SysUtils.MinDateTime may not allow 0001-01-01 Time>0.
  SysUtils.MaxDateTime does not allow 23:59:59.999.
  SysUtils.DateTimeToFileDate LINUX has evident bug in 2038 after 2^31s



  ALL CODE NEEDS FULL TESTING IN THIS CONTEXT.

  More comment may be needed, RSVP.

  But note that some present comment is only for authoring. }


{ COMMENTS
  DateUtils.IsSameDay : or Trunc(Avalue)==Trunc(ABasis) ?
  DateUtils.EndOfTheMonth : or as StartOfTheMonth - 1 for
    YM := 12*Yr + Mo ; Yr := Yr div 12 ; Mo := Mo mod 12 + 1 ; ?
  DateUtils.EndofTheDay : too small.  Trunc(Avalue) + 1 - Epsilon ?
    or rename as LastMilliSecOfDay ?
  DateUtils.EndOfAMonth : see EndOfTheMonth
  DayOfTheWeek : faster by Trunc(AValue+5) mod 7 + 1 (5?)
  All of those routines like DateUtils.MilliSecondOfTheHour should
    be faster by taking Frac(AValue)*864e5, performing the usual
    conversion to integer, then div and mod.
  DateUtils.SpanOfNowAndThen : begin Result := Abs(ANow - AThen) end;
  }


// I've chosen not to use the old word types for Y M D H M S, in
// order to use the natural unit of memory and to extend the range }

// NOTE : use TDateTime for 0001-9999 and Double for wider range }


type
// Note that H M S, Y M D, Y W D normally go together.  Therefore :
THMSrecord = record Hr, Mn, Sc : integer ; end ;
TYMDrecord = record Yr, Mo, Dy : integer ; end ;
TYWDrecord = record YN, WN, DN : integer ; end ;
TYMDHMSrec = record Dat : TYMDrecord ; Tim : THMSrecord ; end ;
// Including milliseconds is unnecessary; omitting simplifies.
A3I = array [0..2] of integer ; // Is casting records to/from that OK?


const // generally useful; ISO 8601
 HMformat = '%2.2d:%2.2d' ;
HMSformat = '%2.2d:%2.2d:%2.2d' ;
YMDformat = '%4.4d-%2.2d-%2.2d' ;
YWDformat = '%4.4d-W%2.2d-%d' ;


// First and Last Days for TDateTime are -693593 and 2958465,
// but remember the effects of adding Time.  Therefore :
DTminimum = -693594 ; // SysUtils.EncodeDate(0001, 01, 00)
DTmaximum = 2958466 ; // SysUtils.EncodeDate(9999, 12, 32)
// Those bounds cannot be equalled by a valid TDT.  Rename them ?


// These two Chronological routines are for use instead of
// DateUtils' DateTimeToJulianDate & JulianDateToDateTime
function ChronJulianDateFromDateTime(const DT : TDateTime) : double ;
function DateTimeFromChronJulianDate(const CJD : double) : TDateTime ;


function CMJDfromCJD(const  CJD : double) : double ;
function CJDfromCMJD(const CMJD : double) : double ;


function EqualYMD(const A, B : TYMDrecord) : Boolean ;
function EqualYWD(const A, B : TYWDrecord) : Boolean ;
function EqualHMS(const A, B : THMSrecord) : Boolean ;


function RecordFromH_M_S(const H, M, S : integer) : THMSrecord ;
procedure H_M_SfromRecord(const HMS : THMSrecord ; out H, M, S : integer) ;

function RecordFromY_M_D(const Y, M, D : integer) : TYMDrecord ;
procedure Y_M_DfromRecord(const YMD : TYMDrecord ; out Y, M, D : integer) ;

function RecordFromY_W_D(const Y, W, D : integer) : TYWDrecord ;
procedure Y_W_DfromRecord(const YWD : TYWDrecord ; out Y, W, D : integer) ;


procedure H_M_SfromDouble(const DT : TDateTime ; out H, M, S : integer) ;
procedure Y_M_DfromDouble(const DT : TDateTime ; out Y, M, D : integer) ;
procedure Y_W_DfromDouble(const DT : TDateTime ; out Y, W, D : integer) ;

function YMDHMSfromDouble(const DT : TDateTime) : TYMDHMSrec ;
function DoubleFromYMDHMS(const Rc : TYMDHMSrec) : TDateTime ;

function DoubleFromHMS(HMS : THMSrecord) : double ;
function HMSfromDouble(const DT : double) : THMSrecord ;

function DoubleFromYMD(const YMD : TYMDrecord) : double ;
function YMDfromDouble(const DT : double) : TYMDrecord ;

// YWDfromDouble is for use instead of DateUtils.DecodeDateWeek
function DTforYearJan1(Yr : integer) : TDateTime ;
function YWDfromDouble{ISODTtoWNr}(const ADT : TDateTime) : TYWDrecord ;
function DoubleFromYWD{ISOWNrtoDT}(const WNR : TYWDrecord) : TDateTime ;


function ValidateDT(const DT : TDateTime) : Boolean ;
function ValidateHMS(const HMS : THMSrecord) : Boolean ;
function ValidateYMD(const YMD : TYMDrecord) : Boolean ;
function ValidateYWD(const YWD : TYWDrecord) : Boolean ;

function StringFromHM(const HMS : THMSrecord) : string ;
function StringFromHMS(const HMS : THMSrecord) : string ;
function StringFromYMD(const YMD : TYMDrecord) : string ;
function StringFromYWD(const YWD : TYWDrecord) : string ;

function StringFromYMDHMS(const YMDHMS : TYMDHMSrec) : string ;

function StringHMSfromDouble(const TD : TDateTime) : string ;
function StringHMfromDouble(const TD : TDateTime) : string ;
function StringYMDfromDouble(const TD : TDateTime) : string ;
function StringYWDfromDouble(const TD : TDateTime) : string ;
function StringYMDHMSfromDouble(const TD : TDateTime) : string ;


function StringFromH_M_S(const H, M, S : integer) : string ;
function StringFromY_M_D(const Y, M, D : integer) : string ;
function StringFromY_W_D(const Y, W, D : integer) : string ;


function HMSfromString(const St : string) : THMSrecord ;
function YMDfromString(const St : string) : TYMDrecord ;
function YWDfromString(const St : string) : TYWDrecord ;


function DoubleFromHMSstring(const St : string) : double ;
function DoubleFromYMDstring(const St : string) : double ;
function DoubleFromYWDstring(const St : string) : double ;


function TryHMSfromString(const St : string; out HMS : THMSrecord) :
  Boolean ;
function TryYMDfromString(const St : string; out YMD : TYMDrecord) :
  Boolean ;
function TryYWDfromString(const St : string; out YWD : TYWDrecord) :
  Boolean ;


function RoundToMillisecond(const DT : TDateTime) : TDateTime ;
function RoundToSecond(const DT : TDateTime) : TDateTime ;
function RoundToMinute(const DT : TDateTime) : TDateTime ;
function RoundToHour(const DT : TDateTime) : TDateTime ;
function RoundToDay(const DT : TDateTime) : TDateTime ;
function RoundToISOWeek(const DT : TDateTime) : TDateTime ;
// Month ? Year ?

function TruncToISOWeek(const DT : TDateTime) : TDateTime ;

function DayOfISOweek(const DT : double) : integer ;

function StringDayOfWeekFromDouble(const DT : Double) : string ;

// This is for use instead of SysUtils.IncAMonth
procedure StepMonths(var YMD : TYMDrecord ; const N : integer) ;

function EasterSunday(const GY : integer) : TYMDrecord ;

function   JDfromCJD(const  CJD : double ; const Offset : double) :
  double ;
function   CJDfromJD(const   JD : double ; const Offset : double) :
  double ;
function MJDfromCMJD(const CMJD : double ; const Offset : double) :
  double ;
function CMJDfromMJD(const  MJD : double ; const Offset : double) :
  double ;


function SecondsFromST(const ST : TSystemTime) : extended ;

function GetUNIXtimeSeconds : extended ;

function GetLocalTimeSeconds : extended ;

function GetCurrentGMTrecord : TYMDHMSrec ;

function GetCurrentLocalCivilTimeMinusGMTinMinutes : double ;

function GetLocalStandardTimeMinusGMTinMinutes : double ;

function GetLocalStandardTime : TDateTime ;


function NthISOxdayOfYM(N, DoW, Year, Mo : word) : TDateTime ;

type T2TDTs = record Spring, Autumn : TDateTime ; end ;

function ShowTSystemTime(const D : TSystemTime) : string ;
function GetSummerTimeText : string ;
function TDTforChangeTime(
  const Year : word ; const ST : TSystemTime) : TDateTime ;
function GetSummerTimeTDTs(const Year : word) : T2TDTs ;


function GetDateTimeOffsetFromOS(const DT : TDateTime) : double ;
// need GMT version ?

function ReadAnyISODateTimeString(St : string) : TYMDHMSrec ;

function YMDHMSDfromDouble(const DT : double) : string ;



// For Unit2, conversion of date/time from/to GMT

type
WinSum = (Winter, Summer) ;
SprAut = (Spring, Autumn) ;
TSummerTimeData = record HasST : Boolean ; TimeZone, Hemi : string ;
  Times :
    array [WinSum] of record Offset : TDateTime ; Abbrev : string ; end ;
  Rules :
    array [SprAut] of record Mo, Wk, Dy, Mn : integer ; end ;
  end ;
FiveItems = record
  STon, STof, When : TDateTime ; Abb : string ; WiSu : WinSum ; end ;


function ParseTZstring(TZZone : string) : TSummerTimeData ;
function ConvertGMTtoLCT(
  const GMT : TDateTime ; const Data : TSummerTimeData) : FiveItems ;
function ConvertLCTtoGMT(
  const LCT : TDateTime ; const Data : TSummerTimeData) : FiveItems ;
function GMTfromLCTandAbbrev(
  const LCTstr, Abbr : string ; const Data : TSummerTimeData) : TDateTime ;




// function (stet: for MTR)



implementation

uses SysUtils ;
                       
const
NaN = 0/0 ;
MJDofTDT0 = 15018 ;
CJDofMJD0 = 2400001 ;
CJDofTDT0 = CJDofMJD0 + MJDofTDT0 ;


function ChronJulianDateFromDateTime(const DT : TDateTime) : double ;
begin
  Result := Trunc(DT) + Abs(Frac(DT)) + CJDofTDT0 ; // Abs needed
  end {ChronJulianDateFromDateTime} ;

function DateTimeFromChronJulianDate(const CJD : double) : TDateTime ;
var TDT, Tim : double ;
begin
  TDT := Trunc(CJD) - CJDofTDT0 ; Tim := Frac(CJD) ;
  if Tim<>0.0 then // optional?
    if TDT<0.0 then TDT := TDT - Tim else TDT := TDT + Tim ;
  Result := TDT end {DateTimeFromChronJulianDate} ;


function CMJDfromCJD(const  CJD : double) : double ;
begin Result :=  CJD - CJDofMJD0 end {CMJDfromCJD} ;

function CJDfromCMJD(const CMJD : double) : double ;
begin Result := CMJD + CJDofMJD0 end {CJDfromCMJD} ;


function EqualYMD(const A, B : TYMDrecord) : Boolean ;
begin Result := (A.Yr=B.Yr) and (A.Mo=B.Mo) and (A.Dy=B.Dy) end ;

function EqualYWD(const A, B : TYWDrecord) : Boolean ;
begin Result := (A.YN=B.YN) and (A.WN=B.WN) and (A.DN=B.DN) end ;

function EqualHMS(const A, B : THMSrecord) : Boolean ;
begin Result := (A.Hr=B.Hr) and (A.Mn=B.Mn) and (A.Sc=B.Sc) end ;


function RecordFromH_M_S(const H, M, S : integer) : THMSrecord ;
begin with Result do begin Hr := H ; Mn := M ; Sc := S end end ;

procedure H_M_SfromRecord(const HMS : THMSrecord ; out H, M, S : integer) ;
begin with HMS do begin H := Hr ; M := Mn ; S := Sc end end ;

function RecordFromY_M_D(const Y, M, D : integer) : TYMDrecord ;
begin with Result do begin Yr := Y ; Mo := M ; Dy := D end end ;

procedure Y_M_DfromRecord(const YMD : TYMDrecord ; out Y, M, D : integer) ;
begin with YMD do begin Y := Yr ; M := Mo ; D := Dy end end ;

function RecordFromY_W_D(const Y, W, D : integer) : TYWDrecord ;
begin with Result do begin YN := Y ; WN := W ; DN := D end end ;

procedure Y_W_DfromRecord(const YWD : TYWDrecord ; out Y, W, D : integer) ;
begin with YWD do begin Y := YN ; W := WN ; D := DN end end ;



procedure H_M_SfromDouble(const DT : TDateTime ; out H, M, S : integer) ;
begin H_M_SfromRecord(HMSfromDouble(DT), H, M, S) end {H_M_SfromDouble} ;

procedure Y_M_DfromDouble(const DT : TDateTime ; out Y, M, D : integer) ;
begin Y_M_DfromRecord(YMDfromDouble(DT), Y, M, D) end {Y_M_DfromDouble} ;

procedure Y_W_DfromDouble(const DT : TDateTime ; out Y, W, D : integer) ;
begin Y_W_DfromRecord(YWDfromDouble(DT), Y, W, D) end {Y_W_DfromDouble} ;



function DoubleFromHMS(HMS : THMSrecord) : double ;
{ H M S can be outside the common range }
begin with HMS do
  Result := Sc/864e2 + Mn/1440 + Hr/24 ;
// or Result := ((Sc/60 + Mn)/60 + Hr)/24 ;
  end {DoubleFromH_M_S} ;

function HMSfromDouble(const DT : double) : THMSrecord ;
{ DT can be outside the TDateTime range }
var Si, XX : integer ;
begin with Result do begin
  XX := Round(Abs(Frac(DT))*864e5) ; // Round to ms
  Si := XX div 1000 ; // ms := XX mod 1000 ;
  Mn := Si div   60 ; Sc := Si mod   60 ;
  Hr := Mn div   60 ; Mn := Mn mod   60 ;
  end end {HMSfromDouble} ;



const
Days2000Y  = Round(365.2425*2000) ; // 730485 ;
Days20000Y = Days2000Y*10 ; // 7304850 ;

// These shift into 2000..3999, convert, shift back

function DoubleFromYMD(const YMD : TYMDrecord) : double ;
{ Any or all of Yr Mo Dy can be outside the normal range }
var YM, YY, ZZ : integer ;
begin with YMD do begin
  YY := Yr + 20000 ; ZZ := YY div 2000 ;
  YM := (2000 + YY mod 2000)*12 + Mo - 1 ;
  Result := SysUtils.EncodeDate(YM div 12, YM mod 12 + 1, 1) + Dy - 1
    - Days20000Y - Days2000Y + ZZ*Days2000Y ;
  end end {EncodeYMD} ;

function YMDfromDouble(const DT : double) : TYMDrecord ;
{ DT can be outside the TDateTime range }
var XX, ZZ : integer ; Y, M, D : word ;
begin
  XX := Trunc(DT) + Days20000Y ; ZZ := XX div Days2000Y ;
  SysUtils.DecodeDate(Days2000Y + XX mod Days2000Y, Y, M, D) ;
  with Result do begin
    Yr := Y + (ZZ*2000 - 22000) ; Mo := M ; Dy := D end ;
  end {DecodeYMD} ;


// Less optimised, but more obvious, versions are in my DEL_WKNO.DPR :

function DTforYearJan1(Yr : integer) : TDateTime ;
// This is faster than SysUtils.EncodeDate, since it does not consider M & D
const Base = 2 - 1899*365 - 1899 div 4 + 1899 div 100 - 1899 div 400 ;
begin Dec(Yr) ;
  if Yr<0 then Result := NaN else
  Result := Base + Yr*365 +   Yr div 4 -   Yr div 100 +   Yr div 400 ;
  end {DTforYearJan1} ;


function YWDfromDouble{ISODTtoWNr}(const ADT : TDateTime) : TYWDrecord ;
var NThu : TDateTime ; TDT : integer ;
begin with Result do begin // The fast non-canonical version.
  TDT := Trunc(ADT) ;
  DN := (TDT+777775) mod 7 + 1 { DT : Mon=1 to Sun=7 } ;
  NThu := TDT + 4 - DN { NThu is the Nearest Thursday } ;
  YN := Round(1899.5 + NThu/365.2425) { estimated Year Number } ;
  if NThu < DTforYearJan1(YN) then Dec(YN) { corrected Year Number } ;
  WN := 1 + Trunc(NThu-DTforYearJan1(YN)) div 7 { Count of Thursdays } ;
  end end {YWDfromDouble} ;


function DoubleFromYWD{ISOWNrtoDT}(const WNR : TYWDrecord) : TDateTime ;
var DT : TDateTime ; DW : integer ;
begin with WNR do begin // The fast non-canonical version.
  DT := DTforYearJan1(YN) + 3 { YN Jan 4, which is in YN Week 1 } ;
  DW := (Round(DT)+7777775) mod 7 + 1 { DT : Mon=1 to Sun=7 } ;
  DT := DT - DW { DT to day before Week 1 } ;
  Result := DT + (WN-1)*7 + DN { increment for Weeks and Days } ;
  end end {DoubleFromYWD} ;




function ValidateDT(const DT : TDateTime) : Boolean ;
begin Result :=
  ( (DT >=  0.0) and (DT < DTmaximum) ) or
  ( (DT <= -1.0) and (DT > DTminimum) ) ;
  end {ValidateDT} ; // untested


// The following three validators are short but slow.  They fully
// validate DayOfMonth and WeekOfYear.

function ValidateHMS(const HMS : THMSrecord) : Boolean ;
var X : THMSrecord ; // cf. Javascript
// if D is known <=9, e.g. by RegExp, no need to test DN.
begin
  X := HMSfromDouble(DoubleFromHMS(HMS)) ;
  Result := (X.Sc = HMS.Sc) and (X.Mn = HMS.Mn) ;
  end {ValidateHMS} ;

function ValidateYMD(const YMD : TYMDrecord) : Boolean ;
var X : TYMDrecord ;
// if known 0<=Dy<=99, e.g. by RegExp, no need to test Dy.
begin
  X := YMDfromDouble(DoubleFromYMD(YMD)) ;
  Result := (X.Dy = YMD.Dy) and (X.Mo = YMD.Mo) ;
  end {ValidateYMD} ; // slightly tested

function ValidateYWD(const YWD : TYWDrecord) : Boolean ;
var X : TYWDrecord ; // cf. Javascript
// if known 0<=D<=9, e.g. by RegExp, no need to test DN.
begin
  X := YWDfromDouble(DoubleFromYWD(YWD)) ;
  Result := (X.WN = YWD.WN) and (X.DN = YWD.DN) ;
  end {ValidateYWD} ;



function StringFromHMS(const HMS : THMSrecord) : string ;
begin with HMS do Result := Format(HMSformat, [Hr, Mn, Sc]) end ;

function StringFromHM(const HMS : THMSrecord) : string ;
begin with HMS do Result := Format(HMformat, [Hr, Mn]) end ;

function StringFromYMD(const YMD : TYMDrecord) : string ;
begin with YMD do Result := Format(YMDformat, [Yr, Mo, Dy]) end ;

function StringFromYWD(const YWD : TYWDrecord) : string ;
begin with YWD do Result := Format(YWDformat, [YN, WN, DN]) end ;


function StringFromYMDHMS(const YMDHMS : TYMDHMSrec) : string ;
begin with YMDHMS do Result :=
  StringFromYMD(Dat) + ' ' +  StringFromHMS(Tim) end {SetNow} ;



function StringHMSfromDouble(const TD : TDateTime) : string ;
begin Result := StringFromHMS(HMSfromDouble(TD)) ;
  end {StringHMSfromDouble} ;

function StringHMfromDouble(const TD : TDateTime) : string ;
begin Result := StringFromHM(HMSfromDouble(TD)) ;
  end {StringHMSfromDouble} ;

function StringYMDfromDouble(const TD : TDateTime) : string ;
begin Result := StringFromYMD(YMDfromDouble(TD)) ;
  end {StringYMDfromDouble} ;
   
function StringYWDfromDouble(const TD : TDateTime) : string ;
begin Result := StringFromYWD(YWDfromDouble(TD)) ;
  end {StringYWDHMSfromDouble} ;

function StringYMDHMSfromDouble(const TD : TDateTime) : string ;
begin
  Result := StringYMDfromDouble(TD) + ' ' + StringHMSfromDouble(TD) ;
  end {StringYMDHMSfromDouble} ;


function StringFromH_M_S(const H, M, S : integer) : string ;
begin
  Result := StringFromHMS(RecordFromH_M_S(H, M, S)) ;
  end {StringFromH_M_S} ;

function StringFromY_M_D(const Y, M, D : integer) : string ;
begin
  Result := StringFromYMD(RecordFromY_M_D(Y, M, D)) ;
  end {StringFromY_M_D} ;

function StringFromY_W_D(const Y, W, D : integer) : string ;
begin
  Result := StringFromYWD(RecordFromY_W_D(Y, W, D)) ;
  end {StringFromY_W_D} ;



function HMSfromString(const St : string) : THMSrecord ;
var L : integer ; // Assume St is <number>:MM:SS
begin with Result do begin L := Length(St) ;
  Hr := StrToInt(Copy(St, 1, L-6)) ;
  Mn := StrToInt(Copy(St, L-4, 2)) ;
  Sc := StrToInt(Copy(St, L-1, 2)) ;
  end end {HMSfromString} ;

function YMDfromString(const St : string) : TYMDrecord ;
var L : integer ; // Assume St is <number>-MM-DD
begin with Result do begin L := Length(St) ;
  Yr := StrToInt(Copy(St, 1, L-6)) ;
  Mo := StrToInt(Copy(St, L-4, 2)) ;
  Dy := StrToInt(Copy(St, L-1, 2)) ;
  end end {YMDfromString} ;

function YWDfromString(const St : string) : TYWDrecord ;
var L : integer ; // Assume St is <number>-.WW-D
begin with Result do begin L := Length(St) ;
  YN := StrToInt(Copy(St, 1, L-6)) ;
  WN := StrToInt(Copy(St, L-3, 2)) ;
  DN := StrToInt(Copy(St, L-0, 1)) ;
  end end {YWDfromString} ;


function DoubleFromHMSstring(const St : string) : double ;
begin Result := DoubleFromHMS(HMSfromString(St)) end ;

function DoubleFromYMDstring(const St : string) : double ;
begin Result := DoubleFromYMD(YMDfromString(St)) end ;

function DoubleFromYWDstring(const St : string) : double ;
begin Result := DoubleFromYWD(YWDfromString(St)) end ;

function YMDHMSfromDouble(const DT : TDateTime) : TYMDHMSrec ;
begin with Result do begin
  Dat := YMDfromDouble(DT) ; Tim := HMSfromDouble(DT) end ;
end;


function DoubleFromYMDHMS(const Rc : TYMDHMSrec) : TDateTime ;
begin
  Result := DoubleFromYMD(Rc.Dat) + {or -} DoubleFromHMS(Rc.Tim) ;
end;


function TryHMSfromString(const St : string; out HMS : THMSrecord) :
  Boolean ;
begin HMS := HMSfromString(St) ; // requires at least HH, allows - ?
  Result := ValidateHMS(HMS) end {TryHMSfromString} ;

function TryYMDfromString(const St : string; out YMD : TYMDrecord) :
  Boolean ;
begin YMD := YMDfromString(St) ; // requires at least YYYY, allows - ?
  Result := ValidateYMD(YMD) end {TryYMDfromString} ;

function TryYWDfromString(const St : string; out YWD : TYWDrecord) :
  Boolean ;
begin YWD := YWDfromString(St) ; // requires at least YYYY, allows - ?
  Result := ValidateYWD(YWD) end {TryYWDfromString} ;



function RoundToMillisecond(const DT : TDateTime) : TDateTime ;
begin Result := Round(DT*864e5)/864e5 end {RoundToMillisecond} ;

function RoundToSecond(const DT : TDateTime) : TDateTime ;
begin Result := Round(DT*86400)/86400 end {RoundToSecond} ;

function RoundToMinute(const DT : TDateTime) : TDateTime ;
begin Result := Round(DT*1440)/1440 end {RoundToMinute} ;

function RoundToHour(const DT : TDateTime) : TDateTime ;
begin Result := Round(DT*24)/24 end {RoundToHour} ;

function RoundToDay(const DT : TDateTime) : TDateTime ;
begin Result := Round(DT) end {RoundToDay} ;

function RoundToISOWeek(const DT : TDateTime) : TDateTime ;
const xx = 5 ; // Determine ISO value.  After 1899?
begin Result := Round((DT+xx)/7)*7 - xx end {RoundToISOWeek} ;

function TruncToISOWeek(const DT : TDateTime) : TDateTime ;
const xx = 5 ; // Determine ISO value  After 1899?
begin Result := Trunc((DT+xx)/7)*7 - xx end {TruncToISOWeek} ;



function DayOfISOweek(const DT : double) : integer ;
{ ISO, Mon=1 to Sun=7; DT can be outside the TDateTime range }
begin
  Result := 1 + (Trunc(DT) + 5) mod 7 ;
  if Result<1 then Inc(Result, 7) ;
  end {DayOfISOweek} ;


function StringDayOfWeekFromDouble(const DT : Double) : string ;
begin
 // Result := DayNames[DayOfISOweek(DT)] ;
  Result := ShortDayNames[DayOfweek(DT)] ;
  end {StringDayOfWeekFromDouble} ;


procedure StepMonths(var YMD : TYMDrecord ; const N : integer) ;
// Nicer than SysUtils.IncAMonth
var YM : integer ;
begin with YMD do begin
  YM := 12*Yr + Mo-1 + N ;
  // if YM<12 then YM := NaN ; // ??
  Yr := YM div 12 ; Mo := 1 + YM mod 12 ;
  // or DivMod(YM, 12, Yr, Mo ; Inc(Mo) ;
  // Fix Dy :
  if (Dy>30) and (Mo in [4, 6, 9, 11]) then Dy := 30 ;
  if (Dy>28) and (Mo=2) then Dy := 28 + Ord(SysUtils.IsLeapYear(Yr)) ;
  end end {StepMonths} ;




function EasterSunday(const GY : integer) : TYMDrecord ;
  (* From fast JRSEaster, unsigned 32-bit year - Delphi/Pascal ?
     TRACEABLE via http://www.merlyn.demon.co.uk/programs/estr-bcp.htm
     to Prayer Book & Calendar Act ; similar to that in paschal.pas *)
var gn, xx, cy, DM : integer ;
begin with Result do begin
  Yr := GY ;
  gn := GY mod 19 ;                             { gn ~ GoldenNumber }
  xx := GY div 100 ;
  cy := 3*(xx+1) div 4 - (13+xx*8) div 25 ;     { cy ~ BCPcypher }
  xx := ( 6 + GY + GY div 4 - xx + GY div 400 ) mod  7 ;
  DM := 21 + (gn*19 + cy + 15) mod 30 ;
  Dec(DM, Ord( Ord(gn>10) + DM > 49 )) ;        { PFM }
  Dy := DM + 1 + (66-xx-DM) mod 7 ;     { Day-of-March }
  Mo := 3 + Ord(Dy>31) ; if Dy>31 then Dec(Dy, 31) ;
  end end {EasterSunday} ;



// Next 4, Offset = NaN ought to mean get it from OS; but that
// needs the date/time to be given to the OS
// At the end of Summer Time, CJD & CMJD cannot determine Offset
// Sign of Offset ?

function   JDfromCJD(const  CJD : double ; const Offset : double) :
  double ;
begin Result :=  CJD - Offset - 0.5 end {JDfromCJD} ;

function   CJDfromJD(const   JD : double ; const Offset : double) :
  double ;
begin Result :=   JD + Offset + 0.5 end {CJDfromJD} ;

function MJDfromCMJD(const CMJD : double ; const Offset : double) :
  double ;
begin Result := CMJD - Offset end {MJDfromCMJD} ;

function CMJDfromMJD(const  MJD : double ; const Offset : double) :
  double ;
begin Result :=  MJD + Offset end {CMJDfromMJD} ;







{ <http://msdn2.microsoft.com/en-us/library/ms725481.aspx> for
  TIME_ZONE_INFORMATION Structure      *** A N D ***
  <http://msdn2.microsoft.com/en-us/library/ms725473(VS.85).aspx>
  for Time Functions }


function SecondsFromST(const ST : TSystemTime) : extended ;
begin with ST do
  Result := (((SysUtils.EncodeDate(wYear, wMonth, wDay)-25569)*24
    + wHour)*60 + wMinute)*60 + wSecond + wMilliseconds/1000;
  end {SecondsFromST} ;


function GetUNIXtimeSeconds : extended ;
var ST : TSystemTime ;
begin Windows.GetSystemTime(ST) ; Result := SecondsFromST(ST) ;
  end {GetUNIXtimeSeconds} ; // is there a more direct way?


function GetLocalTimeSeconds : extended ;
var ST : TSystemTime ;
begin Windows.GetLocalTime(ST) ; Result := SecondsFromST(ST) ;
  end {GetLocalTimeSeconds} ;


function GetCurrentGMTrecord : TYMDHMSrec ;
var ST : TSystemTime ;
begin Windows.GetSystemTime(ST) ;
  with Result, ST, Dat, Tim do begin
    Yr := wYear ; Mo := wMonth ; Dy := wDay ;
    Hr := wHour ; Mn := wMinute ; Sc := wSecond ;
    end {with} ;
  end {GetCurrentGMTrecord} ;


function GetCurrentLocalCivilTimeMinusGMTinMinutes : double ;
var GTZI : cardinal ; TZI : TTimeZoneInformation ;
begin
  GTZI := Windows.GetTimeZoneInformation(TZI) ;
  with TZI do case GTZI of
      0 : {TIME_ZONE_ID_UNKNOWN } Result := Bias { ? } ;
      1 : {TIME_ZONE_ID_STANDARD} Result := Bias + StandardBias ;
      2 : {TIME_ZONE_ID_DAYLIGHT} Result := Bias + DaylightBias ;
      TIME_ZONE_ID_INVALID : Result := NaN ;
      else Result := NaN ;
      end ;
  end {GetCurrentLocalCivilTimeMinusGMTinMinutes} ;


function GetLocalStandardTimeMinusGMTinMinutes : double ;
var GTZI : cardinal ; TZI : TTimeZoneInformation ;
begin
  GTZI := Windows.GetTimeZoneInformation(TZI) ;
  with TZI do case GTZI of
      0 : {TIME_ZONE_ID_UNKNOWN } Result := Bias { ? } ;
      1   {TIME_ZONE_ID_STANDARD} ,
      2 : {TIME_ZONE_ID_DAYLIGHT} Result := Bias + StandardBias ;
      TIME_ZONE_ID_INVALID : Result := NaN ;
      else Result := NaN ;
      end ;
  end {GetLocalStandardTimeMinusGMTinMinutes} ;


function GetLocalStandardTime : TDateTime ;
const T25569 = 25569.0 ; // GMT TDateTime for UNIX base 1970-01-01
begin
  Result := T25569 + (GetUNIXtimeSeconds/60 +
    GetLocalStandardTimeMinusGMTinMinutes)/1440 ;
  end {GetLocalStandardTime} ;


function NthISOxdayOfYM(N, DoW, Year, Mo : word) : TDateTime ;
var DT : TDateTime ; DW : word ;
begin
  if N=5 then begin N := 0 ; // and use next month :
    Inc(Year, Mo div 12) ; Mo := Mo mod 12+1 end ;
  DT := SysUtils.EncodeDate(Year, Mo, 1) ;
  DW := DayOfISOweek(DT) { Mon=1 } ;
  Result := DT + ( (DoW+7 - DW) mod 7 ) + 7*N - 7 ;
  end {NthISOxdayOfYM} ;



function ShowTSystemTime(const D : TSystemTime) : string ;
var SDN : string ;
begin with D do begin
  if WMonth=0 then begin Result := ' Unspecified' ; EXIT end ;
  SDN := ShortDayNames[wDayOfWeek+1] ;
  if WYear=0 then Result :=
    Format(' #%d %s in %s,', [wDay, SDN, ShortMonthNames[wMonth]])
    else Result :=
    Format(' %4.4d-%2.2d-%2.2d, %s,', [wYear, wMonth, wDay, SDN]) ;
  Result := Result + Format(' %2.2d:%2.2d:%2.2d', [wHour, wMinute,wSecond]) ;
  end end {ShowTSystemTime} ;



function GetSummerTimeText : string ;
var GTZI : cardinal ; TZI : TTimeZoneInformation ;
begin ;
  GTZI := GetTimeZoneInformation(TZI) ;
  if GTZI=TIME_ZONE_ID_INVALID then begin
    Result := 'TIME_ZONE_ID_INVALID.' ; EXIT end ;
  with TZI do
    if StandardBias = DaylightBias then Result := 'No change'
    else Result :=  '   ' +
      DaylightName + ' after' + ShowTSystemTime(DaylightDate) + ' civil' +
      #13#10 +      '   ' +
      StandardName + ' after' + ShowTSystemTime(StandardDate) + ' civil' ;
  end {GetSummerTimeText} ;



function TDTforChangeTime(
  const Year : word ; const ST : TSystemTime) : TDateTime ;
begin with ST do begin
  if WMonth=0 then begin Result := NaN ; EXIT end ;
  if WYear>0 then Result := SysUtils.EncodeDate(wYear, wMonth, wDay)
    else Result := NthISOxdayOfYM(wDay{1..5}, wDayOfWeek, Year, wMonth) ;
  Result := Result + { No Summer Time before 1900 }
    SysUtils.EncodeTime(wHour, wMinute, wSecond, wMilliseconds) ;
  end end {TDTforChangeTime} ;


function GetSummerTimeTDTs(const Year : word) : T2TDTs ;
var GTZI : cardinal ; TZI : TTimeZoneInformation ;
begin with Result do begin
  Spring := NaN ; Autumn := NaN ;
  GTZI := Windows.GetTimeZoneInformation(TZI) ;
  if GTZI<>TIME_ZONE_ID_INVALID then with TZI do
    if StandardBias <> DaylightBias then begin
      Spring := TDTforChangeTime(Year, DaylightDate) ;
      Autumn := TDTforChangeTime(Year, StandardDate) ;
    end end end {GetSummerTimeTDTs} ;





// Seems OK :

var CacheTZI : record OldYear : word ; Spring, Autumn : TDateTime ;
  WinterOffset, SummerOffset : double ; end ;

// This may be called repeatedly, so one year's dates should be cached
// Needs update for Vista knowing two rules

function GetDateTimeOffsetFromOS(const DT : TDateTime) : double ;
var Yr, Mo, Dy : word ; Hot : Boolean ;
var GTZI : cardinal ; TZI : TTimeZoneInformation ;
begin with CacheTZI do begin // To Do : CONSIDER no-Summer places //
  SysUtils.DecodeDate(DT, Yr, Mo, Dy) ;
  if Yr <> OldYear then begin OldYear := Yr ;
    GTZI := Windows.GetTimeZoneInformation(TZI) ;
    if GTZI=TIME_ZONE_ID_INVALID then begin
      OldYear := MaxWord ; Result := NaN ; EXIT ; end ;
    with TZI do begin
      Spring := TDTforChangeTime(Yr, DaylightDate) ;
      if StandardBias = DaylightBias then Autumn := Spring else
        Autumn := TDTforChangeTime(Yr, StandardDate) ;
      WinterOffset := Bias + StandardBias ;
      SummerOffset := Bias + DaylightBias ;
      end ;
    end ;
  if Spring=Autumn then Hot := false else // Test in South
    Hot := ((DT  >=Spring) xor (DT  <Autumn)) xor (Spring<Autumn) ;
  if Hot then Result := SummerOffset else Result := WinterOffset ;
  end end {GetDateTimeOffsetFromOS} ;




function ReadAnyISODateTimeString(St : string) : TYMDHMSrec ;
var A : array [0..5] of integer ;
J, K : integer ;
Digit, xDigit : Boolean ;
begin
  for J := 0 to 5 do A[J] := 0 ;
  xDigit := false ; K := 0 ;
  for J := 1 to Length(St) do begin Digit := St[J] in ['0'..'9'] ;
    if Digit then A[K] := A[K]*10 + Ord(St[J])-48
      else if xDigit then begin Inc(K) ; if K=6 then BREAK end ;
    xDigit := Digit end ;
  with Result, Dat, Tim do begin
    Yr := A[0] ; Mo := A[1] ; Dy := A[2] ;
    Hr := A[3] ; Mn := A[4] ; Sc := A[5] end ;
  end {ReadAnyISODateTimeString} ;



// Next is for conversion betweem GMT and remote using TZ

const Sp = #32 ;


function YMDHMSDfromDouble(const DT : double) : string ;
begin
  Result := StringYMDfromDouble(DT) + Sp + StringHMSfromDouble(DT) +
    ', ' + StringDayOfWeekFromDouble(DT) ;
  end {YMDHMSDfromDouble} ;


function MinsFromHMstring(St : string) : integer ;
var Sg : Boolean ; P : integer ;
begin
  Sg := St[1] = '-' ; if Sg then Delete(St, 1, 1) ;
  P := Pos(':', St) ;
  if P=0 then Result := StrToInt(St)*60 else Result :=
    StrToInt(Copy(St, 1, P-1))*60 + StrToInt(Copy(St, P+1, 255)) ;
  if Sg then Result := -Result ;
  end {MinsFromHMstring} ;


function MinsToStr(Mn : integer) : string ;
var Sg : Boolean ;
const PM : array [Boolean] of char = ('+', '-') ;
begin
  Sg := Mn<0 ; Mn := Abs(Mn) ;
  Result := PM[Sg] + Format('%2.2d:%2.2d', [Mn div 60, Mn mod 60]) ;
  end {MinsToStr} ;


function ParseTZstring(TZZone : string) : TSummerTimeData ;
const
Numbr : set of char = ['0'..'9', '+', '-', ':'] ;
Alpha : set of char = ['a'..'z', 'A'..'Z'] ;
HemiArr : array [Boolean] of string = ('North', 'South') ;
var P, Q : integer ;
WiSu : WinSum ;
SpAu : SprAut ;
ZoneTimes : array [WinSum] of string ;
ChangeStr : array [SprAut] of string ;
St : string ;
begin with Result do begin
  for P := Length(TZzone) downto 1 do
    if TZZone[P]<=Sp then Delete(TZZone, P, 1) ; // Omit <= space

  P := Pos(',M', TZZone) ; // Only M format allowed as yet
  HasST := P>0 ;
  if HasST then begin
    St := Copy(TZzone, P+1, 255) ; Delete(TZzone, P, 255) ;
    P := Pos(',', St) ;
    ChangeStr[Spring] := Copy(St, 2, P-2) ;
    ChangeStr[Autumn] := Copy(St, P+2, 255) ;
    end else begin ChangeStr[Spring] := '' ; ChangeStr[Autumn] := '' ;
    end ;
  // now TZ => TZzone , ChangeString[Spring] , ChangeString[Autumn]

  Q := 255 ;                                            // Handle TZZone
  for P := 2 to Length(TZzone) do
    if (TZzone[P-1] in Numbr) and (TZzone[P] in Alpha) then Q := P ;
  ZoneTimes[Winter] := Copy(TZzone, 1, Q-1) ;
  ZoneTimes[Summer] := Copy(TZZone, Q, 255) ;

   for WiSu := Summer downto Winter do begin
    St := ZoneTimes[WiSu] ;
    if St>'' then with Times[WiSu] do begin
      if not (St[Length(St)] in Numbr) then St := St + '-1' ;
      P := 1 ; while St[P] in Alpha do Inc(P) ;
      Abbrev := Copy(St, 1, P-1) ;
      Q := MinsFromHMstring(Copy(St, P, 255)) ; // Minutes of Day
      Offset := Q/1440 ;
      end ;
    end ;

  TimeZone := MinsToStr(-Q) ;

  if HasST then begin                              // Later thirds of TZ
    Times[Summer].Offset := Times[Winter].Offset + Times[Summer].Offset ;
    for SpAu := Spring to Autumn do with Rules[SpAu] do begin
      St := ChangeStr[SpAu] ;
      P := Pos('/', St) ;
      Mn := MinsFromHMstring(Copy(St, P+1, 255)) ;
      Dy := StrToInt(Copy(St, P-1, 1)) ;
      Wk := StrToInt(Copy(St, P-3, 1)) ;
      Mo := StrToInt(Copy(St, 1, P-5)) ;
      end ;
    Hemi := HemiArr[Rules[Spring].Mo > Rules[Autumn].Mo] ;
    end else Hemi := 'N/A' ;
  end end {ParseTZstring} ;


function DTofChange(const Year : integer ;
  const SpAu : SprAut; const Data : TSummerTimeData) : TDateTime ;
begin with Data.Rules[SpAu] do
  Result := NthISOxdayOfYM(Wk, Dy, Year, Mo) + Mn/1440 ;
  end {DTofChange} ;


function ConvertGMTtoLCT(
  const GMT : TDateTime ; const Data : TSummerTimeData) : FiveItems ;
var Year, X : word ;
begin with Result do begin
  WiSu := Winter ;
  if Data.HasST then begin
    DecodeDate(GMT, Year, X, X) ;
    STon := DTofChange(Year, Spring, Data) + Data.Times[Winter].Offset ;  // GMT
    STof := DTofChange(Year, Autumn, Data) + Data.Times[Summer].Offset ;  // GMT
    WiSu := WinSum(((GMT>=STon) xor (GMT<STof)) xor (STof>STon)) ;
    end else begin STon := NaN ; STof := NaN ; end ;
  When := GMT - Data.Times[WiSu].Offset ;
  Abb := Data.Times[WiSu].Abbrev ;
  end end {ConvertGMTtoLCT} ;


function ConvertLCTtoGMT(
  const LCT : TDateTime ; const Data : TSummerTimeData) : FiveItems ;
var Year, X : word ;
begin with Result do begin
  WiSu := Winter ;
  if Data.HasST then begin
    DecodeDate(LCT, Year, X, X) ;
    STon := DTofChange(Year, Spring, Data) ; // LCT
    STof := DTofChange(Year, Autumn, Data) ; // LCT
    WiSu := WinSum(((LCT>=STon) xor (LCT<STof)) xor (STof>STon)) ;
    end else begin STon := NaN ; STof := NaN ; end ;
  Abb := Data.Times[WiSu].Abbrev ;
  When := LCT + Data.Times[WiSu].Offset ; // LCT
  end end {ConvertLCTtoGMT} ;


function GMTfromLCTandAbbrev(
  const LCTstr, Abbr : string ; const Data : TSummerTimeData) : TDateTime ;
var WiSu : WinSum ;
begin
  if (Abbr = Data.Times[Winter].Abbrev) or
     (Abbr = Data.Times[Summer].Abbrev) then begin
    WiSu := WinSum(Abbr <> Data.Times[Winter].Abbrev) ;
    Result := DoubleFromYMDHMS(ReadAnyISODateTimeString(LCTstr)) +
              Data.Times[WiSu].Offset ;
    end else Result := NaN ;
  end {GMTfromLCTandAbbrev} ;



initialization

CacheTZI.OldYear := MaxWord ;

END.