esbdates.pas

好用的日期转换函数 Date/Time Routines to enhance your 32-bit Delphi Programming.

unit ESBDates;

{: ESB Date/Time Routines Collection v3.0.1 for Borland Delphi.

	Date/Time Routines to enhance your 32-bit Delphi
	Programming. <p>

	Copyright (c) 1999-2001 ESB Consultancy <p>

	Recommend checking out (included): <p>

	http://www.tondering.dk/claus/calendar.html<p>

	FREQUENTLY ASKED QUESTIONS ABOUT CALENDARS<p>

	Some of our algorithms are based on info from the above. <p>

	ISO-8601 Document (not included) can be obtained as a PDF file from:<p>

	http://www.iso.ch/markete/8601.pdf <p>

	RFC822 Text File (not included) can be obtained from:<p>

	http://info.internet.isi.edu/in-notes/rfc/files/rfc822.txt <p>

	=================================================== <p>

	These routines are used by ESB Consultancy within the
	development of their Customised Application. <p>

	ESB Consultancy retains full copyright. <p>

	ESB Consultancy grants users of this code royalty free rights
	to do with this code as they wish. <p>

	ESB Consultancy makes no guarantees nor excepts any liabilities
	due to the use of these routines. <p>

	We do ask that if this code helps you in you development
	that you send as an email mailto:[e-mail] or even
	a local postcard. It would also be nice if you gave us a
	mention in your About Box, Help File or Documentation. <p>

	ESB Consultancy Home Page: http://www.esbconsult.com.au/<p>

	Mail Address: PO Box 2259, Boulder, WA 6449 AUSTRALIA <p>

	For Date and Time Edit Components check out our ESB Professional
	Computation Suite (ESBPCS) - trial versions available now.
	Check out the website at http://www.esbconsult.com.au/esbpcs2/<p>

	History: <p>
	v3.0.1 7-Sep-2001<p>
	- Add GpTimeZone v1.21<p>
	- Improved D2 support<p>
<p>
	v3.0.0 6-Sep-2001<p>
	- Testing is only done for Delphi 4 and above from here on in.<p>
	- Delphi 6 Support added.<p>
	- Heaps more constants added.<p>
	- Optimised Encoding and Decoding of Dates.<p>
	- ResourceStrings now used.<p>
	- Date formatted as an MS Access Style Comparison Added.<p>
	- Date formatted as an ANSI SQL Style Comparison Added.<p>
	- Heaps of Date and Time Conversion Routines added.<p>
	- Added an Enhanced Str2Date Conversion.<p>
	- Add GpTimeZone v1.2<p>
<p>
	v2.2.0 3-Feb-2001<p>
	- Fixed bug with IsAugustNow<p>
<p>
	v2.1.0 6-Oct-2000<p>
	- Add GpTimeZone v1.1b<p>
	- Add Calendar FAQ v2.3<p>
	- Added Calendar Weeks Apart<p>
	- Added Calendar Months Apart<p>
	- Added IsValidLongMonth & IsValidShortMonth Routines<p>
	- Added IsValidLongDOW & IsValidShortDOW Routines<p>
	- Added IsFirstDayOfMonth, IsLastDayofMonth Comparisons<p>
	- Added IsFirstDayOfYear, IsLastDayofYear Comparisons<p>
	- Added ISODateTime2DateTime as suggested by Wolfgang Werner.<p>
	- Fixed TimeApartInSecs - thanks to Mark Lussier.<p>
<p>
	v2.0.0 17-Feb-2000<p>
	- Add GpTimeZone v1.1<p>
	- Added TFileTime / TDateTime Conversions donated by J Peter Mugaas<p>
	- Added DateTimeToLargeInteger donated by Damien Racca<p>
	- Added DT Constants<p>
	- Added TimeApartInXXX routines<p>
	- Added SameDate, SameTime, SameDateTime<p>
	- DOW2Int & Month2Int relpaced by DayName2DOW & MonthName2Month<p>
	- Date to Short Month, Long Month, Short DOW, Long DOW Routines added<p>
	- Added GMTNow, GMTDate, GMTTime to return the current Date/Time info at
		GMT/UTC.<p>
	- Redesigned Help<p>

	v1.8.2 5-Nov-99<p>
	- Calender21.txt included<p>
	- URL's updated<p>

	v1.8.1 24-Oct-99<p>
	- Add GpTimeZone v1.0.1<p>
	- GpTimeZone Demo Project now works with Delphi 3<p>

	v1.8 18-Oct-99<p>
	- Removed Daylight Savings Routines due to bugs and included new unit
		GpTimeZone from Primoz Gabrijelcic. Many thanks also to Chris Means
		for his identification of problems with our routine.<p>

	v1.7 6-September-99<p>
	- D5 Compatibility added<p>
	- Updated Str2Time<p>
	- Redesigned Str2Date - previous version didn't work with all DateFormats<p>
	- Added Elapsing Time donated by Laurent PIERRE<p>

	v1.6 1-August-99<p>
	- Now over 175 Routines<p>
	- Str2Date now allows year to be omitted - assumes current year<p>
	- Str2Date now allows you to decide how 2 Digit Years are to be processed<p>
	- Str2HistoricDate assumes 2 Digit Years are this year or earlier<p>
	- Str2CutoffDate uses a Cutoff Date to control how 2 Digit Years are processed<p>
	- Date2Str more tolerant of returning an empty string
	- Fixed Problem with AddMonths with Negative Months
	- Fixed bug in GetFirstSundayOfYear
	- Age in Months & Weeks Routines donated by David Gobbett - aimed at Hospital Application
	- Added Various ISO-8601 Compliant Week and Formatting routines - thanks to Niklas Astrom
	- Links to ISO-8601 and RFC-822 added

	v1.5 12-July-99<p>
	- Now over 150 Routines<p>
	- Added Subtraction routines for completeness - suggested by Wolfgang Wendefeuer<p>
	- AgeAtDate and AgeNow Routines added<p>
	- Fixed a number of mistakes in the comments<p>
	- Conversion of English Day of Week Description to Integer<p>
	- Conversion of English Month Description to Integer<p>
	- WeeksApart (Integer) and ExactWeeksApart (Float) added<p>
	- Added GetFirstSundayOfYear<p>
	- Added Week Number processing<p>

	v1.4.1 18-June-99<p>
	- Fixed Bug in ConvertRFC822Times<p>

	v1.4 21-May-99<p>
	- Now have over 125 Routines!<p>
	- Added AddDays (though this is simple Addition) for completion<p>
	- Added Heaps of new Date/Time Arithmetic Routines.
	Many suggested by John Atchison<p>
	- Added Heaps of Boolean Routines like IsJanuary, IsMonday, etc.
	Many suggested by John Atchison<p>
	- Added Seconds (Floating) to a string of days, hours, minutes, seconds.
	Routine donated by: Marcos Guzm醤 Monta馿z<p>

	v1.3 27-Apr-99<p>
	- Added TimeZone constants missing from D3 (but in D4 Windows.pas)<p>
	- Added StartofWeek which returns the Start of the week a date is in, i.e. the Sunday<p>
	- Added Routine to set Local Time Bias - see warnings below<p>
	- Added Routine to return Daylight Savings Info<p>
	- Added Routine to return set Daylight Savings Info - see warnings below<p>
	- Added Routines to return current Details - ThisYear, ThisMonth, ThisDay,
		ThisHr, ThisMin, ThisSec, ThisMSec<p>

	v1.2 19-Apr-1999<p>
	- Added RFC822 Time Zone Routines <p>
	- Fixed problem with Str2Ext <p>

	v 1.1 6-Apr-1999<p>
	- Added Better IsLeapYear<p>
	- Added GetFirstDayOfMonth & GetLastDayOfMonth<p>
	- Added Constants for Tropical Year and Synodic Month<p>
	- Added Calculation of GoldenNumber and Epact for given year<p>
	- Added GetGoodFriday and GetEasterSunday for given year<p>
	- Added GMTStr2Value<p>
	- Added GetLocalTZBias - which allows for Daylight Savings settings<p>
	- Added GetLocalTime - turns GMT into Local via Regional Settings<p>
	- All Local Time Zone routines handle Standard/Daylight Biases<p>
	- Added ConvertGMTStrTimes to convert between two GMT related Date/Times<p>

	v 1.0 6-Mar-1999 Intial Release <p>

	People who have helped out with ESBDates via good suggestions and/or
	code snippets:<P>

	Scott Kane<p>
	Peter Ogden<p>
	Dr John Stockton<p>
	John Atchison<p>
	Marcos Guzm醤 Monta馿z<p>
	Wolfgang Wendefeuer<p>
	Gary Mugford<p>
	David Gobbett<p>
	Niklas Astrom<p>
	Laurent PIERRE<p>
	Chris Means<p>
	Primoz Gabrijelcic<p>
	J. Peter Mugaas<p>
	Damien Racca<p>
	Wolfgang Werner<p>
	Mark Lussier<p>
	Ken Otto<p>
	Joel Joly
}
interface

{.$Define UseESBRoutines} // Uncomment if you have ESB Routines

{$IFDEF VER120}
{$DEFINE D4Plus}
{$ENDIF}
{$IFDEF VER125}
{$DEFINE D4Plus}
{$ENDIF}
{$IFDEF VER130}
{$DEFINE D4Plus}
{$ENDIF}
{$IFDEF VER140}
{$DEFINE D4Plus}
{$ENDIF}

uses
	Windows;

{$IFNDEF D4PLUS}
const
	TIME_ZONE_ID_STANDARD = 1;
	TIME_ZONE_ID_DAYLIGHT = 2;
{$ENDIF}

{$IFDEF VER90}
type
	LongInt = Integer;
{$ENDIF VER90}

// Date/Time Related Messages
ResourceString
	rsInvalidDate = 'Invalid Date';
	rsInvalidTime = 'Invalid Time';
	rsInvalidDateTime = 'Invalid Date/Time';

const
	//: Fraction of a TDateTime that represents One Hour.
	OneDTHour = 1 / 24;

	//: Fraction of a TDateTime that represents One Minute.
	OneDTMinute = 1 / (24 * 60);

	//: Fraction of a TDateTime that represents One Second.
	OneDTSecond = 1 / (24 * 60 * 60);

	//: Fraction of a TDateTime that represents One Millisecond.
	OneDTMillisecond = 1 / (24 * 60 * 60 * 1000);

const
	//: Seconds Per Minute
	SecsPerMin = 60;

	//: Minutes Per Second
	MinsPerSec = 1 / 60;

	//: Minutes Per Hour
	MinsPerHr = 60;

	//: Hours Per Minute
	HrsPerMin = 1 / 60;

	//: Seconds Per Hour
	SecsPerHr = 3600;

	//: Hours Per Per Second
	HrsPerSec = 1 / 3600;

	//: Hours Per Day
	HrsPerDay = 24;

	//: Days Per Hour
	DaysPerHr = 1 / 24;

	//: Minutes Per Day
	MinsPerDay = 24 * 60;

	//: Days Per Minute
	DaysPerMin = 1 / (24 * 60);

	//: Seconds Per Day
	SecsPerDay = 24 * 3600;

	//: Days Per Second
	DaysPerSec = 1 / (24 * 3600);

	//: Days Per Week
	DaysPerWeek = 7;

	//: Weeks Per Day
	WeeksPerDay = 1 / 7;

	//: Days Per Fortnight
	DaysPerFortnight = 14;

	//: Fortnights Per Day
	FortnightsPerDay = 1 / 14;

const
	{: Time it takes, in days, for the Earth to go from a point in
		its rotation and return to that point, i.e. a revolution.
		This amount changes (gets smaller) as time progresses.
		In 2100 it will be 365.242184 }
	DaysPerTropicalYear = 365.24219;

	// Days per Gregorian Year
	DaysPerGregorianYear = 365.2425;

	// Days per Julian Year
	DaysPerJulianYear = 365.25;

	{: Time it takes, in days, from one New Moon to the next.
		This amount change (gets larger) as time progresses.
		in 2100 it will be 29.5305891 }
	DaysPerSynodicMonth = 29.53059;

type
	{: Different ways in which 1 & 2 Digit Years are handled in Str2Date
		and in the Date Edit Components.

		@enum edyNone Nothing is done, left to Delphi to handle.
		@enum edyCutOff the <See Var=ESB2DigitCutOff> is used to decide
			which century the date lies in. If 1900 + Yr is less than
			ESB2DigitCutOff then it is assumed that 2000 + Yr is wanted,
			otherwise 1900 + Yr is used.
		@enum edyHistoric assumes that the yr is this year or earlier. }
	TESB2DigitYr = (edyNone, edyCutOff, edyHistoric);

var
	{: Different ways in which 1 & 2 Digit Years are handled in Str2Date
		and in the Date Edit Components.
		edyNone - Nothing is done, left to Delphi to handle. <p>
		edyCutOff - the <See Var=ESB2DigitCutOff> is used to decide
			which century the date lies in. If 1900 + Yr is less than
			ESB2DigitCutOff then it is assumed that 2000 + Yr is wanted,
			otherwise 1900 + Yr is used.<p>
		edyHistoric  - assumes that the yr is this year or earlier. }
	ESB2DigitYr: TESB2DigitYr = edyCutOff;
	{: If <See Var=ESB2DigitYr> = edyCutOff - then  ESB2DigitCutOff is used
		to decide	which century the date lies in. If 1900 + Yr less than
		ESB2DigitCutOff then it is assumed that 2000 + Yr is wanted,
		otherwise 1900 + Yr is used. }
	ESB2DigitCutOff: Word = 1920;

//: English Days of Week - used for DOW2Int
const
	DayOfWeekStrings: array [1..7] of String = ('SUNDAY', 'MONDAY', 'TUESDAY',
		'WEDNESDAY', 'THURSDAY', 'FRIDAY', 'SATURDAY');

//: English Calendar Months - used for Month2Int
const
	MonthStrings: array [1..12] of String = ('JANUARY', 'FEBRUARY', 'MARCH',
		'APRIL','MAY', 'JUNE', 'JULY', 'AUGUST', 'SEPTEMBER', 'OCTOBER',
		'NOVEMBER', 'DECEMBER');

{--- Current Date ---}
{: A Speed Optimised Routine to get the Current Date. Time Portion is Zero.
	@cat DTMath
}
function OptDate: TDateTime;

{--- Conversions ---}

{: A Speed Optimised DecodeDate developed by Ken Otto that is many times faster
	than the once included in SysUtils. If you need Words rather than Integers
	use the slightly slower OptDecodeDateW.
	@cat DTConv
}
procedure OptDecodeDateI (const DT: TDateTime; out Year, Month, Day: Integer);

{: A Speed Optimised DecodeDate developed by Ken Otto that is many times faster
	than the once included in SysUtils. If you want even faster results and
	are happy to use Integers than use the slightly slower OptDecodeDateI.
	@cat DTConv
}
procedure OptDecodeDateW (const DT: TDateTime; out Year, Month, Day: Word);

{: A Speed Optimised EncodeDate developed by Ken Otto that is many times faster
	than the once included in SysUtils, and includes Exception Handling. If you
	need Words rather than Integers use the slightly slower OptEncodeDateW.
	@cat DTConv
}
function OptEncodeDateI (Year, Month, Day: Integer): TDateTime;

{: A Speed Optimised EncodeDate developed by Ken Otto that is many times faster
	than the once included in SysUtils, and includes Exception Handling. If you
	want even faster results and are happy to use Integers than use the
	slightly slower OptEncodeDateI.
	@cat DTConv
}
function OptEncodeDateW (Year, Month, Day: Word): TDateTime;

{: A Speed Optimised Routine for getting the Year portion of a Date based on
	Routine by Ken Otto that is many times faster than using DecodeDate in
	SysUtils.
	@cat DTConv
}
function OptDate2Year (const DT: TDateTime) : Word;