jcldatetime.pas

East make Tray Icon in delphi

{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is JclDateTime.pas.                                                            }
{                                                                                                  }
{ The Initial Developer of the Original Code is Marcel van Brakel.                                 }
{ Portions created by Marcel van Brakel are Copyright Marcel van Brakel. All rights reserved.      }
{                                                                                                  }
{ Contributors:                                                                                    }
{   Anthony Steele                                                                                 }
{   Charlie Calvert                                                                                }
{   Heri Bender                                                                                    }
{   Marc Convents                                                                                  }
{   Marcel van Brakel                                                                              }
{   Matthias Thoma (mthoma)                                                                        }
{   Michael Schnell                                                                                }
{   Nick Hodges                                                                                    }
{   Petr Vones                                                                                     }
{   Robert Marquardt (marquardt)                                                                   }
{   Robert Rossmair (rrossmair)                                                                    }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Routines for working with dates and times. Mostly conversion between the                         }
{ different formats but also some date testing routines (is leap year? etc)                        }
{                                                                                                  }
{**************************************************************************************************}

// Last modified: $Date: 2005/03/09 23:09:01 $
// For history see end of file

// in Help:
//  We do all conversions (but thoses provided by Delphi anyway) between
//  TDateTime, TDosDateTime, TFileTime and TSystemTime plus
//  TDatetime, TDosDateTime, TFileTime, TSystemTime to string

unit JclDateTime;

{$I jcl.inc}
{$I crossplatform.inc}

interface

uses
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF MSWINDOWS}
  {$IFDEF HAS_UNIT_TYPES}
  Types,
  {$ENDIF HAS_UNIT_TYPES}
  {$IFDEF HAS_UNIT_LIBC}
  Libc,
  {$ENDIF HAS_UNIT_LIBC}
  SysUtils,
  JclBase, JclResources;

const
  // 1970-01-01T00:00:00 in TDateTime
  UnixTimeStart = 25569;

{ Encode / Decode functions }

function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime;
procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Word); overload;
procedure DecodeDate(Date: TDateTime; var Year: Integer; var Month, Day: Word); overload;
procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Integer); overload;

function CenturyOfDate(const DateTime: TDateTime): Integer;
function CenturyBaseYear(const DateTime: TDateTime): Integer;
function DayOfDate(const DateTime: TDateTime): Integer;
function MonthOfDate(const DateTime: TDateTime): Integer;
function YearOfDate(const DateTime: TDateTime): Integer;
function DayOfTheYear(const DateTime: TDateTime; var Year: Integer): Integer; overload;
function DayOfTheYear(const DateTime: TDateTime): Integer; overload;
function DayOfTheYearToDateTime(const Year, Day: Integer): TDateTime;
function HourOfTime(const DateTime: TDateTime): Integer;
function MinuteOfTime(const DateTime: TDateTime): Integer;
function SecondOfTime(const DateTime: TDateTime): Integer;

{ ISO 8601 support }

function GetISOYearNumberOfDays(const Year: Word): Word;  
function IsISOLongYear(const Year: Word): Boolean; overload;
function IsISOLongYear(const DateTime: TDateTime): Boolean; overload;
function ISODayOfWeek(const DateTime: TDateTime): Word;
function ISOWeekNumber(DateTime: TDateTime; var YearOfWeekNumber, WeekDay: Integer): Integer; overload;
function ISOWeekNumber(DateTime: TDateTime; var YearOfWeekNumber: Integer): Integer; overload;
function ISOWeekNumber(DateTime: TDateTime): Integer; overload;
function ISOWeekToDateTime(const Year, Week, Day: Integer): TDateTime;

{ Miscellanous }

function IsLeapYear(const Year: Integer): Boolean; overload;
function IsLeapYear(const DateTime: TDateTime): Boolean; overload;
function DaysInMonth(const DateTime: TDateTime): Integer;
function Make4DigitYear(Year, Pivot: Integer): Integer;
function MakeYear4Digit(Year, WindowsillYear: Integer): Integer;
function EasterSunday(const Year: Integer): TDateTime;
function FormatDateTime(Form: string; DateTime: TDateTime): string;
function FATDatesEqual(const FileTime1, FileTime2: Int64): Boolean; overload;
function FATDatesEqual(const FileTime1, FileTime2: TFileTime): Boolean; overload;

// Conversion
type
  TDosDateTime = Integer;

function HoursToMSecs(Hours: Integer): Integer;
function MinutesToMSecs(Minutes: Integer): Integer;
function SecondsToMSecs(Seconds: Integer): Integer;

function TimeOfDateTimeToSeconds(DateTime: TDateTime): Integer;
function TimeOfDateTimeToMSecs(DateTime: TDateTime): Integer;

function DateTimeToLocalDateTime(DateTime: TDateTime): TDateTime;
function LocalDateTimeToDateTime(DateTime: TDateTime): TDateTime;

{$IFDEF MSWINDOWS}
function DateTimeToDosDateTime(const DateTime: TDateTime): TDosDateTime;
function DateTimeToFileTime(DateTime: TDateTime): TFileTime;
function DateTimeToSystemTime(DateTime: TDateTime): TSystemTime; overload;
procedure DateTimeToSystemTime(DateTime: TDateTime; var SysTime : TSystemTime); overload;

function LocalDateTimeToFileTime(DateTime: TDateTime): FileTime;
{$ENDIF MSWINDOWS}

function DosDateTimeToDateTime(const DosTime: TDosDateTime): TDateTime;
{$IFDEF MSWINDOWS}
function DosDateTimeToFileTime(DosTime: TDosDateTime): TFileTime; overload;
procedure DosDateTimeToFileTime(DTH, DTL: Word; FT: TFileTime); overload;
function DosDateTimeToSystemTime(const DosTime: TDosDateTime): TSystemTime;
{$ENDIF MSWINDOWS}
function DosDateTimeToStr(DateTime: Integer): string;

function FileTimeToDateTime(const FileTime: TFileTime): TDateTime;
{$IFDEF MSWINDOWS}
function FileTimeToLocalDateTime(const FileTime: TFileTime): TDateTime;
function FileTimeToDosDateTime(const FileTime: TFileTime): TDosDateTime; overload;
procedure FileTimeToDosDateTime(const FileTime: TFileTime; var Date, Time: Word); overload;
function FileTimeToSystemTime(const FileTime: TFileTime): TSystemTime; overload;
procedure  FileTimeToSystemTime(const FileTime: TFileTime; var ST: TSystemTime); overload;
{$ENDIF MSWINDOWS}
function FileTimeToStr(const FileTime: TFileTime): string;

{$IFDEF MSWINDOWS}
function SystemTimeToDosDateTime(const SystemTime: TSystemTime): TDosDateTime;
function SystemTimeToFileTime(const SystemTime: TSystemTime): TFileTime; overload;
procedure SystemTimeToFileTime(const SystemTime: TSystemTime; FTime : TFileTime); overload;
function SystemTimeToStr(const SystemTime: TSystemTime): string;

// Filedates
function CreationDateTimeOfFile(const Sr: TSearchRec): TDateTime;
function LastAccessDateTimeOfFile(const Sr: TSearchRec): TDateTime;
function LastWriteDateTimeOfFile(const Sr: TSearchRec): TDateTime;
{$ENDIF MSWINDOWS}

type
  TJclUnixTime32 = Longword;

function DateTimeToUnixTime(DateTime : TDateTime) : TJclUnixTime32;
function UnixTimeToDateTime(const UnixTime: TJclUnixTime32): TDateTime;

{$IFDEF MSWINDOWS}
function FileTimeToUnixTime(const AValue: TFileTime): TJclUnixTime32;
function UnixTimeToFileTime(const AValue: TJclUnixTime32): TFileTime;
{$ENDIF MSWINDOWS}

type
  EJclDateTimeError = class(EJclError);

implementation

const
  DaysInMonths: array [1..12] of Integer =
    (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

  MinutesPerDay     = 60 * 24;
  SecondsPerMinute  = 60;
  SecondsPerHour    = 3600;
  SecondsPerDay     = MinutesPerDay * 60;
  MsecsPerMinute    = 60 * 1000;
  MsecsPerHour      = 60 * MsecsPerMinute;
  DaysPerYear       = 365.2422454;          // Solar Year
  DaysPerMonth      = DaysPerYear / 12;
  DateTimeBaseDay   = -693593;              //  1/1/0001
  EncodeDateMaxYear = 9999;
  SolarDifference   = 1.7882454;            //  Difference of Julian Calendar to Solar Calendar at 1/1/10000
  DateTimeMaxDay    = 2958466;              //  12/31/EncodeDateMaxYear + 1;
  FileTimeBase      = -109205.0;
  FileTimeStep: Extended = 24.0 * 60.0 * 60.0 * 1000.0 * 1000.0 * 10.0; // 100 nSek per Day

  // Weekday to start the week
  //   1 : Sonday
  //   2 : Monday (according to ISO 8601)
  ISOFirstWeekDay = 2;

  // minmimum number of days of the year in the first week of the year week
  //   1 : week one starts at 1/1
  //   4 : first week has at least four days (according to ISO 8601)
  //   7 : first full week
  ISOFirstWeekMinDays = 4;

function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime; overload;
begin
  if (Year > 0) and (Year < EncodeDateMaxYear + 1) then
    Result := SysUtils.EncodeDate(Year, Month, Day)
  else
  begin
    if Year <= 0 then
      Result := Year * DaysPerYear + DateTimeBaseDay
    else      // Year >= 10000
              // for some reason year 0 does not exist so we switch from
              // the last day of year -1 (-693594) to the first days of year 1
      Result := (Year-1) * DaysPerYear + DateTimeBaseDay + // BaseDate is 1/1/1
        SolarDifference;  // guarantee a smooth transition at 1/1/10000
    Result := Trunc(Result);
    Result := Result + (Month - 1) * DaysPerMonth;
    Result := Round(Result) + (Day - 1);
  end;
end;

procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Word);
begin
  SysUtils.DecodeDate(Date, Year, Month, Day);
end;

procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Integer);
var
  WMonth, WDay: Word;
begin
  DecodeDate(Date, Year, WMonth, WDay);
  Month := WMonth;
  Day := WDay;
end;

procedure DecodeDate(Date: TDateTime; var Year: Integer; var Month, Day: Word); 
var
  WYear: Word;
  RDays, RMonths: TDateTime;
begin
  if (Date >= DateTimeBaseDay) and (Date < DateTimeMaxDay) then
  begin
    SysUtils.DecodeDate(Date, WYear, Month, Day);
    Year := WYear;
  end
  else
  begin
    Year := Trunc((Date - DateTimeBaseDay) / DaysPerYear);
    if Year <= 0 then
      Year := Year - 1
              // for some historical reason year 0 does not exist so we switch from
              // the last day of year -1 (-693594) to the first days of year 1
    else                                    // Year >= 10000
      Date := Date - SolarDifference;       // guarantee a smooth transition at 1/1/10000
    RDays := Date - DateTimeBaseDay;        // Days relative to 1/1/0001
    RMonths := RDays / DaysPerMonth;        // "Months" relative to 1/1/0001
    RMonths := RMonths - Year * 12.0;       // 12 "Months" per Year
    if RMonths < 0 then                     // possible truncation glitches
    begin
      RMonths := 11;
      Year := Year - 1;
    end;
    Month := Trunc(RMonths);
    RMonths := Month;
    Month := Month + 1;
    RDays := RDays - Year * DaysPerYear;    // subtract Base Day ot the year
    RDays := RDays - RMonths * DaysPerMonth;// subtract Base Day of the month
    Day := Trunc(RDays)+ 1;
    if Year > 0 then                        // Year >= 10000
      Year := Year + 1;                     // BaseDate is 1/1/1
  end;
end;

procedure ResultCheck(Val: LongBool);
begin
  if not Val then
    raise EJclDateTimeError.CreateRes(@RsDateConversion);
end;

function CenturyBaseYear(const DateTime: TDateTime): Integer;
var
  Y: Integer;
begin
  Y := YearOfDate(DateTime);
  Result := (Y div 100) * 100;
  if Y <= 0 then
    Result := Result - 100;
end;

function CenturyOfDate(const DateTime: TDateTime): Integer;
var
  Y: Integer;
begin
  Y := YearOfDate(DateTime);
  if Y > 0 then
    Result := (Y div 100) + 1
  else
    Result := (Y div 100) - 1;
end;

function DayOfDate(const DateTime: TDateTime): Integer;
var
  Y: Integer;
  M, D: Word;
begin
  DecodeDate(DateTime, Y, M, D);
  Result := D;
end;

function MonthOfDate(const DateTime: TDateTime): Integer;
var
  Y: Integer;
  M, D: Word;
begin
  DecodeDate(DateTime, Y, M, D);
  Result := M;
end;

function YearOfDate(const DateTime: TDateTime): Integer;
var
  M, D: Word;
begin
  DecodeDate(DateTime, Result, M, D);
end;

function DayOfTheYear(const DateTime: TDateTime; var Year: Integer): Integer;
var
  Month, Day: Word;
  DT: TDateTime;
begin
  DecodeDate(DateTime, Year, Month, Day);
  DT := EncodeDate(Year, 1, 1);
  Result := Trunc(DateTime);
  Result := Result - Trunc(DT) + 1;
end;

function DayOfTheYear(const DateTime: TDateTime): Integer;
var
  Year: Integer;
begin
  Result := DayOfTheYear(DateTime, Year);
end;

function DayOfTheYearToDateTime(const Year, Day: Integer): TDateTime;
begin
  Result := EncodeDate(Year, 1, 1) + Day - 1;
end;

function HourOfTime(const DateTime: TDateTime): Integer;
var
  H, M, S, MS: Word;
begin
  DecodeTime(DateTime, H, M, S, MS);
  Result := H;
end;

function MinuteOfTime(const DateTime: TDateTime): Integer;
var
  H, M, S, MS: Word;
begin
  DecodeTime(DateTime, H, M, S, MS);
  Result := M;
end;

function SecondOfTime(const DateTime: TDateTime): Integer;
var
  H, M, S, MS: Word;
begin
  DecodeTime(DateTime, H, M, S, MS);
  Result := S;
end;

function TimeOfDateTimeToSeconds(DateTime: TDateTime): Integer;
begin
  Result := Round(Frac(DateTime) * SecondsPerDay);
end;

function TimeOfDateTimeToMSecs(DateTime: TDateTime): Integer;
begin
  Result := Round(Frac(DateTime) * MSecsPerDay);
end;

function DaysInMonth(const DateTime: TDateTime): Integer;
var
  M: Integer;
begin
  M := MonthOfDate(DateTime);
  Result := DaysInMonths[M];
  if (M = 2) and IsLeapYear(DateTime) then
    Result := 29;
end;

// SysUtils.DayOfWeek returns the day of the week of the given date. The result is an integer between
// 1 and 7, corresponding to Sunday through Saturday. ISODayOfWeek on the other hand returns an integer
// between 1 and 7 where the first day is a Monday. The forumla for calculation ISODayOfTheWeek is
// simply
//                    DayOfWeek(D) - 1  if DayOfWeek(D) > 1
// ISODayOfWeek (D) = 7                 if DayOfWeek(D) = 1

function ISODayOfWeek(const DateTime: TDateTime): Word;
var
  TmpDayOfWeek: Word;
begin
  TmpDayOfWeek := SysUtils.DayOfWeek(DateTime);
  if TmpDayOfWeek = 1 then
    Result := 7
  else
    Result := TmpDayOfWeek - 1;
end;

// Determines if the ISO Year is ordinary  (52 weeks) or Long (53 weeks). Uses a rule first
// suggested by Sven Pran (Norway) and Lars Nordentoft (Denmark) - according to