{******************************************************************************}
{                                                                              }
{   Library:          Fundamentals 5.00                                        }
{   File name:        flcDateTime.pas                                          }
{   File version:     5.24                                                     }
{   Description:      DateTime functions                                       }
{                                                                              }
{   Copyright:        Copyright (c) 1999-2020, David J Butler                  }
{                     All rights reserved.                                     }
{                     Redistribution and use in source and binary forms, with  }
{                     or without modification, are permitted provided that     }
{                     the following conditions are met:                        }
{                     Redistributions of source code must retain the above     }
{                     copyright notice, this list of conditions and the        }
{                     following disclaimer.                                    }
{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
{                     POSSIBILITY OF SUCH DAMAGE.                              }
{                                                                              }
{   Github:           https://github.com/fundamentalslib                       }
{   E-mail:           fundamentals.library at gmail.com                        }
{                                                                              }
{ Revision history:                                                            }
{                                                                              }
{   1999/11/10  0.01  Initial version from scratch. Add functions. DayOfYear.  }
{   1999/11/21  0.02  EasterSunday function. Diff functions. ISOInteger.       }
{   2000/03/04  1.03  Moved RFC functions to cInternetStandards.               }
{   2000/03/05  1.04  Added Time Zone functions from cInternetStandards.       }
{   2000/05/03  1.05  Added ISO Week functions, courtesy of Martin Boonstra    }
{   2000/08/16  1.06  Fixed bug in GMTBias reported by Gerhard Steinwedel      }
{   2001/12/22  2.07  Added RFC DateTime functions from cInternetStandards.    }
{   2002/01/10  3.08  Fixed bug with negative values in AddMonths as           }
{                     reported by Michael Valentiner <MichaelVB at gmx.de>     }
{   2004/02/22  3.09  Fixed bug in RFCDateTimeToGMTDateTime.                   }
{   2005/06/17  4.10  English language datetime functions.                     }
{   2005/08/19  4.11  Compilable with FreePascal 2.0.1 Win32 i386.             }
{   2005/08/21  4.12  Compilable with FreePascal 2.0.1 Linux i386.             }
{   2005/08/26  4.13  Improvements to timer functions.                         }
{   2005/08/27  4.14  Revised for Fundamentals 4.                              }
{   2006/01/11  4.15  Fixed bug in Diff functions detected by Juergen.         }
{   2007/06/08  4.16  Compilable with FreePascal 2.04 Win32 i386               }
{   2007/08/08  4.17  Fixes for negative dates.                                }
{   2008/12/30  4.18  Revision.                                                }
{   2009/10/09  4.19  Compilable with Delphi 2009 Win32/.NET.                  }
{   2010/06/27  4.20  Compilable with FreePascal 2.4.0 OSX x86-64              }
{   2011/05/04  4.21  Moved timer functions to cTimers unit.                   }
{   2016/01/09  5.22  Revised for Fundamendals 5.                              }
{   2018/07/17  5.23  Update for string types.                                 }
{   2018/08/13  5.24  String type changes.                                     }
{                                                                              }
{ Supported compilers:                                                         }
{                                                                              }
{   Delphi 2010-10.4 Win32/Win64        5.24  2020/06/02                       }
{   Delphi 10.2-10.4 Linux64            5.24  2020/06/02                       }
{   FreePascal 3.0.4 Win64              5.24  2020/06/02                       }
{                                                                              }
{ References:                                                                  }
{                                                                              }
{   FAQ ABOUT CALENDARS - http://www.tondering.dk/claus/calendar.html          }
{   RFC822, RFC850, RFC1123, RFC1036, RFC1945.                                 }
{                                                                              }
{******************************************************************************}

{$INCLUDE ..\flcInclude.inc}

{$IFDEF FREEPASCAL}
  {$WARNINGS OFF}
  {$HINTS OFF}
{$ENDIF}

{$IFDEF DEBUG}
{$IFDEF TEST}
  {$DEFINE DATETIME_TEST}
{$ENDIF}
{$ENDIF}

unit flcDateTime;

interface

uses
  { System }
  SysUtils,

  { Fundamentals }
  flcStdTypes;



{                                                                              }
{ Exception                                                                    }
{                                                                              }
type
  EDateTime = class(Exception);

  

{                                                                              }
{ Decoding                                                                     }
{                                                                              }
{$IFNDEF DELPHI6_UP}
procedure DecodeDateTime(const DateTime: TDateTime;
          out Year, Month, Day, Hour, Minute, Second, Millisecond: Word);
{$ENDIF}
function  DatePart(const D: TDateTime): Integer;
function  TimePart(const D: TDateTime): Double;
function  Century(const D: TDateTime): Word;
function  Year(const D: TDateTime): Word;
function  Month(const D: TDateTime): Word;
function  Day(const D: TDateTime): Word;
function  Hour(const D: TDateTime): Word;
function  Minute(const D: TDateTime): Word;
function  Second(const D: TDateTime): Word;
function  Millisecond(const D: TDateTime): Word;

const
  OneDay         = 1.0;
  OneHour        = OneDay / 24;
  OneMinute      = OneHour / 60;
  OneSecond      = OneMinute / 60;
  OneMillisecond = OneSecond / 1000;
  OneWeek        = OneDay * 7;

  HoursPerDay      = 24;
  MinutesPerHour   = 60;
  MinutesPerDay    = MinutesPerHour * HoursPerDay;
  SecondsPerMinute = 60;
  SecondsPerHour   = SecondsPerMinute * MinutesPerHour;
  SecondsPerDay    = SecondsPerHour * HoursPerDay;



{                                                                              }
{ Encoding                                                                     }
{                                                                              }
{$IFNDEF DELPHI6_UP}
function  EncodeDateTime(const Year, Month, Day, Hour, Minute, Second, Millisecond: Word): TDateTime;
{$ENDIF}
procedure SetYear(var D: TDateTime; const Year: Word);
procedure SetMonth(var D: TDateTime; const Month: Word);
procedure SetDay(var D: TDateTime; const Day: Word);
procedure SetHour(var D: TDateTime; const Hour: Word);
procedure SetMinute(var D: TDateTime; const Minute: Word);
procedure SetSecond(var D: TDateTime; const Second: Word);
procedure SetMillisecond(var D: TDateTime; const Milliseconds: Word);



{                                                                              }
{ Comparison                                                                   }
{                                                                              }
function  IsEqual(const D1, D2: TDateTime): Boolean; overload;
function  IsEqual(const D1: TDateTime; const Ye, Mo, Da: Word): Boolean; overload;
function  IsEqual(const D1: TDateTime; const Ho, Mi, Se, ms: Word): Boolean; overload;
function  IsAM(const D: TDateTime): Boolean;
function  IsPM(const D: TDateTime): Boolean;
function  IsMidnight(const D: TDateTime): Boolean;
function  IsNoon(const D: TDateTime): Boolean;
function  IsSunday(const D: TDateTime): Boolean;
function  IsMonday(const D: TDateTime): Boolean;
function  IsTuesday(const D: TDateTime): Boolean;
function  IsWedneday(const D: TDateTime): Boolean;
function  IsThursday(const D: TDateTime): Boolean;
function  IsFriday(const D: TDateTime): Boolean;
function  IsSaturday(const D: TDateTime): Boolean;
function  IsWeekend(const D: TDateTime): Boolean;



{                                                                              }
{ Relative date/times                                                          }
{                                                                              }
function  Noon(const D: TDateTime): TDateTime;
function  Midnight(const D: TDateTime): TDateTime;
function  FirstDayOfMonth(const D: TDateTime): TDateTime;
function  LastDayOfMonth(const D: TDateTime): TDateTime;
function  NextWorkday(const D: TDateTime): TDateTime;
function  PreviousWorkday(const D: TDateTime): TDateTime;
function  FirstDayOfYear(const D: TDateTime): TDateTime;
function  LastDayOfYear(const D: TDateTime): TDateTime;
function  EasterSunday(const Year: Word): TDateTime;
function  GoodFriday(const Year: Word): TDateTime;

function  AddMilliseconds(const D: TDateTime; const N: Int64): TDateTime;
function  AddSeconds(const D: TDateTime; const N: Int64): TDateTime;
function  AddMinutes(const D: TDateTime; const N: Integer): TDateTime;
function  AddHours(const D: TDateTime; const N: Integer): TDateTime;
function  AddDays(const D: TDateTime; const N: Integer): TDateTime;
function  AddWeeks(const D: TDateTime; const N: Integer): TDateTime;
function  AddMonths(const D: TDateTime; const N: Integer): TDateTime;
function  AddYears(const D: TDateTime; const N: Integer): TDateTime;



{                                                                              }
{ Counting                                                                     }
{                                                                              }
{   DayOfYear and WeekNumber start at 1.                                       }
{   WeekNumber is not the ISO week number but the week number where week one   }
{     starts at Jan 1.                                                         }
{   For reference: ISO standard 8601:1988 - (European Standard EN 28601).      }
{     "It states that a week is identified by its number in a given year.      }
{      A week begins with a Monday (day 1) and ends with a Sunday (day 7).     }
{      The first week of a year is the one which includes the first Thursday   }
{      (day 4), or equivalently the one which includes January 4.              }
{      In other words, the first week of a new year is the week that has the   }
{      majority of its days in the new year."                                  }
{   ISOFirstWeekOfYear returns the start date (Monday) of the first ISO week   }
{     of a year (may be in the previous year).                                 }
{   ISOWeekNumber returns the ISO Week number and the year to which the week   }
{     number applies.                                                          }
{                                                                              }
function  DayOfYear(const Ye, Mo, Da: Word): Integer; overload;
function  DayOfYear(const D: TDateTime): Integer; overload;
function  DaysInMonth(const Ye, Mo: Word): Integer; overload;
function  DaysInMonth(const D: TDateTime): Integer; overload;
function  DaysInYear(const Ye: Word): Integer;
function  DaysInYearDate(const D: TDateTime): Integer;
function  WeekNumber(const D: TDateTime): Integer;
function  ISOFirstWeekOfYear(const Ye: Word): TDateTime;
procedure ISOWeekNumber(const D: TDateTime; var WeekNumber, WeekYear: Word);



{                                                                              }
{ Difference                                                                   }
{   Returns difference between two dates (D2 - D1).                            }
{                                                                              }
function  DiffMilliseconds(const D1, D2: TDateTime): Int64;
function  DiffSeconds(const D1, D2: TDateTime): Int64;
function  DiffMinutes(const D1, D2: TDateTime): Int64;
function  DiffHours(const D1, D2: TDateTime): Int64;
function  DiffDays(const D1, D2: TDateTime): Integer;
function  DiffWeeks(const D1, D2: TDateTime): Integer;
function  DiffMonths(const D1, D2: TDateTime): Integer;
function  DiffYears(const D1, D2: TDateTime): Integer;



{                                                                              }
{ Time Zone                                                                    }
{   Uses system's regional settings to convert between local and GMT time.     }
{   GMTBias returns the number of minutes difference between GMT and the       }
{   system's time zone.                                                        }
{   NowAsGMTTime returns the current GMT time.                                 }
{                                                                              }
function  GMTBias: Integer;
function  GMTTimeToLocalTime(const D: TDateTime): TDateTime;
function  LocalTimeToGMTTime(const D: TDateTime): TDateTime;
function  NowAsGMTTime: TDateTime;



{                                                                              }
{ Conversions                                                                  }
{                                                                              }
{   ANSI Integer is an integer in the format YYYYDDD (where DDD = day number)  }
{   ISO-8601 DateTime format is YYMMDD 'T' HH ':' MM ':' SS                    }
{   ISO-8601 Integer date is an integer in the format YYYYMMDD.                }
{   TwoDigitYearToYear returns the full year number given a two digit year.    }
{                                                                              }
function  DateTimeToISO8601StringB(const D: TDateTime): RawByteString;
function  ISO8601StringToTime(const D: RawByteString): TDateTime;
function  ISO8601StringAsDateTime(const D: RawByteString): TDateTime;

function  DateTimeToANSI(const D: TDateTime): Integer;
function  ANSIToDateTime(const Julian: Integer): TDateTime;

function  DateTimeToISOInteger(const D: TDateTime): Integer;
function  DateTimeToISOStringB(const D: TDateTime): RawByteString;
function  ISOIntegerToDateTime(const ISOInteger: Integer): TDateTime;

function  TwoDigitRadix2000YearToYear(const Y: Integer): Integer;

function  DateTimeAsElapsedTimeB(const D: TDateTime;
          const IncludeMilliseconds: Boolean = False): RawByteString;

function  UnixTimeToDateTime(const UnixTime: Word32): TDateTime;
function  DateTimeToUnixTime(const D: TDateTime): Word32;



{                                                                              }
{ English Language DateTimes                                                   }
{                                                                              }
{   ShortDay    =  "Mon" | "Tue" | "Wed" | "Thu" |                             }
{                  "Fri" | "Sat" | "Sun"                                       }
{   LongDay     =  "Monday" | "Tuesday" | "Wednesday" | "Thurday" |            }
{                  "Friday" | "Saturday" | "Sunday"                            }
{   ShortMonth  =  "Jan" | "Feb" | "Mar" | "Apr" | "May" | "Jun" |             }
{                  "Jul" | "Aug" | "Sep" | "Oct" | "Nov" | "Dec"               }
{   LongMonth   =  "January" | "February" | "March" | "April" | "May" |        }
{                  "June" | "July" | "August" | "September" | "October" |      }
{                  "November" | "December"                                     }
{                                                                              }
function  EnglishShortDayOfWeekStrA(const DayOfWeek: Integer): RawByteString;
function  EnglishShortDayOfWeekStrU(const DayOfWeek: Integer): UnicodeString;

function  EnglishLongDayOfWeekStrA(const DayOfWeek: Integer): RawByteString;
function  EnglishLongDayOfWeekStrU(const DayOfWeek: Integer): UnicodeString;

function  EnglishShortMonthStrA(const Month: Integer): RawByteString;
function  EnglishShortMonthStrU(const Month: Integer): UnicodeString;

function  EnglishLongMonthStrA(const Month: Integer): RawByteString;
function  EnglishLongMonthStrU(const Month: Integer): UnicodeString;

function  EnglishShortDayOfWeekA(const S: RawByteString): Integer;
function  EnglishShortDayOfWeekU(const S: UnicodeString): Integer;

function  EnglishLongDayOfWeekA(const S: RawByteString): Integer;
function  EnglishLongDayOfWeekU(const S: UnicodeString): Integer;

function  EnglishShortMonthA(const S: RawByteString): Integer;
function  EnglishShortMonthU(const S: UnicodeString): Integer;

function  EnglishLongMonthA(const S: RawByteString): Integer;
function  EnglishLongMonthU(const S: UnicodeString): Integer;



{                                                                              }
{ RFC DateTimes                                                                }
{                                                                              }
{   RFC1123 DateTime is the preferred representation on the Internet for all   }
{   DateTime values.                                                           }
{   Use DateTimeToRFCDateTime to convert local time to RFC1123 DateTime.       }
{   Use RFCDateTimeToDateTime to convert RFC DateTime formats to local time.   }
{   Returns 0.0 if not a recognised RFC DateTime.                              }
{   See RFC822, RFC850, RFC1123, RFC1036, RFC1945.                             }
{                                                                              }
{ From RFC 822 (Standard for the format of ARPA INTERNET Text Messages):       }
{    "time        =  hour zone                      ; ANSI and Military        }
{     hour        =  2DIGIT ":" 2DIGIT [":" 2DIGIT] ; 00:00:00 - 23:59:59      }
{     zone        =  "UT"  / "GMT"                  ; Universal Time           }
{                                                   ; North American : UT      }
{                 /  "EST" / "EDT"                  ;  Eastern:  - 5/ - 4      }
{                 /  "CST" / "CDT"                  ;  Central:  - 6/ - 5      }
{                 /  "MST" / "MDT"                  ;  Mountain: - 7/ - 6      }
{                 /  "PST" / "PDT"                  ;  Pacific:  - 8/ - 7      }
{                 /  1ALPHA                         ; Military: Z = UT;        }
{                                                   ;  A:-1; (J not used)      }
{                                                   ;  M:-12; N:+1; Y:+12      }
{                 / ( ("+" / "-") 4DIGIT )          ; Local differential       }
{                                                   ;  hours+min. (HHMM)       }
{     date-time   =  [ day "," ] date time          ; dd mm yy                 }
{                                                   ;  hh:mm:ss zzz            }
{     day         =  "Mon"  / "Tue" /  "Wed"  / "Thu"                          }
{                 /  "Fri"  / "Sat" /  "Sun"                                   }
{     date        =  1*2DIGIT month 2DIGIT        ; day month year             }
{                                                 ;  e.g. 20 Jun 82            }
{     month       =  "Jan"  /  "Feb" /  "Mar"  /  "Apr"                        }
{                 /  "May"  /  "Jun" /  "Jul"  /  "Aug"                        }
{                 /  "Sep"  /  "Oct" /  "Nov"  /  "Dec"                    "   }
{                                                                              }
{ Note that even though RFC 822 states hour=2DIGIT":"2DIGIT, none of the       }
{   examples given in the appendix include the ":",                            }
{   for example: "26 Aug 76 1429 EDT"                                          }
{                                                                              }
{                                                                              }
{ From RFC 1036 (Standard for Interchange of USENET Messages):                 }
{                                                                              }
{   "Its format must be acceptable both in RFC-822 and to the getdate(3)       }
{    routine that is provided with the Usenet software.   ...                  }
{    One format that is acceptable to both is:                                 }
{                                                                              }
{                      Wdy, DD Mon YY HH:MM:SS TIMEZONE                        }
{                                                                              }
{    Note in particular that ctime(3) format:                                  }
{                                                                              }
{                          Wdy Mon DD HH:MM:SS YYYY                            }
{                                                                              }
{    is not acceptable because it is not a valid RFC-822 date.  However,       }
{    since older software still generates this format, news                    }
{    implementations are encouraged to accept this format and translate        }
{    it into an acceptable format.                                         "   }
{                                                                              }
{   "Here is an example of a message in the old format (before the             }
{    existence of this standard). It is recommended that                       }
{    implementations also accept messages in this format to ease upward        }
{    conversion.                                                               }
{                                                                              }
{               Posted: Fri Nov 19 16:14:55 1982                           "   }
{                                                                              }
{                                                                              }
{ From RFC 1945 (Hypertext Transfer Protocol -- HTTP/1.0)                      }
{                                                                              }
{  "HTTP/1.0 applications have historically allowed three different            }
{   formats for the representation of date/time stamps:                        }
{                                                                              }
{       Sun, 06 Nov 1994 08:49:37 GMT    ; RFC 822, updated by RFC 1123        }
{       Sunday, 06-Nov-94 08:49:37 GMT   ; RFC 850, obsoleted by RFC 1036      }
{       Sun Nov  6 08:49:37 1994         ; ANSI C's asctime() format           }
{                                                                              }
{   The first format is preferred as an Internet standard and represents       }
{   a fixed-length subset of that defined by RFC 1123 [6] (an update to        }
{   RFC 822 [7]). The second format is in common use, but is based on the      }
{   obsolete RFC 850 [10] date format and lacks a four-digit year.             }
{   HTTP/1.0 clients and servers that parse the date value should accept       }
{   all three formats, though they must never generate the third               }
{   (asctime) format.                                                          }
{                                                                              }
{      Note: Recipients of date values are encouraged to be robust in          }
{      accepting date values that may have been generated by non-HTTP          }
{      applications, as is sometimes the case when retrieving or posting       }
{      messages via proxies/gateways to SMTP or NNTP.                       "  }
{                                                                              }
{  "All HTTP/1.0 date/time stamps must be represented in Universal Time        }
{   (UT), also known as Greenwich Mean Time (GMT), without exception.          }
{                                                                              }
{       HTTP-date      = rfc1123-date | rfc850-date | asctime-date             }
{                                                                              }
{       rfc1123-date   = wkday "," SP date1 SP time SP "GMT"                   }
{       rfc850-date    = weekday "," SP date2 SP time SP "GMT"                 }
{       asctime-date   = wkday SP date3 SP time SP 4DIGIT                      }
{                                                                              }
{       date1          = 2DIGIT SP month SP 4DIGIT                             }
{                        ; day month year (e.g., 02 Jun 1982)                  }
{       date2          = 2DIGIT "-" month "-" 2DIGIT                           }
{                        ; day-month-year (e.g., 02-Jun-82)                    }
{       date3          = month SP ( 2DIGIT | ( SP 1DIGIT ))                    }
{                        ; month day (e.g., Jun  2)                            }
{                                                                              }
{       time           = 2DIGIT ":" 2DIGIT ":" 2DIGIT                          }
{                        ; 00:00:00 - 23:59:59                                 }
{                                                                              }
{       wkday          = "Mon" | "Tue" | "Wed"                                 }
{                      | "Thu" | "Fri" | "Sat" | "Sun"                         }
{                                                                              }
{       weekday        = "Monday" | "Tuesday" | "Wednesday"                    }
{                      | "Thursday" | "Friday" | "Saturday" | "Sunday"         }
{                                                                              }
{       month          = "Jan" | "Feb" | "Mar" | "Apr"                         }
{                      | "May" | "Jun" | "Jul" | "Aug"                         }
{                      | "Sep" | "Oct" | "Nov" | "Dec"                      "  }
{                                                                              }
function  RFC850DayOfWeekB(const S: RawByteString): Integer;
function  RFC850DayOfWeekU(const S: UnicodeString): Integer;

function  RFC1123DayOfWeek(const S: String): Integer;
function  RFC1123DayOfWeekB(const S: RawByteString): Integer;
function  RFC1123DayOfWeekU(const S: UnicodeString): Integer;

function  RFCMonth(const S: String): Word;
function  RFCMonthB(const S: RawByteString): Word;
function  RFCMonthU(const S: UnicodeString): Word;

function  GMTTimeToRFC1123Time(const D: TDateTime;
          const IncludeSeconds: Boolean = False): String;
function  GMTTimeToRFC1123TimeB(const D: TDateTime;
          const IncludeSeconds: Boolean = False): RawByteString;
function  GMTTimeToRFC1123TimeU(const D: TDateTime;
          const IncludeSeconds: Boolean = False): UnicodeString;

function  GMTDateTimeToRFC1123DateTime(const D: TDateTime;
          const IncludeDayOfWeek: Boolean = True): String;
function  GMTDateTimeToRFC1123DateTimeB(const D: TDateTime;
          const IncludeDayOfWeek: Boolean = True): RawByteString;
function  GMTDateTimeToRFC1123DateTimeU(const D: TDateTime;
          const IncludeDayOfWeek: Boolean = True): UnicodeString;

function  DateTimeToRFCDateTimeA(const D: TDateTime): RawByteString;
function  DateTimeToRFCDateTimeU(const D: TDateTime): UnicodeString;

function  NowAsRFCDateTimeA: RawByteString;
function  NowAsRFCDateTimeU: UnicodeString;

function  RFCDateTimeToGMTDateTimeA(const S: RawByteString): TDateTime;
function  RFCDateTimeToDateTimeA(const S: RawByteString): TDateTime;

function  RFCTimeZoneToGMTBiasB(const Zone: RawByteString): Integer;



{                                                                              }
{ Constants                                                                    }
{                                                                              }
{   TropicalYear is the time for one orbit of the earth around the sun.        }
{   SynodicMonth is the time between two full moons.                           }
{                                                                              }
const
  TropicalYear = 365.24219 * OneDay;  // 365 days, 5 hr, 48 min, 46 sec
  SynodicMonth = 29.53059 * OneDay;



{                                                                              }
{ Natural language                                                             }
{                                                                              }
function  TimePeriodStr(const D: TDateTime): RawByteString;



{                                                                              }
{ Test                                                                         }
{                                                                              }
{$IFDEF DATETIME_TEST}
procedure Test;
{$ENDIF}



implementation

uses
  { System }
  {$IFDEF MSWIN}
  Windows,
  {$ENDIF}

  {$IFDEF DELPHI6_UP}
  DateUtils,
  {$ENDIF}

  {$IFDEF UNIX}
  {$IFDEF FREEPASCAL}
  BaseUnix,
  Unix,
  {$ENDIF}
  {$ENDIF}

  {$IFDEF POSIX}
  {$IFDEF DELPHI}
  Posix.SysTime,
  {$ENDIF}
  {$ENDIF}

  { Fundamentals }
  flcUtils,
  {$IFDEF DATETIME_TEST}
  flcTimers,
  {$ENDIF}
  flcStrings;



resourcestring
  SInvalidANSIDateFormat       = 'Invalid ANSI date format';
  SInvalidISOIntegerDateFormat = 'Invalid ISO Integer date format';



{                                                                              }
{ Decoding                                                                     }
{                                                                              }
const
  // DateTruncateFraction is the float value adjustment used when truncating.
  // This avoids truncating errors caused by the inexact nature of floating
  // point representation.
  DateTruncateFraction = OneMillisecond / 8.0;

function DatePart(const D: TDateTime): Integer;
begin
  // Adjust away from zero before truncating
  if D < 0 then
    Result := Trunc(D - DateTruncateFraction)
  else
    Result := Trunc(D + DateTruncateFraction);
end;

function TimePart(const D: TDateTime): Double;
begin
  Result := Abs(Frac(D));
end;

function Century(const D: TDateTime): Word;
begin
  Result := Year(D) div 100;
end;

function Year(const D: TDateTime): Word;
var Mo, Da : Word;
begin
  DecodeDate(D, Result, Mo, Da);
end;

function Month(const D: TDateTime): Word;
var Ye, Da : Word;
begin
  DecodeDate(D, Ye, Result, Da);
end;

function Day(const D: TDateTime): Word;
var Ye, Mo : Word;
begin
  DecodeDate(D, Ye, Mo, Result);
end;

function Hour(const D: TDateTime): Word;
var Mi, Se, MS : Word;
begin
  DecodeTime(D, Result, Mi, Se, MS);
end;

function Minute(const D: TDateTime): Word;
var Ho, Se, MS : Word;
begin
  DecodeTime(D, Ho, Result, Se, MS);
end;

function Second(const D: TDateTime): Word;
var Ho, Mi, MS : Word;
begin
  DecodeTime(D, Ho, Mi, Result, MS);
end;

function Millisecond(const D: TDateTime): Word;
var Ho, Mi, Se : Word;
begin
  DecodeTime(D, Ho, Mi, Se, Result);
end;

{$IFNDEF DELPHI6_UP}
procedure DecodeDateTime(const DateTime: TDateTime; out Year, Month, Day, Hour, Minute, Second, Millisecond : Word);
begin
  DecodeDate(DateTime, Year, Month, Day);
  DecodeTime(DateTime, Hour, Minute, Second, Millisecond);
end;

function EncodeDateTime(const Year, Month, Day, Hour, Minute, Second, Millisecond: Word): TDateTime;
var T : TDateTime;
begin
  Result := EncodeDate(Year, Month, Day);
  T := EncodeTime(Hour, Minute, Second, Millisecond);
  if Result >= 0 then
    Result := Result + T
  else
    Result := Result - T;
end;
{$ENDIF}



{                                                                              }
{ Encoding                                                                     }
{                                                                              }
procedure SetYear(var D: TDateTime; const Year: Word);
var Ye, Mo, Da, Ho, Mi, Se, Ms : Word;
begin
  DecodeDateTime(D, Ye, Mo, Da, Ho, Mi, Se, Ms);
  D := EncodeDateTime(Year, Mo, Da, Ho, Mi, Se, Ms);
end;

procedure SetMonth(var D: TDateTime; const Month: Word);
var Ye, Mo, Da, Ho, Mi, Se, Ms : Word;
begin
  DecodeDateTime(D, Ye, Mo, Da, Ho, Mi, Se, Ms);
  D := EncodeDateTime(Ye, Month, Da, Ho, Mi, Se, Ms);
end;

procedure SetDay(var D: TDateTime; const Day: Word);
var Ye, Mo, Da, Ho, Mi, Se, Ms : Word;
begin
  DecodeDateTime(D, Ye, Mo, Da, Ho, Mi, Se, Ms);
  D := EncodeDateTime(Ye, Mo, Day, Ho, Mi, Se, Ms);
end;

procedure SetHour(var D: TDateTime; const Hour: Word);
var Ye, Mo, Da, Ho, Mi, Se, Ms : Word;
begin
  DecodeDateTime(D, Ye, Mo, Da, Ho, Mi, Se, Ms);
  D := EncodeDateTime(Ye, Mo, Da, Hour, Mi, Se, Ms);
end;

procedure SetMinute(var D: TDateTime; const Minute: Word);
var Ye, Mo, Da, Ho, Mi, Se, Ms : Word;
begin
  DecodeDateTime(D, Ye, Mo, Da, Ho, Mi, Se, Ms);
  D := EncodeDateTime(Ye, Mo, Da, Ho, Minute, Se, Ms);
end;

procedure SetSecond(var D: TDateTime; const Second: Word);
var Ye, Mo, Da, Ho, Mi, Se, Ms : Word;
begin
  DecodeDateTime(D, Ye, Mo, Da, Ho, Mi, Se, Ms);
  D := EncodeDateTime(Ye, Mo, Da, Ho, Mi, Second, Ms);
end;

procedure SetMillisecond(var D: TDateTime; const Milliseconds: Word);
var Ye, Mo, Da, Ho, Mi, Se, Ms : Word;
begin
  DecodeDateTime(D, Ye, Mo, Da, Ho, Mi, Se, Ms);
  D := EncodeDateTime(Ye, Mo, Da, Ho, Mi, Se, Milliseconds);
end;



{                                                                              }
{ Comparison                                                                   }
{                                                                              }
function IsEqual(const D1, D2: TDateTime): Boolean;
begin
  Result := Abs(D1 - D2) < OneMillisecond;
end;

function IsEqual(const D1: TDateTime; const Ye, Mo, Da: Word): Boolean;
var Ye1, Mo1, Da1 : Word;
begin
  DecodeDate(D1, Ye1, Mo1, Da1);
  Result := (Da = Da1) and (Mo = Mo1) and (Ye = Ye1);
end;

function IsEqual(const D1: TDateTime; const Ho, Mi, Se, ms: Word): Boolean;
var Ho1, Mi1, Se1, ms1 : Word;
begin
  DecodeTime(D1, Ho1, Mi1, Se1, ms1);
  Result := (ms = ms1) and (Se = Se1) and (Mi = Mi1) and (Ho = Ho1);
end;

function IsAM(const D: TDateTime): Boolean;
begin
  Result := TimePart(D) < 0.5;
end;

function IsPM(const D: TDateTime): Boolean;
begin
  Result := TimePart(D) >= 0.5;
end;

function IsNoon(const D: TDateTime): Boolean;
var T : Double;
begin
  T := TimePart(D);
  Result := (T >= 0.5) and (T < 0.5 + OneMillisecond);
end;

function IsMidnight(const D: TDateTime): Boolean;
begin
  Result := TimePart(D) < OneMillisecond;
end;

function IsSunday(const D: TDateTime): Boolean;
begin
  Result := DayOfWeek(D) = 1;
end;

function IsMonday(const D: TDateTime): Boolean;
begin
  Result := DayOfWeek(D) = 2;
end;

function IsTuesday(const D: TDateTime): Boolean;
begin
  Result := DayOfWeek(D) = 3;
end;

function IsWedneday(const D: TDateTime): Boolean;
begin
  Result := DayOfWeek(D) = 4;
end;

function IsThursday(const D: TDateTime): Boolean;
begin
  Result := DayOfWeek(D) = 5;
end;

function IsFriday(const D: TDateTime): Boolean;
begin
  Result := DayOfWeek(D) = 6;
end;

function IsSaturday(const D: TDateTime): Boolean;
begin
  Result := DayOfWeek(D) = 7;
end;

function IsWeekend(const D: TDateTime): Boolean;
begin
  Result := Byte(DayOfWeek(D)) in [1, 7];
end;



{                                                                              }
{ Relative calculations                                                        }
{                                                                              }
function Noon(const D: TDateTime): TDateTime;
begin
  Result := DatePart(D) + 0.5 * OneDay;
end;

function Midnight(const D: TDateTime): TDateTime;
var Ye, Mo, Da : Word;
begin
  DecodeDate(D, Ye, Mo, Da);
  Result := EncodeDate(Ye, Mo, Da);
end;

function NextWorkday(const D: TDateTime): TDateTime;
begin
  case DayOfWeek(D) of
    1..5 : Result := DatePart(D) + OneDay;      // 1..5 Sun..Thu
    6    : Result := DatePart(D) + 3 * OneDay;  // 6    Fri
  else
    Result := DatePart(D) + 2 * OneDay;         // 7    Sat
  end;
end;

function PreviousWorkday(const D: TDateTime): TDateTime;
begin
  case DayOfWeek(D) of
    1 : Result := DatePart(D) - 2 * OneDay;  // 1    Sun
    2 : Result := DatePart(D) - 3 * OneDay;  // 2    Mon
  else
    Result := DatePart(D) - OneDay;          // 3..7 Tue-Sat
  end;
end;

function LastDayOfMonth(const D: TDateTime): TDateTime;
var Ye, Mo, Da : Word;
begin
  DecodeDate(D, Ye, Mo, Da);
  Result := EncodeDate(Ye, Mo, Word(DaysInMonth(Ye, Mo)));
end;

function FirstDayOfMonth(const D: TDateTime): TDateTime;
var Ye, Mo, Da : Word;
begin
  DecodeDate(D, Ye, Mo, Da);
  Result := EncodeDate(Ye, Mo, 1);
end;

function LastDayOfYear(const D: TDateTime): TDateTime;
var Ye, Mo, Da : Word;
begin
  DecodeDate(D, Ye, Mo, Da);
  Result := EncodeDate(Ye, 12, 31);
end;

function FirstDayOfYear(const D: TDateTime): TDateTime;
var Ye, Mo, Da : Word;
begin
  DecodeDate(D, Ye, Mo, Da);
  Result := EncodeDate(Ye, 1, 1);
end;

{ This algorithm comes from http://www.tondering.dk/claus/calendar.html:       }
{ " This algorithm is based in part on the algorithm of Oudin (1940) as        }
{   quoted in "Explanatory Supplement to the Astronomical Almanac",            }
{   P. Kenneth Seidelmann, editor.                                             }
{   People who want to dig into the workings of this algorithm, may be         }
{   interested to know that                                                    }
{     G is the Golden Number-1                                                 }
{     H is 23-Epact (modulo 30)                                                }
{     I is the number of days from 21 March to the Paschal full moon           }
{     J is the weekday for the Paschal full moon (0=Sunday, 1=Monday,etc.)     }
{     L is the number of days from 21 March to the Sunday on or before         }
{       the Paschal full moon (a number between -6 and 28) "                   }
function EasterSunday(const Year: Word): TDateTime;
var C, I, J, H, G, L : Integer;
    D, M : Word;
begin
  G := Year mod 19;
  C := Year div 100;
  H := (C - C div 4 - (8 * C + 13) div 25 + 19 * G + 15) mod 30;
  I := H - (H div 28) * (1 - (H div 28) * (29 div (H + 1)) * ((21 - G) div 11));
  J := (Year + Year div 4 + I + 2 - C + C div 4) mod 7;
  L := I - J;
  M := 3 + (L + 40) div 44;
  D := L + 28 - 31 * (M div 4);
  Result := EncodeDate(Year, M, D);
end;

function GoodFriday(const Year: Word): TDateTime;
begin
  Result := EasterSunday(Year) - 2 * OneDay;
end;

function AddMilliseconds(const D: TDateTime; const N: Int64): TDateTime;
var R : Integer;
    T : Double;
begin
  R := DatePart(D) + (N div 86400000);
  T := TimePart(D) + (N mod 86400000) / 86400000.0;
  if T >= 1.0 then
  begin
    if R >= 0 then
      Inc(R)
    else
      Dec(R);
    T := Frac(T);
  end;
  if R >= 0 then
    Result := R + T
  else
    Result := R - T;
end;

function AddSeconds(const D: TDateTime; const N: Int64): TDateTime;
var R : Integer;
    T : Double;
begin
  R := DatePart(D) + (N div 86400);
  T := TimePart(D) + (N mod 86400) / 86400.0;
  if T >= 1.0 then
  begin
    if R >= 0 then
      Inc(R)
    else
      Dec(R);
    T := Frac(T);
  end;
  if R >= 0 then
    Result := R + T
  else
    Result := R - T;
end;

function AddMinutes(const D: TDateTime; const N: Integer): TDateTime;
var R : Integer;
    T : Double;
begin
  R := DatePart(D) + (N div 1440);
  T := TimePart(D) + (N mod 1440) / 1440.0;
  if T >= 1.0 then
  begin
    if R >= 0 then
      Inc(R)
    else
      Dec(R);
    T := Frac(T);
  end;
  if R >= 0 then
    Result := R + T
  else
    Result := R - T;
end;

function AddHours(const D: TDateTime; const N: Integer): TDateTime;
var R : Integer;
    T : Double;
begin
  R := DatePart(D) + (N div 24);
  T := TimePart(D) + (N mod 24) / 24.0;
  if T >= 1.0 then
  begin
    if R >= 0 then
      Inc(R)
    else
      Dec(R);
    T := Frac(T);
  end;
  if R >= 0 then
    Result := R + T
  else
    Result := R - T;
end;

function AddDays(const D: TDateTime; const N: Integer): TDateTime;
begin
  Result := D + N;
end;

function AddWeeks(const D: TDateTime; const N: Integer): TDateTime;
begin
  Result := D + N * 7 * OneDay;
end;

function AddMonths(const D: TDateTime; const N: Integer): TDateTime;
var Ye, Mo, Da : Word;
    IMo : Integer;
    T : Double;
begin
  DecodeDate(D, Ye, Mo, Da);
  Inc(Ye, N div 12);
  IMo := Mo;
  Inc(IMo, N mod 12);
  if IMo > 12 then
    begin
      Dec(IMo, 12);
      Inc(Ye);
    end else
    if IMo < 1 then
      begin
        Inc(IMo, 12);
        Dec(Ye);
      end;
  Mo := Word(IMo);
  Da := Word(MinInt(Da, DaysInMonth(Ye, Mo)));
  Result := EncodeDate(Ye, Mo, Da);
  T := TimePart(D);
  if DatePart(Result) >= 0 then
    Result := Result + T
  else
    Result := Result - T;
end;

function AddYears(const D: TDateTime; const N: Integer): TDateTime;
var Ye, Mo, Da : Word;
    T : Double;
begin
  DecodeDate(D, Ye, Mo, Da);
  Inc(Ye, N);
  Da := Word(MinInt(Da, DaysInMonth(Ye, Mo)));
  Result := EncodeDate(Ye, Mo, Da);
  T := TimePart(D);
  if DatePart(Result) >= 0 then
    Result := Result + T
  else
    Result := Result - T;
end;




{                                                                              }
{ Counting                                                                     }
{                                                                              }
const
  DaysInNonLeapMonth : array[1..12] of Integer = (
    31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  CumDaysInNonLeapMonth : array[1..12] of Integer = (
    0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);

function DayOfYear(const Ye, Mo, Da: Word): Integer; overload;
begin
  Result := CumDaysInNonLeapMonth[Mo] + Da;
  if (Mo > 2) and IsLeapYear(Ye) then
    Inc(Result);
end;

function DayOfYear(const D: TDateTime): Integer; overload;
var Ye, Mo, Da : Word;
begin
  DecodeDate(D, Ye, Mo, Da);
  Result := DayOfYear(Ye, Mo, Da);
end;

function DaysInMonth(const Ye, Mo: Word): Integer;
begin
  Result := DaysInNonLeapMonth[Mo];
  if (Mo = 2) and IsLeapYear(Ye) then
    Inc(Result);
end;

function DaysInMonth(const D: TDateTime): Integer;
var Ye, Mo, Da : Word;
begin
  DecodeDate(D, Ye, Mo, Da);
  Result := DaysInMonth(Ye, Mo);
end;

function DaysInYear(const Ye: Word): Integer;
begin
  if IsLeapYear(Ye) then
    Result := 366
  else
    Result := 365;
end;

function DaysInYearDate(const D: TDateTime): Integer;
var Ye, Mo, Da : Word;
begin
  DecodeDate(D, Ye, Mo, Da);
  Result := DaysInYear(Ye);
end;

function WeekNumber(const D: TDateTime): Integer;
begin
  Result := (DiffDays(FirstDayOfYear(D), D) div 7) + 1;
end;

{ ISO Week functions courtesy of Martin Boonstra (m.boonstra at imn.nl)        }
function ISOFirstWeekOfYear(const Ye: Word): TDateTime;
const WeekStartOffset: array[1..7] of Integer = (1, 0, -1, -2, -3, 3, 2);
            // Weekday  Start of ISO week 1 is
            //  1 Su          02-01-Year
            //  2 Mo          01-01-Year
            //  3 Tu          31-12-(Year-1)
            //  4 We          30-12-(Year-1)
            //  5 Th          29-12-(Year-1)
            //  6 Fr          04-01-Year
            //  7 Sa          03-01-Year
begin
  // Adjust with an offset from 01-01-Ye
  Result := EncodeDate(Ye, 1, 1);
  Result := AddDays(Result, WeekStartOffset[DayOfWeek(Result)]);
end;

procedure ISOWeekNumber(const D: TDateTime; var WeekNumber, WeekYear : Word);
var Ye : Word;
    ISOFirstWeekOfPrevYear,
    ISOFirstWeekOfCurrYear,
    ISOFirstWeekOfNextYear : TDateTime;
begin
  { 3 cases:                                                       }
  {   1: D < ISOFirstWeekOfCurrYear                                }
  {       D lies in week 52/53 of previous year                    }
  {   2: ISOFirstWeekOfCurrYear <= D < ISOFirstWeekOfNextYear      }
  {       D lies in week N (1..52/53) of this year                 }
  {   3: D >= ISOFirstWeekOfNextYear                               }
  {       D lies in week 1 of next year                            }
  Ye := Year(D);
  ISOFirstWeekOfCurrYear := ISOFirstWeekOfYear(Ye);
  if D >= ISOFirstWeekOfCurrYear then
    begin
      ISOFirstWeekOfNextYear := ISOFirstWeekOfYear(Ye + 1);
      if (D < ISOFirstWeekOfNextYear) then
        begin // case 2
          WeekNumber := DiffDays(ISOFirstWeekOfCurrYear, D) div 7 + 1;
          WeekYear := Ye;
        end else
        begin // case 3
          WeekNumber := 1;
          WeekYear := Ye + 1;
        end;
    end else
    begin // case 1
      ISOFirstWeekOfPrevYear := ISOFirstWeekOfYear(Ye - 1);
      WeekNumber := DiffDays(ISOFirstWeekOfPrevYear, D) div 7 + 1;
      WeekYear := Ye - 1;
    end;
end;



{                                                                              }
{ Difference                                                                   }
{                                                                              }
function DiffDateTime(const D1, D2: TDateTime; const Period: Double): Int64;
var R : Double;
begin
  R := D2 - D1;
  // Adjust away from zero to ensure correct result when truncating
  if R < 0.0 then
    R := R - DateTruncateFraction
  else
    R := R + DateTruncateFraction;
  Result := Trunc(R / Period);
end;

function DiffMilliseconds(const D1, D2: TDateTime): Int64;
begin
  Result := DiffDateTime(D1, D2, OneMillisecond);
end;

function DiffSeconds(const D1, D2: TDateTime): Int64;
begin
  Result := DiffDateTime(D1, D2, OneSecond);
end;

function DiffMinutes(const D1, D2: TDateTime): Int64;
begin
  Result := DiffDateTime(D1, D2, OneMinute);
end;

function DiffHours(const D1, D2: TDateTime): Int64;
begin
  Result := DiffDateTime(D1, D2, OneHour);
end;

function DiffDays(const D1, D2: TDateTime): Integer;
begin
  Result := DatePart(D2 - D1);
end;

function DiffWeeks(const D1, D2: TDateTime): Integer;
begin
  Result := DatePart(D2 - D1) div 7;
end;

function DiffMonths(const D1, D2: TDateTime): Integer;
var Ye1, Mo1, Da1 : Word;
    Ye2, Mo2, Da2 : Word;
    ModMonth1,
    ModMonth2     : TDateTime;
begin
  DecodeDate(D1, Ye1, Mo1, Da1);
  DecodeDate(D2, Ye2, Mo2, Da2);
  Result := (Ye2 - Ye1) * 12 + (Mo2 - Mo1);
  ModMonth1 := Da1 + TimePart(D1);
  ModMonth2 := Da2 + TimePart(D2);
  if (D2 > D1) and (ModMonth2 < ModMonth1) then
    Dec(Result);
  if (D2 < D1) and (ModMonth2 > ModMonth1) then
    Inc(Result);
end;

function DiffYears(const D1, D2: TDateTime): Integer;
var Ye1, Mo1, Da1 : Word;
    Ye2, Mo2, Da2 : Word;
    ModYear1,
    ModYear2      : TDateTime;
begin
  DecodeDate(D1, Ye1, Mo1, Da1);
  DecodeDate(D2, Ye2, Mo2, Da2);
  Result := Ye2 - Ye1;
  ModYear1 := Mo1 * 31 + Da1 + TimePart(Da1);
  ModYear2 := Mo2 * 31 + Da2 + TimePart(Da2);
  if (D2 > D1) and (ModYear2 < ModYear1) then
    Dec(Result);
  if (D2 < D1) and (ModYear2 > ModYear1) then
    Inc(Result);
end;



{                                                                              }
{ Time Zone                                                                    }
{                                                                              }

{ Returns the GMT bias (in minutes) from the operating system's regional       }
{ settings.                                                                    }
{$IFDEF WindowsPlatform}
function GMTBias: Integer;
var TZI : TTimeZoneInformation;
begin
  case GetTimeZoneInformation(TZI) of
    TIME_ZONE_ID_STANDARD : Result := TZI.StandardBias;
    TIME_ZONE_ID_DAYLIGHT : Result := TZI.DaylightBias
  else
    Result := 0;
  end;
  Result := Result + TZI.Bias;
end;
{$ENDIF}

{$IFDEF UNIX}
{$IFDEF FREEPASCAL}
function GMTBias: Integer;
var TV : TTimeVal;
    TZ : PTimeZone;
begin
  TZ := nil;
  fpGetTimeOfDay(@TV, TZ);
  if Assigned(TZ) then
    Result := TZ^.tz_minuteswest div 60
  else
    Result := 0;
end;
{$ENDIF}
{$ENDIF}

{$IFDEF POSIX}
{$IFDEF DELPHI}
function GMTBias: Integer;
begin
  Result := 0;
end;
{$ENDIF}
{$ENDIF}

{ Converts GMT Time to Local Time                                              }
function GMTTimeToLocalTime(const D: TDateTime): TDateTime;
begin
  Result := D - GMTBias / (24.0 * 60.0);
end;

{ Converts Local Time to GMT Time                                              }
function LocalTimeToGMTTime(const D: TDateTime): TDateTime;
begin
  Result := D + GMTBias / (24.0 * 60.0);
end;

function NowAsGMTTime: TDateTime;
begin
  Result := LocalTimeToGMTTime(Now);
end;



{                                                                              }
{ Conversions                                                                  }
{                                                                              }
function DateTimeToISO8601StringB(const D: TDateTime): RawByteString;
begin
  Result :=
      StrPadLeftB(IntToStringB(Year(D)),   '0', 2, False) +
      StrPadLeftB(IntToStringB(Month(D)),  '0', 2, False) +
      StrPadLeftB(IntToStringB(Day(D)),    '0', 2, False) + 'T' +
      StrPadLeftB(IntToStringB(Hour(D)),   '0', 2, False) + ':' +
      StrPadLeftB(IntToStringB(Minute(D)), '0', 2, False) + ':' +
      StrPadLeftB(IntToStringB(Second(D)), '0', 2, False);
end;

function ISO8601StringToTime(const D: RawByteString): TDateTime;
var P : RawByteStringArray;
    L : Integer;
    Ho, Mi, Se, S1 : Word;
begin
  P := StrSplitCharB(D, ':');
  L := Length(P);
  if (L < 2) or (L > 4) then
    raise EDateTime.Create('Invalid time');
  Ho := Word(StringToIntB(P[0]));
  Mi := Word(StringToIntB(P[1]));
  if L >= 3 then
    Se := Word(StringToIntB(P[2]))
  else
    Se := 0;
  if L >= 4 then
    S1 := Word(StringToIntB(P[3]))
  else
    S1 := 0;
  Result := EncodeTime(Ho, Mi, Se, S1);
end;

function ISO8601StringAsDateTime(const D: RawByteString): TDateTime;
var Date, Time : RawByteString;
    Ye, Mo, Da : Word;
begin
  Date := '';
  Time := '';
  StrSplitAtCharSetB(D, ['T', 't'], Date, Time);
  Ye := Word(StringToIntB(CopyLeftB(Date, 4)));
  Mo := Word(StringToIntB(CopyRangeB(Date, 5, 6)));
  Da := Word(StringToIntB(CopyRangeB(Date, 7, 8)));
  Result := EncodeDate(Ye, Mo, Da) + ISO8601StringToTime(Time);
end;

function DateTimeToANSI(const D: TDateTime): Integer;
var Ye, Mo, Da : Word;
begin
  DecodeDate(D, Ye, Mo, Da);
  Result := Ye * 1000 + DayOfYear(Ye, Mo, Da);
end;

function ANSIToDateTime(const Julian: Integer): TDateTime;
const MaxJulian = $FFFF * 1000 + 366;
var DDD     : Integer;
    C, J    : Integer;
    M, Y, I : Word;
begin
  DDD := Julian mod 1000;
  if (DDD = 0) or (DDD > 366) or (Julian > MaxJulian) then
    raise EDateTime.Create(SInvalidANSIDateFormat);

  Y := Julian div 1000;
  M := 0;
  C := 0;
  for I := 1 to 12 do
    begin
      J := DaysInNonLeapMonth[I];
      if (I = 2) and IsLeapYear(Y) then
        Inc(J);
      Inc(C, J);
      if C >= DDD then
        begin
          M := I;
          break;
        end;
    end;
  if M = 0 then // DDD > end of year
    raise EDateTime.Create(SInvalidANSIDateFormat);

  Result := EncodeDate(Y, M, DDD - C + J);
end;

function DateTimeToISOInteger(const D: TDateTime): Integer;
var Ye, Mo, Da : Word;
begin
  DecodeDate(D, Ye, Mo, Da);
  Result := Ye * 10000 + Mo * 100 + Da;
end;

function DateTimeToISOStringB(const D: TDateTime): RawByteString;
var Ye, Mo, Da : Word;
begin
  DecodeDate(D, Ye, Mo, Da);
  Result := IntToStringB(Ye) + '-' +
            StrPadLeftB(IntToStringB(Mo), '0', 2) + '-' +
            StrPadLeftB(IntToStringB(Da), '0', 2);
end;

function ISOIntegerToDateTime(const ISOInteger: Integer): TDateTime;
var Ye, Mo, Da : Word;
begin
  Ye := ISOInteger div 10000;
  Mo := (ISOInteger mod 10000) div 100;
  if (Mo < 1) or (Mo > 12) then
    raise EDateTime.Create(SInvalidISOIntegerDateFormat);
  Da := ISOInteger mod 100;
  if (Da < 1) or (Da > DaysInMonth(Ye, Mo)) then
    raise EDateTime.Create(SInvalidISOIntegerDateFormat);
  Result := EncodeDate(Ye, Mo, Da);
end;

function TwoDigitRadix2000YearToYear(const Y: Integer): Integer;
begin
  if Y < 50 then
    Result := 2000 + Y
  else
    Result := 1900 + Y;
end;

function DateTimeAsElapsedTimeB(const D: TDateTime;
    const IncludeMilliseconds: Boolean): RawByteString;
var I : Integer;
begin
  I := DatePart(D);
  if I > 0 then
    Result := IntToStringB(I) + '.'
  else
    Result := '';
  Result := Result + IntToStringB(Hour(D)) + ':' +
            StrPadLeftB(IntToStringB(Minute(D)), '0', 2) + ':' +
            StrPadLeftB(IntToStringB(Second(D)), '0', 2);
  if IncludeMilliseconds then
    Result := Result + '.' + StrPadLeftB(IntToStringB(Millisecond(D)), '0', 3);
end;

// Unix time is the number of seconds elapsed since 1 Jan 1970
const
  UnixBaseTime = 25569.0; // 1 Jan 1970 as TDateTime

function UnixTimeToDateTime(const UnixTime: Word32): TDateTime;
begin
  Result := UnixBaseTime + UnixTime / SecondsPerDay;
end;

function DateTimeToUnixTime(const D: TDateTime): Word32;
begin
  Result := Trunc((D - UnixBaseTime) * SecondsPerDay);
end;



{                                                                              }
{ English Language DateTimes                                                   }
{                                                                              }
const
  EnglishShortDayNamesA : array[1..7] of RawByteString = (
      'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
  EnglishShortDayNamesU : array[1..7] of UnicodeString = (
      'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');

  EnglishLongDayNamesA : array[1..7] of RawByteString = (
      'Sunday', 'Monday', 'Tuesday', 'Wednesday',
      'Thursday', 'Friday', 'Saturday');
  EnglishLongDayNamesU : array[1..7] of UnicodeString = (
      'Sunday', 'Monday', 'Tuesday', 'Wednesday',
      'Thursday', 'Friday', 'Saturday');

  EnglishShortMonthNamesA : array[1..12] of RawByteString = (
      'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
      'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  EnglishShortMonthNamesU : array[1..12] of UnicodeString = (
      'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
      'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');

  EnglishLongMonthNamesA : array[1..12] of RawByteString = (
      'January', 'February', 'March', 'April', 'May', 'June',
      'July', 'August', 'September', 'October', 'November', 'December');
  EnglishLongMonthNamesU : array[1..12] of UnicodeString = (
      'January', 'February', 'March', 'April', 'May', 'June',
      'July', 'August', 'September', 'October', 'November', 'December');

function EnglishShortDayOfWeekStrA(const DayOfWeek: Integer): RawByteString;
begin
  if DayOfWeek in [1..7] then
    Result := EnglishShortDayNamesA[DayOfWeek]
  else
    Result := '';
end;

function EnglishShortDayOfWeekStrU(const DayOfWeek: Integer): UnicodeString;
begin
  if DayOfWeek in [1..7] then
    Result := EnglishShortDayNamesU[DayOfWeek]
  else
    Result := '';
end;

function EnglishLongDayOfWeekStrA(const DayOfWeek: Integer): RawByteString;
begin
  if DayOfWeek in [1..7] then
    Result := EnglishLongDayNamesA[DayOfWeek]
  else
    Result := '';
end;

function EnglishLongDayOfWeekStrU(const DayOfWeek: Integer): UnicodeString;
begin
  if DayOfWeek in [1..7] then
    Result := EnglishLongDayNamesU[DayOfWeek]
  else
    Result := '';
end;

function EnglishShortMonthStrA(const Month: Integer): RawByteString;
begin
  if Month in [1..12] then
    Result := EnglishShortMonthNamesA[Month]
  else
    Result := '';
end;

function EnglishShortMonthStrU(const Month: Integer): UnicodeString;
begin
  if Month in [1..12] then
    Result := EnglishShortMonthNamesU[Month]
  else
    Result := '';
end;

function EnglishLongMonthStrA(const Month: Integer): RawByteString;
begin
  if Month in [1..12] then
    Result := EnglishLongMonthNamesA[Month]
  else
    Result := '';
end;

function EnglishLongMonthStrU(const Month: Integer): UnicodeString;
begin
  if Month in [1..12] then
    Result := EnglishLongMonthNamesU[Month]
  else
    Result := '';
end;

function EnglishShortDayOfWeekA(const S: RawByteString): Integer;
var I : Integer;
begin
  for I := 1 to 7 do
    if StrEqualNoAsciiCaseB(EnglishShortDayNamesA[I], S) then
      begin
        Result := I;
        exit;
      end;
  Result := -1;
end;

function EnglishShortDayOfWeekU(const S: UnicodeString): Integer;
var I : Integer;
begin
  for I := 1 to 7 do
    if StrEqualNoAsciiCaseU(EnglishShortDayNamesU[I], S) then
      begin
        Result := I;
        exit;
      end;
  Result := -1;
end;

function EnglishLongDayOfWeekA(const S: RawByteString): Integer;
var I : Integer;
begin
  for I := 1 to 7 do
    if StrEqualNoAsciiCaseB(EnglishLongDayNamesA[I], S) then
      begin
        Result := I;
        exit;
      end;
  Result := -1;
end;

function EnglishLongDayOfWeekU(const S: UnicodeString): Integer;
var I : Integer;
begin
  for I := 1 to 7 do
    if StrEqualNoAsciiCaseU(EnglishLongDayNamesU[I], S) then
      begin
        Result := I;
        exit;
      end;
  Result := -1;
end;

function EnglishShortMonthA(const S: RawByteString): Integer;
var I : Integer;
begin
  for I := 1 to 12 do
    if StrEqualNoAsciiCaseB(EnglishShortMonthNamesA[I], S) then
      begin
        Result := I;
        exit;
      end;
  Result := -1;
end;

function EnglishShortMonthU(const S: UnicodeString): Integer;
var I : Integer;
begin
  for I := 1 to 12 do
    if StrEqualNoAsciiCaseU(EnglishShortMonthNamesU[I], S) then
      begin
        Result := I;
        exit;
      end;
  Result := -1;
end;

function EnglishLongMonthA(const S: RawByteString): Integer;
var I : Integer;
begin
  for I := 1 to 12 do
    if StrEqualNoAsciiCaseB(EnglishLongMonthNamesA[I], S) then
      begin
        Result := I;
        exit;
      end;
  Result := -1;
end;

function EnglishLongMonthU(const S: UnicodeString): Integer;
var I : Integer;
begin
  for I := 1 to 12 do
    if StrEqualNoAsciiCaseU(EnglishLongMonthNamesU[I], S) then
      begin
        Result := I;
        exit;
      end;
  Result := -1;
end;



{                                                                              }
{ RFC DateTime                                                                 }
{                                                                              }
const
  RFC_SPACE = csWhiteSpace;

  RFC850DayNamesA : array[1..7] of RawByteString = (
      'Sunday', 'Monday', 'Tuesday', 'Wednesday',
      'Thursday', 'Friday', 'Saturday');
  RFC850DayNamesU : array[1..7] of UnicodeString = (
      'Sunday', 'Monday', 'Tuesday', 'Wednesday',
      'Thursday', 'Friday', 'Saturday');

  RFC1123DayNames : array[1..7] of String = (
      'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
  RFC1123DayNamesA : array[1..7] of RawByteString = (
      'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
  RFC1123DayNamesU : array[1..7] of UnicodeString = (
      'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');

  RFCMonthNames : array[1..12] of String = (
      'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
      'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  RFCMonthNamesA : array[1..12] of RawByteString = (
      'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
      'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  RFCMonthNamesU : array[1..12] of UnicodeString = (
      'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
      'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');

function RFC850DayOfWeekB(const S: RawByteString): Integer;
var I : Integer;
begin
  for I := 1 to 7 do
    if StrEqualNoAsciiCaseB(RFC850DayNamesA[I], S) then
      begin
        Result := I;
        exit;
      end;
  Result := -1;
end;

function RFC850DayOfWeekU(const S: UnicodeString): Integer;
var I : Integer;
begin
  for I := 1 to 7 do
    if StrEqualNoAsciiCaseU(RFC850DayNamesU[I], S) then
      begin
        Result := I;
        exit;
      end;
  Result := -1;
end;

function RFC1123DayOfWeek(const S: String): Integer;
var I : Integer;
begin
  for I := 1 to 7 do
    if StrEqualNoAsciiCase(RFC1123DayNames[I], S) then
      begin
        Result := I;
        exit;
      end;
  Result := -1;
end;

function RFC1123DayOfWeekB(const S: RawByteString): Integer;
var I : Integer;
begin
  for I := 1 to 7 do
    if StrEqualNoAsciiCaseB(RFC1123DayNamesA[I], S) then
      begin
        Result := I;
        exit;
      end;
  Result := -1;
end;

function RFC1123DayOfWeekU(const S: UnicodeString): Integer;
var I : Integer;
begin
  for I := 1 to 7 do
    if StrEqualNoAsciiCaseU(RFC1123DayNamesU[I], S) then
      begin
        Result := I;
        exit;
      end;
  Result := -1;
end;

function RFCMonth(const S: String): Word;
var I : Word;
begin
  for I := 1 to 12 do
    if StrEqualNoAsciiCase(RFCMonthNames[I], S) then
      begin
        Result := I;
        exit;
      end;
  Result := 0;
end;

function RFCMonthB(const S: RawByteString): Word;
var I : Word;
begin
  for I := 1 to 12 do
    if StrEqualNoAsciiCaseB(RFCMonthNamesA[I], S) then
      begin
        Result := I;
        exit;
      end;
  Result := 0;
end;

function RFCMonthU(const S: UnicodeString): Word;
var I : Word;
begin
  for I := 1 to 12 do
    if StrEqualNoAsciiCaseU(RFCMonthNamesU[I], S) then
      begin
        Result := I;
        exit;
      end;
  Result := 0;
end;

function GMTTimeToRFC1123Time(const D: TDateTime; const IncludeSeconds: Boolean): String;
var Ho, Mi, Se, Ms : Word;
begin
  DecodeTime(D, Ho, Mi, Se, Ms);
  Result := StrPadLeft(IntToString(Ho), '0', 2) + ':' +
            StrPadLeft(IntToString(Mi), '0', 2);
  if IncludeSeconds then
    Result := Result + ':' + StrPadLeft(IntToString(Se), '0', 2);
  Result := Result + ' GMT';
end;

function GMTTimeToRFC1123TimeB(const D: TDateTime; const IncludeSeconds: Boolean): RawByteString;
var Ho, Mi, Se, Ms : Word;
begin
  DecodeTime(D, Ho, Mi, Se, Ms);
  Result := StrPadLeftB(IntToStringB(Ho), '0', 2) + ':' +
            StrPadLeftB(IntToStringB(Mi), '0', 2);
  if IncludeSeconds then
    Result := Result + ':' + StrPadLeftB(IntToStringB(Se), '0', 2);
  Result := Result + ' GMT';
end;

function GMTTimeToRFC1123TimeU(const D: TDateTime; const IncludeSeconds: Boolean): UnicodeString;
var Ho, Mi, Se, Ms : Word;
begin
  DecodeTime(D, Ho, Mi, Se, Ms);
  Result := StrPadLeftU(IntToStringU(Ho), '0', 2) + ':' +
            StrPadLeftU(IntToStringU(Mi), '0', 2);
  if IncludeSeconds then
    Result := Result + ':' + StrPadLeftU(IntToStringU(Se), '0', 2);
  Result := Result + ' GMT';
end;

function GMTDateTimeToRFC1123DateTime(const D: TDateTime; const IncludeDayOfWeek: Boolean): String;
var Ye, Mo, Da : Word;
begin
  DecodeDate(D, Ye, Mo, Da);
  if IncludeDayOfWeek then
    Result := RFC1123DayNames[DayOfWeek(D)] + ', '
  else
    Result := '';
  Result := Result +
            StrPadLeft(IntToString(Da), '0', 2) + ' ' +
            RFCMonthNames[Mo] + ' ' +
            IntToString(Ye) + ' ' +
            GMTTimeToRFC1123Time(D, True);
end;

function GMTDateTimeToRFC1123DateTimeB(const D: TDateTime;
         const IncludeDayOfWeek: Boolean): RawByteString;
var Ye, Mo, Da : Word;
begin
  DecodeDate(D, Ye, Mo, Da);
  if IncludeDayOfWeek then
    Result := RFC1123DayNamesA[DayOfWeek(D)] + ', '
  else
    Result := '';
  Result := Result +
            StrPadLeftB(IntToStringB(Da), '0', 2) + ' ' +
            RFCMonthNamesA[Mo] + ' ' +
            IntToStringB(Ye) + ' ' +
            GMTTimeToRFC1123TimeB(D, True);
end;

function GMTDateTimeToRFC1123DateTimeU(const D: TDateTime; const IncludeDayOfWeek: Boolean): UnicodeString;
var Ye, Mo, Da : Word;
begin
  DecodeDate(D, Ye, Mo, Da);
  if IncludeDayOfWeek then
    Result := RFC1123DayNamesU[DayOfWeek(D)] + ', '
  else
    Result := '';
  Result := Result +
            StrPadLeftU(IntToStringU(Da), '0', 2) + ' ' +
            RFCMonthNamesU[Mo] + ' ' +
            IntToStringU(Ye) + ' ' +
            GMTTimeToRFC1123TimeU(D, True);
end;

function DateTimeToRFCDateTimeA(const D: TDateTime): RawByteString;
begin
  Result := GMTDateTimeToRFC1123DateTimeB(LocalTimeToGMTTime(D), True);
end;

function DateTimeToRFCDateTimeU(const D: TDateTime): UnicodeString;
begin
  Result := GMTDateTimeToRFC1123DateTimeU(LocalTimeToGMTTime(D), True);
end;

function NowAsRFCDateTimeA: RawByteString;
begin
  Result := DateTimeToRFCDateTimeA(Now);
end;

function NowAsRFCDateTimeU: UnicodeString;
begin
  Result := DateTimeToRFCDateTimeU(Now);
end;

type
  TRFCNamedZoneBias = record
     Zone : RawByteString;
     Bias : Integer;
   end;

const
  RFCNamedTimeZones = 76;
  RFCNamedZoneBias : array[1..RFCNamedTimeZones] of TRFCNamedZoneBias =
      ((Zone:'GMT';  Bias:0),       (Zone:'UT';   Bias:0),
       (Zone:'EST';  Bias:-5*60),   (Zone:'EDT';  Bias:-4*60),
       (Zone:'CST';  Bias:-6*60),   (Zone:'CDT';  Bias:-5*60),
       (Zone:'MST';  Bias:-7*60),   (Zone:'MDT';  Bias:-6*60),
       (Zone:'PST';  Bias:-8*60),   (Zone:'PDT';  Bias:-7*60),

       (Zone:'Z';    Bias:0),       (Zone:'A';    Bias:-1*60),
       (Zone:'B';    Bias:-2*60),   (Zone:'C';    Bias:-3*60),
       (Zone:'D';    Bias:-4*60),   (Zone:'E';    Bias:-5*60),
       (Zone:'F';    Bias:-6*60),   (Zone:'G';    Bias:-7*60),
       (Zone:'H';    Bias:-8*60),   (Zone:'I';    Bias:-9*60),
       (Zone:'K';    Bias:-10*60),  (Zone:'L';    Bias:-11*60),
       (Zone:'M';    Bias:-12*60),  (Zone:'N';    Bias:1*60),
       (Zone:'O';    Bias:2*60),    (Zone:'P';    Bias:3*60),
       (Zone:'Q';    Bias:4*60),    (Zone:'R';    Bias:3*60),
       (Zone:'S';    Bias:6*60),    (Zone:'T';    Bias:3*60),
       (Zone:'U';    Bias:8*60),    (Zone:'V';    Bias:3*60),
       (Zone:'W';    Bias:10*60),   (Zone:'X';    Bias:3*60),
       (Zone:'Y';    Bias:12*60),

       // Additional time zones (not specified in RFC)
       (Zone:'NZDT'; Bias:13*60),   (Zone:'IDLE'; Bias:12*60),
       (Zone:'NZST'; Bias:12*60),   (Zone:'NZT';  Bias:12*60),
       (Zone:'EADT'; Bias:11*60),   (Zone:'GST';  Bias:10*60),
       (Zone:'JST';  Bias:9*60),    (Zone:'CCT';  Bias:8*60),
       (Zone:'WADT'; Bias:8*60),    (Zone:'WAST'; Bias:7*60),
       (Zone:'ZP6';  Bias:6*60),    (Zone:'ZP5';  Bias:5*60),
       (Zone:'ZP4';  Bias:4*60),    (Zone:'BT';   Bias:3*60),
       (Zone:'EET';  Bias:2*60),    (Zone:'MEST'; Bias:2*60),
       (Zone:'MESZ'; Bias:2*60),    (Zone:'SST';  Bias:2*60),
       (Zone:'FST';  Bias:2*60),    (Zone:'CEST'; Bias:2*60),
       (Zone:'CET';  Bias:1*60),    (Zone:'FWT';  Bias:1*60),
       (Zone:'MET';  Bias:1*60),    (Zone:'MEWT'; Bias:1*60),
       (Zone:'SWT';  Bias:1*60),    (Zone:'UTC';  Bias:0),
       (Zone:'WET';  Bias:0*60),    (Zone:'WAT';  Bias:-1*60),
       (Zone:'BST';  Bias:-1*60),   (Zone:'AT';   Bias:-2*60),
       (Zone:'ADT';  Bias:-3*60),   (Zone:'AST';  Bias:-4*60),
       (Zone:'YDT';  Bias:-8*60),   (Zone:'YST';  Bias:-9*60),
       (Zone:'HDT';  Bias:-9*60),   (Zone:'AHST'; Bias:-10*60),
       (Zone:'CAT';  Bias:-10*60),  (Zone:'HST';  Bias:-10*60),
       (Zone:'EAST'; Bias:-10*60),  (Zone:'NT';   Bias:-11*60),
       (Zone:'IDLW'; Bias:-12*60) );

function RFCNamedTimeZoneToGMTBiasB(const TimeZone: RawByteString; out Bias: Integer): Boolean;
var I : Integer;
begin
  for I := 1 to RFCNamedTimeZones do
    if StrEqualNoAsciiCaseB(RFCNamedZoneBias[I].Zone, TimeZone) then
      begin
        Bias := RFCNamedZoneBias[I].Bias;
        Result := True;
        exit;
      end;
  Bias := 0;
  Result := False;
end;

function RFCTimeZoneToGMTBiasB(const Zone: RawByteString): Integer;
var
  C : ByteChar;
  S : RawByteString;
begin
  if Zone = '' then
    begin
      Result := 0;
      exit;
    end;
  C := Zone[1];
  if (C = '+') or (C = '-') then // +hhmm format
    begin
      S := StrTrimB(Zone, RFC_SPACE);
      Result := MaxInt(-23, MinInt(23, StringToIntDefB(Copy(S, 2, 2), 0))) * 60;
      S := CopyFromB(S, 4);
      if S <> '' then
        Result := Result + MinInt(59, MaxInt(0, StringToIntDefB(S, 0)));
      if Zone[1] = '-' then
        Result := -Result;
    end
  else
    begin // named format
      S := StrTrimB(Zone, RFC_SPACE);
      if not RFCNamedTimeZoneToGMTBiasB(S, Result) then
        Result := 0;
    end;
end;

procedure RFCTimeToGMTTime(const S: RawByteString; out Hours, Minutes, Seconds: Integer);
var
  I : Integer;
  T : RawByteString;
  Bias, HH, MM, SS : Integer;
  U : RawByteStringArray;
begin
  U := nil;
  Hours := 0;
  Minutes := 0;
  Seconds := 0;
  T := StrTrimB(S, RFC_SPACE);
  if T = '' then
    exit;

  // Get Zone bias
  I := PosCharSetRevB(RFC_SPACE, T);
  if I > 0 then
    begin
      Bias := RFCTimeZoneToGMTBiasB(CopyFromB(T, I + 1));
      T := StrTrimB(CopyLeftB(T, I - 1), RFC_SPACE);
    end
  else
    Bias := 0;

  // Get time
  U := StrSplitB(T, ':');
  if (Length(U) = 1) and (Length(U[0]) = 4) then
    begin // old hhmm format
      HH := StringToIntDefB(Copy(U[0], 1, 2), 0);
      MM := StringToIntDefB(Copy(U[0], 3, 2), 0);
      SS := 0;
    end else
  if (Length(U) >= 2) or (Length(U) <= 3) then // hh:mm[:ss] format (RFC1123)
    begin
      HH := StringToIntDefB(StrTrimB(U[0], RFC_SPACE), 0);
      MM := StringToIntDefB(StrTrimB(U[1], RFC_SPACE), 0);
      if Length(U) = 3 then
        SS := StringToIntDefB(StrTrimB(U[2], RFC_SPACE), 0) else
        SS := 0;
    end
  else
    exit;

  Hours := MaxInt(0, MinInt(23, HH));
  Minutes := MaxInt(0, MinInt(59, MM));
  Seconds := MaxInt(0, MinInt(59, SS));
  Inc(Hours, Bias div 60);
  Inc(Minutes, Bias mod 60);
end;

function EncodeBiasedDateTime(const Year, Month, Day, Hour, Minute, Second: Integer): TDateTime;
var Ho, Mi : Integer;
begin
  Result := EncodeDate(Word(Year), Word(Month), Word(Day));
  Ho := Hour;
  Mi := Minute;
  if Mi < 0 then
    begin
      Inc(Mi, 60);
      Dec(Ho);
    end;
  if Ho < 0 then
    begin
      Inc(Ho, 24);
      Result := AddDays(Result, -1);
    end;
  if Ho >= 24 then
    begin
      Dec(Ho, 24);
      Result := AddDays(Result, 1);
    end;
  Result := Result + EncodeTime(Word(Ho), Word(Mi), Word(Second), 0);
end;

{$IFDEF DELPHI5}{$OPTIMIZATION OFF}{$ENDIF}
function RFCDateTimeToGMTDateTimeA(const S: RawByteString): TDateTime;
var
  T, U : RawByteString;
  I : Integer;
  D, M, Y, DOW, Ho, Mi, Se : Integer;
  V, W : RawByteStringArray;
begin
  Result := 0.0;

  W := nil;
  T := StrTrimB(S, RFC_SPACE);

  // Extract Day of week
  I := PosCharSetB(RFC_SPACE + [','], T);
  if I > 0 then
    begin
      U := CopyLeftB(T, I - 1);
      DOW := RFC850DayOfWeekB(U);
      if DOW = -1 then
        DOW := RFC1123DayOfWeekB(U);
      if DOW <> -1 then
        T := StrTrimB(CopyFromB(S, I + 1), RFC_SPACE);
    end;

  V := StrSplitCharSetB(T, RFC_SPACE);
  if Length(V) < 3 then
    exit;

  if PosCharB('-', V[0]) > 0 then // RFC850 date, eg "Sunday, 06-Nov-94 08:49:37 GMT"
    begin
      W := StrSplitCharB(V[0], AnsiChar('-'));
      if Length(W) <> 3 then
        exit;
      M := RFCMonthB(W[1]);
      if M = 0 then
        exit;
      D := StringToIntDefB(W[0], 0);
      Y := StringToIntDefB(W[2], 0);
      if Y < 100 then
        Y := TwoDigitRadix2000YearToYear(Y);
      RFCTimeToGMTTime(V[1] + ' ' + V[2], Ho, Mi, Se);
      Result := EncodeBiasedDateTime(Y, M, D, Ho, Mi, Se);
      exit;
    end;

  M := RFCMonthB(V[1]);
  if M >= 1 then // RFC822 date, eg Sun, 06 Nov 1994 08:49:37 GMT
    begin
      D := StringToIntDefB(V[0], 0);
      Y := StringToIntDefB(V[2], 0);
      Ho := 0;
      Mi := 0;
      Se := 0;
      if Length(V) = 4 then
        RFCTimeToGMTTime(V[3], Ho, Mi, Se) else
      if Length(V) >= 5 then
        RFCTimeToGMTTime(V[3] + ' ' + V[4], Ho, Mi, Se);
      Result := EncodeBiasedDateTime(Y, M, D, Ho, Mi, Se);
      exit;
    end;

  M := RFCMonthB(V[0]);
  if M >= 1 then // ANSI C asctime() format, eg "Sun Nov  6 08:49:37 1994"
    begin
      D := StringToIntDefB(V[1], 0);
      Y := StringToIntDefB(V[3], 0);
      RFCTimeToGMTTime(V[2], Ho, Mi, Se);
      Result := EncodeBiasedDateTime(Y, M, D, Ho, Mi, Se);
    end;
end;
{$IFDEF DELPHI5}{$OPTIMIZATION ON}{$ENDIF}

function RFCDateTimeToDateTimeA(const S: RawByteString): TDateTime;
begin
  Result := GMTTimeToLocalTime(RFCDateTimeToGMTDateTimeA(S));
end;



{                                                                              }
{ Natural language                                                             }
{                                                                              }
function TimePeriodStr(const D: TDateTime): RawByteString;
var E : TDateTime;
    I : Integer;
begin
  E := Abs(D);
  if E < OneMillisecond then
    Result := '' else
  if E >= OneWeek then
    begin
      I := Trunc(D / OneWeek);
      if I = 1 then
        Result := 'a week'
      else
        Result := IntToStringB(I) + ' weeks';
    end else
  if E >= OneDay then
    begin
      I := Trunc(D / OneDay);
      if I = 1 then
        Result := 'a day'
      else
        Result := IntToStringB(I) + ' days';
    end else
  if E >= OneHour then
    begin
      I := Trunc(D / OneHour);
      if I = 1 then
        Result := 'an hour'
      else
        Result := IntToStringB(I) + ' hours';
    end else
  if E >= OneMinute then
    begin
      I := Trunc(D / OneMinute);
      if I = 1 then
        Result := 'a minute'
      else
        Result := IntToStringB(I) + ' minutes';
    end
  else
    begin
      I := Trunc(D / OneSecond);
      if I = 1 then
        Result := 'a second'
      else
        Result := IntToStringB(I) + ' seconds';
    end;
end;



{                                                                              }
{ Test                                                                         }
{                                                                              }
{$IFDEF DATETIME_TEST}
{$ASSERTIONS ON}
procedure Test;
var Ye, Mo, Da         : Word;
    Ho, Mi, Se, Ms     : Word;
    Ye2, Mo2, Da2      : Word;
    Ho2, Mi2, Se2, Ms2 : Word;
    A, B               : TDateTime;
    S                  : RawByteString;
    I                  : Integer;
begin
  Ho := 7;
  Mi := 10;
  Da := 8;
  Ms := 3;
  for Ye := 1999 to 2001 do
    for Mo := 1 to 12 do
      for Se := 0 to 59 do
        begin
          A := EncodeDateTime(Ye, Mo, Da, Ho, Mi, Se, Ms);
          DecodeDateTime(A, Ye2, Mo2, Da2, Ho2, Mi2, Se2, Ms2);
          Assert(Ye = Ye2, 'DecodeDate');
          Assert(Mo = Mo2, 'DecodeDate');
          Assert(Da = Da2, 'DecodeDate');
          Assert(Ho = Ho2, 'DecodeDate');
          Assert(Mi = Mi2, 'DecodeDate');
          Assert(Se = Se2, 'DecodeDate');
          Assert(Ms = Ms2, 'DecodeDate');
          Assert(Year(A) = Ye, 'Year');
          Assert(Month(A) = Mo, 'Month');
          Assert(Day(A) = Da, 'Day');
          Assert(Hour(A) = Ho, 'Hour');
          Assert(Minute(A) = Mi, 'Minute');
          Assert(Second(A) = Se, 'Second');
          Assert(Millisecond(A) = Ms, 'Millisecond');
        end;
  A := EncodeDateTime(2002, 05, 31, 07, 04, 01, 02);
  Assert(IsEqual(A, 2002, 05, 31), 'IsEqual');
  Assert(IsEqual(A, 07, 04, 01, 02), 'IsEqual');
  Assert(IsFriday(A), 'IsFriday');
  Assert(not IsMonday(A), 'IsMonday');
  A := AddWeeks(A, 2);
  Assert(IsEqual(A, 2002, 06, 14), 'AddWeeks');
  A := AddHours(A, 2);
  Assert(IsEqual(A, 09, 04, 01, 02), 'AddHours');
  A := EncodeDateTime(2004, 03, 01, 0, 0, 0, 0);
  Assert(DayOfYear(A) = 61, 'DayOfYear');
  Assert(DaysInMonth(2004, 02) = 29, 'DaysInMonth');
  Assert(DaysInMonth(2005, 02) = 28, 'DaysInMonth');
  Assert(DaysInMonth(2001, 01) = 31, 'DaysInMonth');
  Assert(DaysInYear(2000) = 366, 'DaysInYear');
  Assert(DaysInYear(2004) = 366, 'DaysInYear');
  Assert(DaysInYear(2006) = 365, 'DaysInYear');
  A := EncodeDateTime(2001, 09, 02, 12, 11, 10, 0);
  Assert(Month(A) = 9, 'EncodeDateTime');
  S := GMTTimeToRFC1123TimeB(A, True);
  Assert(S = '12:11:10 GMT');
  S := GMTDateTimeToRFC1123DateTimeB(A, True);
  Assert(S = 'Sun, 02 Sep 2001 12:11:10 GMT', 'GMTDateTimeToRFC1123DateTime');
  for Ye := 1999 to 2004 do
    for Mo := 1 to 2 do
      for Da := 1 to 2 do
        for Ho := 0 to 23 do
          begin
            A := EncodeDateTime(Ye, Mo, Da, Ho, 11, 10, 0);
            S := GMTDateTimeToRFC1123DateTimeB(A, True);
            B := RFCDateTimeToGMTDateTimeA(S);
            Assert(IsEqual(A, B), 'RFCDateTimeToGMTDateTime');
          end;

  Assert(RFCMonthNamesA[1] = 'Jan', 'RFCMonthNames');
  Assert(RFCMonthNamesA[12] = 'Dec', 'RFCMonthNames');
  Assert(RFC850DayNamesA[1] = 'Sunday', 'RFC850DayNames');
  Assert(RFCMonthB('Jan') = 1, 'RFCMonth');
  Assert(RFCMonthB('Nov') = 11, 'RFCMonth');
  Assert(EnglishLongMonthNamesA[12] = 'December', 'EnglishLongMonthNames');
  Assert(RFCTimeZoneToGMTBiasB('GMT') = 0, 'RFCTimeZoneToGMTBias');
  Assert(RFCTimeZoneToGMTBiasB('est') = -300, 'RFCTimeZoneToGMTBias');

  I := GMTBias;
  Assert((I <= 12 * 60) and (I >= -12 * 60), 'GMTBias');
  A := EncodeDateTime(2002, 05, 31, 07, 04, 01, 02);
  B := UnixTimeToDateTime(DateTimeToUnixTime(A));
  Assert(DiffSeconds(A, B) = 0, 'DateTimeToUnixTime');

  for I := 0 to 59 do
    begin
      Assert(DiffMinutes(EncodeDateTime(2006, 1, 1, 6, I, 0, 0), EncodeDateTime(2006, 1, 1, 7, 30, 0, 0)) = 90 - I, 'DiffMinutes');
      Assert(DiffMinutes(EncodeDateTime(2006, 1, 1, 7, 30, 0, 0), EncodeDateTime(2006, 1, 1, 6, I, 0, 0)) = -(90 - I), 'DiffMinutes');
      Assert(DiffSeconds(EncodeDateTime(2006, 1, 1, 6, I, 0, 0), EncodeDateTime(2006, 1, 1, 7, 30, 0, 0)) = (90 - I) * 60, 'DiffSeconds');
      Assert(DiffMilliseconds(EncodeDateTime(2006, 1, 1, 6, I, 0, 0), EncodeDateTime(2006, 1, 1, 7, 30, 0, I)) = (90 - I) * 60 * 1000 + I, 'DiffMilliseconds');
      Assert(DiffMilliseconds(EncodeDateTime(2006, 1, 1, 7, 30, 0, 0), EncodeDateTime(2006, 1, 1, 6, I, 0, 0)) = -((90 - I) * 60 * 1000), 'DiffMilliseconds');
      Assert(DiffMinutes(EncodeDateTime(2001, 1, 1, 0, 0, 0, 0), EncodeDateTime(2004, 1, 1, 0, I, 0, 0)) = 3 * 365 * 24 * 60 + I, 'DiffMinutes');
      Assert(DiffSeconds(EncodeDateTime(2001, 1, 1, 0, 0, 0, 0), EncodeDateTime(2004, 1, 1, 0, 0, I, 0)) = 3 * 365 * 24 * 60 * 60 + I, 'DiffSeconds');
    end;
  for I := 0 to 999 do
    Assert(DiffMilliseconds(EncodeDateTime(2001, 1, 1, 0, 0, 0, 0), EncodeDateTime(2001, 1, 22, 0, 0, 0, I)) = 21 * 24 * 60 * 60 * 1000 + I, 'DiffMilliseconds');
  Assert(DiffDays(EncodeDateTime(2006, 1, 1, 0, 0, 0, 0), EncodeDateTime(2006, 1, 1, 23, 59, 59, 999)) = 0, 'DiffDays');
  Assert(DiffDays(EncodeDateTime(2006, 1, 1, 0, 0, 0, 0), EncodeDateTime(2006, 1, 2, 0, 00, 0, 0)) = 1, 'DiffDays');
  Assert(DiffDays(EncodeDateTime(2006, 1, 2, 0, 0, 0, 0), EncodeDateTime(2006, 1, 1, 0, 00, 0, 0)) = -1, 'DiffDays');
  Assert(NextWorkDay(EncodeDate(2006, 1, 11)) = EncodeDate(2006, 1, 12), 'NextWorkDay');
  Assert(NextWorkDay(EncodeDate(2006, 1, 12)) = EncodeDate(2006, 1, 13), 'NextWorkDay');
  Assert(NextWorkDay(EncodeDate(2006, 1, 13)) = EncodeDate(2006, 1, 16), 'NextWorkDay');
  Assert(NextWorkDay(EncodeDate(2006, 1, 16)) = EncodeDate(2006, 1, 17), 'NextWorkDay');
end;
{$ENDIF}



end.