哪位大侠安装了delphi6,请将dateutils.pas(安装目录里)发给我([e-mail])

[iloveyan]

[王集鹄]

{ *********************************************************************** }
{ }
{ Delphi Runtime Library }
{ }
{ Copyright (c) 1995-2001 Borland Software Corporation }
{ }
{ *********************************************************************** }

unit StrUtils;

interface

uses
SysUtils;

{ AnsiResemblesText returns true if the two strings are similar (using a
Soundex algorithm or something similar) }

function AnsiResemblesText(const AText, AOther: string): Boolean;

{ AnsiContainsText returns true if the subtext is found, without
case-sensitivity, in the given text }

function AnsiContainsText(const AText, ASubText: string): Boolean;

{ AnsiStartsText & AnsiEndText return true if the leading or trailing part
of the given text matches, without case-sensitivity, the subtext }

function AnsiStartsText(const ASubText, AText: string): Boolean;
function AnsiEndsText(const ASubText, AText: string): Boolean;

{ AnsiReplaceText will replace all occurrences of a substring, without
case-sensitivity, with another substring (recursion substring replacement
is not supported) }

function AnsiReplaceText(const AText, AFromText, AToText: string): string;

{ AnsiMatchText & AnsiIndexText provide case like function for dealing with
strings }

function AnsiMatchText(const AText: string;
const AValues: array of string): Boolean;
function AnsiIndexText(const AText: string;
const AValues: array of string): Integer;

{ These function are similar to some of the above but are case-sensitive }

function AnsiContainsStr(const AText, ASubText: string): Boolean;
function AnsiStartsStr(const ASubText, AText: string): Boolean;
function AnsiEndsStr(const ASubText, AText: string): Boolean;
function AnsiReplaceStr(const AText, AFromText, AToText: string): string;
function AnsiMatchStr(const AText: string;
const AValues: array of string): Boolean;
function AnsiIndexStr(const AText: string;
const AValues: array of string): Integer;

{ DupeString will return N copies of the given string }

function DupeString(const AText: string; ACount: Integer): string;

{ ReverseString simply reverses the given string }

function ReverseString(const AText: string): string;

{ StuffString replaces a segment of a string with another one }

function StuffString(const AText: string; AStart, ALength: Cardinal;
const ASubText: string): string;

{ RandomFrom will randomly return one of the given strings }

function RandomFrom(const AValues: array of string): string; overload;

{ IfThen will return the true string if the value passed in is true, else
it will return the false string }

function IfThen(AValue: Boolean; const ATrue: string;
AFalse: string = ''): string; overload;

{ Basic-like functions }

function LeftStr(const AText: string; const ACount: Integer): string;
function RightStr(const AText: string; const ACount: Integer): string;
function MidStr(const AText: string; const AStart, ACount: Integer): string;

const
{ Default word delimiters are any character except the core alphanumerics. }
WordDelimiters: set of Char = [#0..#255] - ['a'..'z','A'..'Z','1'..'9','0'];

type
TStringSeachOption = (soDown, soMatchCase, soWholeWord);
TStringSearchOptions = set of TStringSeachOption;

{ SearchBuf is a search routine for arbitrary text buffers. If a match is
found, the function returns a pointer to the start of the matching
string in the buffer. If no match, the function returns nil. Specify
soDown to search forward otherwise the search is performs
backwards through the text. Use SelStart and SelLength skip "selected"
text thus the search will start before or after (soDown) the specified text. }

function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer;
SearchString: String; Options: TStringSearchOptions = [soDown]): PChar;

{ Soundex function returns the Soundex code for the given string. Unlike
the original Soundex routine this function can return codes of varying
lengths. This function is loosely based on SoundBts which was written
by John Midwinter. For more information about Soundex see:

http://www.nara.gov/genealogy/coding.html

The general theory behind this function was originally patented way back in
1918 (US1261167 & US1435663) but are now in the public domain.

NOTE: This function does not attempt to deal with 'names with prefixes'
issue.
}

type
TSoundexLength = 1..MaxInt;

function Soundex(const AText: string; ALength: TSoundexLength = 4): string;

{ SoundexInt uses Soundex but returns the resulting Soundex code encoded
into an integer. However, due to limits on the size of an integer, this
function is limited to Soundex codes of eight characters or less.

DecodeSoundexInt is designed to decode the results of SoundexInt back to
a normal Soundex code. Length is not required since it was encoded into
the results of SoundexInt. }

type
TSoundexIntLength = 1..8;

function SoundexInt(const AText: string; ALength: TSoundexIntLength = 4): Integer;
function DecodeSoundexInt(AValue: Integer): string;

{ SoundexWord is a special case version of SoundexInt that returns the
Soundex code encoded into a word. However, due to limits on the size of a
word, this function uses a four character Soundex code.

DecodeSoundexWord is designed to decode the results of SoundexWord back to
a normal Soundex code. }

function SoundexWord(const AText: string): Word;
function DecodeSoundexWord(AValue: Word): string;

{ SoundexSimilar and SoundexCompare are simple comparison functions that use
the Soundex encoding function. }

function SoundexSimilar(const AText, AOther: string;
ALength: TSoundexLength = 4): Boolean;
function SoundexCompare(const AText, AOther: string;
ALength: TSoundexLength = 4): Integer;

{ Default entry point for AnsiResemblesText }

function SoundexProc(const AText, AOther: string): Boolean;

type
TCompareTextProc = function(const AText, AOther: string): Boolean;

{ If the default behavior of AnsiResemblesText (using Soundex) is not suitable
for your situation, you can redirect it to a function of your own choosing }

var
AnsiResemblesProc: TCompareTextProc = SoundexProc;

implementation

uses
Windows;

function AnsiResemblesText(const AText, AOther: string): Boolean;
begin
Result := False;
if Assigned(AnsiResemblesProc) then
Result := AnsiResemblesProc(AText, AOther);
end;

function AnsiContainsText(const AText, ASubText: string): Boolean;
begin
Result := AnsiPos(AnsiUppercase(ASubText), AnsiUppercase(AText)) > 0;
end;

function AnsiStartsText(const ASubText, AText: string): Boolean;
var
P: PChar;
L, L2: Integer;
begin
P := PChar(AText);
L := Length(ASubText);
L2 := Length(AText);
if L > L2 then
Result := False
else
Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE,
P, L, PChar(ASubText), L) = 2;
end;

function AnsiEndsText(const ASubText, AText: string): Boolean;
var
P: PChar;
L, L2: Integer;
begin
P := PChar(AText);
L := Length(ASubText);
L2 := Length(AText);
Inc(P, L2 - L);
if L > L2 then
Result := False
else
Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE,
P, L, PChar(ASubText), L) = 2;
end;

function AnsiReplaceStr(const AText, AFromText, AToText: string): string;
begin
Result := StringReplace(AText, AFromText, AToText, [rfReplaceAll]);
end;

function AnsiReplaceText(const AText, AFromText, AToText: string): string;
begin
Result := StringReplace(AText, AFromText, AToText, [rfReplaceAll, rfIgnoreCase]);
end;

function AnsiMatchText(const AText: string;
const AValues: array of string): Boolean;
begin
Result := AnsiIndexText(AText, AValues) <> -1;
end;

function AnsiIndexText(const AText: string;
const AValues: array of string): Integer;
var
I: Integer;
begin
Result := -1;
for I := Low(AValues) to High(AValues) do
if AnsiSameText(AText, AValues[I]) then
begin
Result := I;
Break;
end;
end;

function AnsiContainsStr(const AText, ASubText: string): Boolean;
begin
Result := AnsiPos(ASubText, AText) > 0;
end;

function AnsiStartsStr(const ASubText, AText: string): Boolean;
begin
Result := AnsiSameStr(ASubText, Copy(AText, 1, Length(ASubText)));
end;

function AnsiEndsStr(const ASubText, AText: string): Boolean;
begin
Result := AnsiSameStr(ASubText,
Copy(AText, Length(AText) - Length(ASubText) + 1,
Length(ASubText)));
end;

function AnsiMatchStr(const AText: string;
const AValues: array of string): Boolean;
begin
Result := AnsiIndexStr(AText, AValues) <> -1;
end;

function AnsiIndexStr(const AText: string;
const AValues: array of string): Integer;
var
I: Integer;
begin
Result := -1;
for I := Low(AValues) to High(AValues) do
if AnsiSameStr(AText, AValues[I]) then
begin
Result := I;
Break;
end;
end;

function DupeString(const AText: string; ACount: Integer): string;
var
P: PChar;
C: Integer;
begin
C := Length(AText);
SetLength(Result, C * ACount);
P := Pointer(Result);
if P = nil then Exit;
while ACount > 0 do
begin
Move(Pointer(AText)^, P^, C);
Inc(P, C);
Dec(ACount);
end;
end;

function ReverseString(const AText: string): string;
var
I: Integer;
P: PChar;
begin
SetLength(Result, Length(AText));
P := PChar(Result);
for I := Length(AText) downto 1 do
begin
P^ := AText[I];
Inc(P);
end;
end;

function StuffString(const AText: string; AStart, ALength: Cardinal;
const ASubText: string): string;
begin
Result := Copy(AText, 1, AStart - 1) +
ASubText +
Copy(AText, AStart + ALength, MaxInt);
end;

function RandomFrom(const AValues: array of string): string;
begin
Result := AValues[Random(High(AValues) + 1)];
end;

function IfThen(AValue: Boolean; const ATrue: string;
AFalse: string = ''): string;
begin
if AValue then
Result := ATrue
else
Result := AFalse;
end;

function LeftStr(const AText: string; const ACount: Integer): string;
begin
Result := Copy(AText, 1, ACount);
end;

function RightStr(const AText: string; const ACount: Integer): string;
begin
Result := Copy(AText, Length(AText) + 1 - ACount, ACount);
end;

function MidStr(const AText: string; const AStart, ACount: Integer): string;
begin
Result := Copy(AText, AStart, ACount);
end;

function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer;
SearchString: String; Options: TStringSearchOptions): PChar;
var
SearchCount, I: Integer;
C: Char;
Direction: Shortint;
CharMap: array [Char] of Char;

function FindNextWordStart(var BufPtr: PChar): Boolean;
begin { (True XOR N) is equivalent to (not N) }
{ (False XOR N) is equivalent to (N) }
{ When Direction is forward (1), skip non delimiters, then skip delimiters. }
{ When Direction is backward (-1), skip delims, then skip non delims }
while (SearchCount > 0) and
((Direction = 1) xor (BufPtr^ in WordDelimiters)) do
begin
Inc(BufPtr, Direction);
Dec(SearchCount);
end;
while (SearchCount > 0) and
((Direction = -1) xor (BufPtr^ in WordDelimiters)) do
begin
Inc(BufPtr, Direction);
Dec(SearchCount);
end;
Result := SearchCount > 0;
if Direction = -1 then
begin { back up one char, to leave ptr on first non delim }
Dec(BufPtr, Direction);
Inc(SearchCount);
end;
end;

begin
Result := nil;
if BufLen <= 0 then Exit;
if soDown in Options then
begin
Direction := 1;
Inc(SelStart, SelLength); { start search past end of selection }
SearchCount := BufLen - SelStart - Length(SearchString) + 1;
if SearchCount < 0 then Exit;
if Longint(SelStart) + SearchCount > BufLen then Exit;
end
else
begin
Direction := -1;
Dec(SelStart, Length(SearchString));
SearchCount := SelStart + 1;
end;
if (SelStart < 0) or (SelStart > BufLen) then Exit;
Result := @Buf[SelStart];

{ Using a Char map array is faster than calling AnsiUpper on every character }
for C := Low(CharMap) to High(CharMap) do
CharMap[C] := C;

if not (soMatchCase in Options) then
begin
AnsiUpperBuff(PChar(@CharMap), sizeof(CharMap));
AnsiUpperBuff(@SearchString[1], Length(SearchString));
end;

while SearchCount > 0 do
begin
if soWholeWord in Options then
if not FindNextWordStart(Result) then Break;
I := 0;
while (CharMap[Result[I]] = SearchString[I+1]) do
begin
Inc(I);
if I >= Length(SearchString) then
begin
if (not (soWholeWord in Options)) or
(SearchCount = 0) or
(Result[I] in WordDelimiters) then
Exit;
Break;
end;
end;
Inc(Result, Direction);
Dec(SearchCount);
end;
Result := nil;
end;

{ This function is loosely based on SoundBts which was written by John Midwinter }
function Soundex(const AText: string; ALength: TSoundexLength): string;
const

// This table gives the Soundex score for all characters upper- and lower-
// case hence no need to convert. This is faster than doing an UpCase on the
// whole input string. The 5 non characters in middle are just given 0.
CSoundexTable: array[65..122] of ShortInt =
// A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
(0, 1, 2, 3, 0, 1, 2, -1, 0, 2, 2, 4, 5, 5, 0, 1, 2, 6, 2, 3, 0, 1, -1, 2, 0, 2,
// [ / ] ^ _ '
0, 0, 0, 0, 0, 0,
// a b c d e f g h i j k l m n o p q r s t u v w x y z
0, 1, 2, 3, 0, 1, 2, -1, 0, 2, 2, 4, 5, 5, 0, 1, 2, 6, 2, 3, 0, 1, -1, 2, 0, 2);

function Score(AChar: Integer): Integer;
begin
Result := 0;
if (AChar >= Low(CSoundexTable)) and (AChar <= High(CSoundexTable)) then
Result := CSoundexTable[AChar];
end;

var
I, LScore, LPrevScore: Integer;
begin
Result := '';
if AText <> '' then
begin
Result := Upcase(AText[1]);
LPrevScore := Score(Ord(AText[1]));
for I := 2 to Length(AText) do
begin
LScore := Score(Ord(AText[I]));
if (LScore > 0) and (LScore <> LPrevScore) then
begin
Result := Result + IntToStr(LScore);
if Length(Result) = ALength then
Break;
end;
if LScore <> -1 then
LPrevScore := LScore;
end;
if Length(Result) < ALength then
Result := Copy(Result + DupeString('0', ALength), 1, ALength);
end;
end;

function SoundexInt(const AText: string; ALength: TSoundexIntLength): Integer;
var
LResult: string;
I: Integer;
begin
LResult := Soundex(AText, ALength);
Result := Ord(LResult[1]) - Ord('A');
if ALength > 1 then
begin
Result := Result * 26 + StrToInt(LResult[2]);
for I := 3 to ALength do
Result := Result * 7 + StrToInt(LResult[I]);
end;
Result := Result * 9 + ALength;
end;

function DecodeSoundexInt(AValue: Integer): string;
var
I, LLength: Integer;
begin
Result := '';
LLength := AValue mod 9;
AValue := AValue div 9;
for I := LLength downto 3 do
begin
Result := IntToStr(AValue mod 7) + Result;
AValue := AValue div 7;
end;
if LLength > 2 then
Result := IntToStr(AValue mod 26) + Result;
AValue := AValue div 26;
Result := Chr(AValue + Ord('A')) + Result;
end;

function SoundexWord(const AText: string): Word;
var
LResult: string;
begin
LResult := Soundex(AText, 4);
Result := Ord(LResult[1]) - Ord('A');
Result := Result * 26 + StrToInt(LResult[2]);
Result := Result * 7 + StrToInt(LResult[3]);
Result := Result * 7 + StrToInt(LResult[4]);
end;

function DecodeSoundexWord(AValue: Word): string;
begin
Result := IntToStr(AValue mod 7) + Result;
AValue := AValue div 7;
Result := IntToStr(AValue mod 7) + Result;
AValue := AValue div 7;
Result := IntToStr(AValue mod 26) + Result;
AValue := AValue div 26;
Result := Chr(AValue + Ord('A')) + Result;
end;

function SoundexSimilar(const AText, AOther: string; ALength: TSoundexLength): Boolean;
begin
Result := Soundex(AText, ALength) = Soundex(AOther, ALength);
end;

function SoundexCompare(const AText, AOther: string; ALength: TSoundexLength): Integer;
begin
Result := AnsiCompareStr(Soundex(AText, ALength), Soundex(AOther, ALength));
end;

function SoundexProc(const AText, AOther: string): Boolean;
begin
Result := SoundexSimilar(AText, AOther);
end;

end.

[王集鹄]

{ *********************************************************************** }
{ }
{ Delphi Runtime Library }
{ }
{ Copyright (c) 1995-2001 Borland Software Corporation }
{ }
{ *********************************************************************** }

{*******************************************************}
{ Date/time Utilities Unit }
{*******************************************************}

{ The following unit is ISO 8601 compliant. What that means is this unit
considers Monday the first day of the week (5.2.3). Additionally ISO 8601
dictates the following "the first calendar week of the year is the one
that includes the first Thursday of that year" (3.17). In other words the
first week of the week is the first one that has four or more days. For
more information about ISO 8601 see: http://www.iso.ch/markete/8601.pdf

The functions most impacted by ISO 8601 are marked as such in the interface
section.

The functions marked with "ISO 8601x" are not directly covered by ISO 8601
but their functionality is a logical extension to the standard.

Some of the functions, concepts or constants in this unit were provided by
Jeroen W. Pluimers (http://www.all-im.com), Glenn Crouch, Rune Moberg and
Ray Lischner (http://www.tempest-sw.com).

The Julian Date and Modified Julian Date functions are based on code
from NASA's SOHO site (http://sohowww.nascom.nasa.gov/solarsoft/gen/idl/time)
in which they credit the underlying algorithms as by Fliegel and Van
Flandern (1968) which was reprinted in the Explanatory Supplement to the
Astronomical Almanac, 1992.

Julian Date and Modified Julian Date is discussed in some detail on the
US Naval Observatory Time Service site (http://tycho.usno.navy.mil/mjd.html).
Additional information can be found at (http://www.treasure-troves.com/astro).
}

unit DateUtils;

interface

uses
SysUtils, Math, Types;

{ Simple trimming functions }

function DateOf(const AValue: TDateTime): TDateTime;
function TimeOf(const AValue: TDateTime): TDateTime;

{ Misc functions }

function IsInLeapYear(const AValue: TDateTime): Boolean;
function IsPM(const AValue: TDateTime): Boolean;
function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;
function IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
function IsValidDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond,
AMilliSecond: Word): Boolean;
function IsValidDateDay(const AYear, ADayOfYear: Word): Boolean;
function IsValidDateWeek(const AYear, AWeekOfYear, {ISO 8601}
ADayOfWeek: Word): Boolean;
function IsValidDateMonthWeek(const AYear, AMonth, AWeekOfMonth, {ISO 8601x}
ADayOfWeek: Word): Boolean;
function WeeksInYear(const AValue: TDateTime): Word; {ISO 8601}
function WeeksInAYear(const AYear: Word): Word; {ISO 8601}
function DaysInYear(const AValue: TDateTime): Word;
function DaysInAYear(const AYear: Word): Word;
function DaysInMonth(const AValue: TDateTime): Word;
function DaysInAMonth(const AYear, AMonth: Word): Word;
function Today: TDateTime;
function Yesterday: TDateTime;
function Tomorrow: TDateTime;
function IsToday(const AValue: TDateTime): Boolean;
function IsSameDay(const AValue, ABasis: TDateTime): Boolean;

{ Pick-a-field functions }

function YearOf(const AValue: TDateTime): Word;
function MonthOf(const AValue: TDateTime): Word;
function WeekOf(const AValue: TDateTime): Word; {ISO 8601}
function DayOf(const AValue: TDateTime): Word;
function HourOf(const AValue: TDateTime): Word;
function MinuteOf(const AValue: TDateTime): Word;
function SecondOf(const AValue: TDateTime): Word;
function MilliSecondOf(const AValue: TDateTime): Word;

{ Start/End functions }

function StartOfTheYear(const AValue: TDateTime): TDateTime;
function EndOfTheYear(const AValue: TDateTime): TDateTime;
function StartOfAYear(const AYear: Word): TDateTime;
function EndOfAYear(const AYear: Word): TDateTime;

function StartOfTheMonth(const AValue: TDateTime): TDateTime;
function EndOfTheMonth(const AValue: TDateTime): TDateTime;
function StartOfAMonth(const AYear, AMonth: Word): TDateTime;
function EndOfAMonth(const AYear, AMonth: Word): TDateTime;

function StartOfTheWeek(const AValue: TDateTime): TDateTime; {ISO 8601}
function EndOfTheWeek(const AValue: TDateTime): TDateTime; {ISO 8601}
function StartOfAWeek(const AYear, AWeekOfYear: Word; {ISO 8601}
const ADayOfWeek: Word = 1): TDateTime;
function EndOfAWeek(const AYear, AWeekOfYear: Word; {ISO 8601}
const ADayOfWeek: Word = 7): TDateTime;

function StartOfTheDay(const AValue: TDateTime): TDateTime;
function EndOfTheDay(const AValue: TDateTime): TDateTime;
function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime; overload;
function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime; overload;
function StartOfADay(const AYear, ADayOfYear: Word): TDateTime; overload;
function EndOfADay(const AYear, ADayOfYear: Word): TDateTime; overload;

{ This of that functions }

function MonthOfTheYear(const AValue: TDateTime): Word;
function WeekOfTheYear(const AValue: TDateTime): Word; overload; {ISO 8601}
function WeekOfTheYear(const AValue: TDateTime; {ISO 8601}
var AYear: Word): Word; overload;
function DayOfTheYear(const AValue: TDateTime): Word;
function HourOfTheYear(const AValue: TDateTime): Word;
function MinuteOfTheYear(const AValue: TDateTime): LongWord;
function SecondOfTheYear(const AValue: TDateTime): LongWord;
function MilliSecondOfTheYear(const AValue: TDateTime): Int64;

function WeekOfTheMonth(const AValue: TDateTime): Word; overload; {ISO 8601x}
function WeekOfTheMonth(const AValue: TDateTime; var AYear, {ISO 8601x}
AMonth: Word): Word; overload;
function DayOfTheMonth(const AValue: TDateTime): Word;
function HourOfTheMonth(const AValue: TDateTime): Word;
function MinuteOfTheMonth(const AValue: TDateTime): Word;
function SecondOfTheMonth(const AValue: TDateTime): LongWord;
function MilliSecondOfTheMonth(const AValue: TDateTime): LongWord;

function DayOfTheWeek(const AValue: TDateTime): Word; {ISO 8601}
function HourOfTheWeek(const AValue: TDateTime): Word; {ISO 8601}
function MinuteOfTheWeek(const AValue: TDateTime): Word; {ISO 8601}
function SecondOfTheWeek(const AValue: TDateTime): LongWord; {ISO 8601}
function MilliSecondOfTheWeek(const AValue: TDateTime): LongWord; {ISO 8601}

function HourOfTheDay(const AValue: TDateTime): Word;
function MinuteOfTheDay(const AValue: TDateTime): Word;
function SecondOfTheDay(const AValue: TDateTime): LongWord;
function MilliSecondOfTheDay(const AValue: TDateTime): LongWord;

function MinuteOfTheHour(const AValue: TDateTime): Word;
function SecondOfTheHour(const AValue: TDateTime): Word;
function MilliSecondOfTheHour(const AValue: TDateTime): LongWord;

function SecondOfTheMinute(const AValue: TDateTime): Word;
function MilliSecondOfTheMinute(const AValue: TDateTime): LongWord;

function MilliSecondOfTheSecond(const AValue: TDateTime): Word;

{ Range checking functions }

function WithinPastYears(const ANow, AThen: TDateTime;
const AYears: Integer): Boolean;
function WithinPastMonths(const ANow, AThen: TDateTime;
const AMonths: Integer): Boolean;
function WithinPastWeeks(const ANow, AThen: TDateTime;
const AWeeks: Integer): Boolean;
function WithinPastDays(const ANow, AThen: TDateTime;
const ADays: Integer): Boolean;
function WithinPastHours(const ANow, AThen: TDateTime;
const AHours: Int64): Boolean;
function WithinPastMinutes(const ANow, AThen: TDateTime;
const AMinutes: Int64): Boolean;
function WithinPastSeconds(const ANow, AThen: TDateTime;
const ASeconds: Int64): Boolean;
function WithinPastMilliSeconds(const ANow, AThen: TDateTime;
const AMilliSeconds: Int64): Boolean;

{ Range query functions }

function YearsBetween(const ANow, AThen: TDateTime): Integer;
function MonthsBetween(const ANow, AThen: TDateTime): Integer;
function WeeksBetween(const ANow, AThen: TDateTime): Integer;
function DaysBetween(const ANow, AThen: TDateTime): Integer;
function HoursBetween(const ANow, AThen: TDateTime): Int64;
function MinutesBetween(const ANow, AThen: TDateTime): Int64;
function SecondsBetween(const ANow, AThen: TDateTime): Int64;
function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;

{ Range spanning functions }
{ YearSpan and MonthSpan are approximates, not exact but pretty darn close }
function YearSpan(const ANow, AThen: TDateTime): Double;
function MonthSpan(const ANow, AThen: TDateTime): Double;
function WeekSpan(const ANow, AThen: TDateTime): Double;
function DaySpan(const ANow, AThen: TDateTime): Double;
function HourSpan(const ANow, AThen: TDateTime): Double;
function MinuteSpan(const ANow, AThen: TDateTime): Double;
function SecondSpan(const ANow, AThen: TDateTime): Double;
function MilliSecondSpan(const ANow, AThen: TDateTime): Double;

{ Increment/decrement datetime fields }

function IncYear(const AValue: TDateTime;
const ANumberOfYears: Integer = 1): TDateTime;
// function IncMonth is in SysUtils
function IncWeek(const AValue: TDateTime;
const ANumberOfWeeks: Integer = 1): TDateTime;
function IncDay(const AValue: TDateTime;
const ANumberOfDays: Integer = 1): TDateTime;
function IncHour(const AValue: TDateTime;
const ANumberOfHours: Int64 = 1): TDateTime;
function IncMinute(const AValue: TDateTime;
const ANumberOfMinutes: Int64 = 1): TDateTime;
function IncSecond(const AValue: TDateTime;
const ANumberOfSeconds: Int64 = 1): TDateTime;
function IncMilliSecond(const AValue: TDateTime;
const ANumberOfMilliSeconds: Int64 = 1): TDateTime;

{ Unified encode/decode functions that deal with all datetime fields at once }

function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond,
AMilliSecond: Word): TDateTime;
procedure DecodeDateTime(const AValue: TDateTime; out AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word);

{ Encode/decode functions that work with week of year and day of week }

function EncodeDateWeek(const AYear, AWeekOfYear: Word; {ISO 8601}
const ADayOfWeek: Word = 1): TDateTime;
procedure DecodeDateWeek(const AValue: TDateTime; out AYear, {ISO 8601}
AWeekOfYear, ADayOfWeek: Word);

{ Encode/decode functions that work with day of year }

function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;
procedure DecodeDateDay(const AValue: TDateTime; out AYear, ADayOfYear: Word);

{ Encode/decode functions that work with week of month }

function EncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, {ISO 8601x}
ADayOfWeek: Word): TDateTime;
procedure DecodeDateMonthWeek(const AValue: TDateTime; {ISO 8601x}
out AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);

{ The following functions are similar to the above ones except these don't
generated exceptions on failure, they return false instead }

function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond,
AMilliSecond: Word; out AValue: TDateTime): Boolean;
function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; {ISO 8601}
out AValue: TDateTime; const ADayOfWeek: Word = 1): Boolean;
function TryEncodeDateDay(const AYear, ADayOfYear: Word;
out AValue: TDateTime): Boolean;
function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, {ISO 8601x}
ADayOfWeek: Word; var AValue: TDateTime): Boolean;

{ Recode functions for datetime fields }

function RecodeYear(const AValue: TDateTime; const AYear: Word): TDateTime;
function RecodeMonth(const AValue: TDateTime; const AMonth: Word): TDateTime;
function RecodeDay(const AValue: TDateTime; const ADay: Word): TDateTime;
function RecodeHour(const AValue: TDateTime; const AHour: Word): TDateTime;
function RecodeMinute(const AValue: TDateTime; const AMinute: Word): TDateTime;
function RecodeSecond(const AValue: TDateTime; const ASecond: Word): TDateTime;
function RecodeMilliSecond(const AValue: TDateTime;
const AMilliSecond: Word): TDateTime;

function RecodeDate(const AValue: TDateTime; const AYear, AMonth,
ADay: Word): TDateTime;
function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond,
AMilliSecond: Word): TDateTime;
function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;

{ The following function is similar to the above one except it doesn't
generated an exception on failure, it return false instead }

function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word; out AResult: TDateTime): Boolean;

{ Fuzzy comparison }

function CompareDateTime(const A, B: TDateTime): TValueRelationship;
function SameDateTime(const A, B: TDateTime): Boolean;
function CompareDate(const A, B: TDateTime): TValueRelationship;
function SameDate(const A, B: TDateTime): Boolean;
function CompareTime(const A, B: TDateTime): TValueRelationship;
function SameTime(const A, B: TDateTime): Boolean;

{ For a given date these functions tell you the which day of the week of the
month (or year). If its a Thursday, they will tell you if its the first,
second, etc Thursday of the month (or year). Remember, even though its
the first Thursday of the year it doesn't mean its the first week of the
year. See ISO 8601 above for more information. }

function NthDayOfWeek(const AValue: TDateTime): Word;

procedure DecodeDayOfWeekInMonth(const AValue: TDateTime; out AYear, AMonth,
ANthDayOfWeek, ADayOfWeek: Word);

function EncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek,
ADayOfWeek: Word): TDateTime;
function TryEncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek,
ADayOfWeek: Word; out AValue: TDateTime): Boolean;

{ Error reporting }

procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute,
ASecond, AMilliSecond: Word; const ABaseDate: TDateTime = 0);
procedure InvalidDateWeekError(const AYear, AWeekOfYear, ADayOfWeek: Word);
procedure InvalidDateDayError(const AYear, ADayOfYear: Word);
procedure InvalidDateMonthWeekError(const AYear, AMonth, AWeekOfMonth,
ADayOfWeek: Word);
procedure InvalidDayOfWeekInMonthError(const AYear, AMonth, ANthDayOfWeek,
ADayOfWeek: Word);

{ Julian and Modified Julian Date conversion support }
{ Be aware that not all Julian Dates (or MJD) are encodable as a TDateTime }

function DateTimeToJulianDate(const AValue: TDateTime): Double;
function JulianDateToDateTime(const AValue: Double): TDateTime;
function TryJulianDateToDateTime(const AValue: Double;
out ADateTime: TDateTime): Boolean;

function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
function TryModifiedJulianDateToDateTime(const AValue: Double;
out ADateTime: TDateTime): Boolean;

{ Unix date conversion support }

function DateTimeToUnix(const AValue: TDateTime): Int64;
function UnixToDateTime(const AValue: Int64): TDateTime;

{ Constants used in this unit }

const
DaysPerWeek = 7;
WeeksPerFortnight = 2;
MonthsPerYear = 12;
YearsPerDecade = 10;
YearsPerCentury = 100;
YearsPerMillennium = 1000;

DayMonday = 1;
DayTuesday = 2;
DayWednesday = 3;
DayThursday = 4;
DayFriday = 5;
DaySaturday = 6;
DaySunday = 7;

OneHour = 1 / HoursPerDay;
OneMinute = 1 / MinsPerDay;
OneSecond = 1 / SecsPerDay;
OneMillisecond = 1 / MSecsPerDay;

{ This is actual days per year but you need to know if it's a leap year}
DaysPerYear: array [Boolean] of Word = (365, 366);

{ Used in RecodeDate, RecodeTime and RecodeDateTime for those datetime }
{ fields you want to leave alone }
RecodeLeaveFieldAsIs = High(Word);

{ Global variable used in this unit }

var

{ average over a 4 year span }
ApproxDaysPerMonth: Double = 30.4375;
ApproxDaysPerYear: Double = 365.25;

{ The above are the average days per month/year over a normal 4 year period. }
{ We use these approximations because they are more accurate for the next }
{ century or so. After that you may want to switch over to these 400 year }
{ approximations... }
{ ApproxDaysPerMonth = 30.436875 }
{ ApproxDaysPerYear = 365.2425 }

implementation

uses
RTLConsts;

function DateOf(const AValue: TDateTime): TDateTime;
begin
Result := Trunc(AValue);
end;

function TimeOf(const AValue: TDateTime): TDateTime;
begin
Result := Frac(AValue);
end;


function IsInLeapYear(const AValue: TDateTime): Boolean;
begin
Result := IsLeapYear(YearOf(AValue));
end;

function IsPM(const AValue: TDateTime): Boolean;
begin
Result := HourOf(AValue) >= 12;
end;

function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;
begin
Result := (AYear >= 1) and (AYear <= 9999) and
(AMonth >= 1) and (AMonth <= 12) and
(ADay >= 1) and (ADay <= DaysInAMonth(AYear, AMonth));
end;

function IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
begin
Result := ((AHour < 24) and (AMinute < 60) and
(ASecond < 60) and (AMilliSecond < 1000)) or
((AHour = 24) and (AMinute = 0) and
(ASecond = 0) and (AMilliSecond = 0));
end;

function IsValidDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond,
AMilliSecond: Word): Boolean;
begin
Result := IsValidDate(AYear, AMonth, ADay) and
IsValidTime(AHour, AMinute, ASecond, AMilliSecond);
end;

function IsValidDateMonthWeek(const AYear, AMonth, AWeekOfMonth,
ADayOfWeek: Word): Boolean;
begin
Result := (AYear >= 1) and (AYear <= 9999) and
(AMonth >= 1) and (AMonth <= 12) and
(AWeekOfMonth >= 1) and (AWeekOfMonth <= 5) and
(ADayOfWeek >= DayMonday) and (ADayOfWeek <= DaySunday);
end;

function IsValidDateDay(const AYear, ADayOfYear: Word): Boolean;
begin
Result := (AYear >= 1) and (AYear <= 9999) and
(ADayOfYear >= 1) and (ADayOfYear <= DaysInAYear(AYear));
end;

function IsValidDateWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): Boolean;
begin
Result := (AYear >= 1) and (AYear <= 9999) and
(AWeekOfYear >= 1) and (AWeekOfYear <= WeeksInAYear(AYear)) and
(ADayOfWeek >= DayMonday) and (ADayOfWeek <= DaySunday);
end;

function DaysInYear(const AValue: TDateTime): Word;
begin
Result := DaysInAYear(YearOf(AValue));
end;

function DaysInAYear(const AYear: Word): Word;
begin
Result := DaysPerYear[IsLeapYear(AYear)];
end;

function DaysInMonth(const AValue: TDateTime): Word;
begin
Result := DaysInAMonth(YearOf(AValue), MonthOf(AValue));
end;

function DaysInAMonth(const AYear, AMonth: Word): Word;
begin
Result := MonthDays[(AMonth = 2) and IsLeapYear(AYear), AMonth];
end;

function WeeksInYear(const AValue: TDateTime): Word;
begin
Result := WeeksInAYear(YearOf(AValue));
end;

function WeeksInAYear(const AYear: Word): Word;
var
LDayOfWeek: Word;
begin
Result := 52;
LDayOfWeek := DayOfTheWeek(EncodeDate(AYear, 1, 1));
if (LDayOfWeek = DayThursday) or
((LDayOfWeek = DayWednesday) and IsLeapYear(AYear)) then
Inc(Result);
end;

function Today: TDateTime;
begin
Result := Date;
end;

function Yesterday: TDateTime;
begin
Result := Date - 1;
end;

function Tomorrow: TDateTime;
begin
Result := Date + 1;
end;

function IsToday(const AValue: TDateTime): Boolean;
begin
Result := IsSameDay(AValue, Date);
end;

function IsSameDay(const AValue, ABasis: TDateTime): Boolean;
begin
Result := (AValue >= Trunc(ABasis)) and
(AValue < Trunc(ABasis) + 1);
end;

function YearOf(const AValue: TDateTime): Word;
var
LMonth, LDay: Word;
begin
DecodeDate(AValue, Result, LMonth, LDay);
end;

function MonthOf(const AValue: TDateTime): Word;
var
LYear, LDay: Word;
begin
DecodeDate(AValue, LYear, Result, LDay);
end;

function WeekOf(const AValue: TDateTime): Word;
begin
Result := WeekOfTheYear(AValue);
end;

function DayOf(const AValue: TDateTime): Word;
var
LYear, LMonth: Word;
begin
DecodeDate(AValue, LYear, LMonth, Result);
end;

function HourOf(const AValue: TDateTime): Word;
var
LMinute, LSecond, LMilliSecond: Word;
begin
DecodeTime(AValue, Result, LMinute, LSecond, LMilliSecond);
end;

function MinuteOf(const AValue: TDateTime): Word;
var
LHour, LSecond, LMilliSecond: Word;
begin
DecodeTime(AValue, LHour, Result, LSecond, LMilliSecond);
end;

function SecondOf(const AValue: TDateTime): Word;
var
LHour, LMinute, LMilliSecond: Word;
begin
DecodeTime(AValue, LHour, LMinute, Result, LMilliSecond);
end;

function MilliSecondOf(const AValue: TDateTime): Word;
var
LHour, LMinute, LSecond: Word;
begin
DecodeTime(AValue, LHour, LMinute, LSecond, Result);
end;

function StartOfTheYear(const AValue: TDateTime): TDateTime;
begin
Result := EncodeDate(YearOf(AValue), 1, 1);
end;

function EndOfTheYear(const AValue: TDateTime): TDateTime;
begin
Result := EndOfTheDay(EncodeDate(YearOf(AValue), 12, 31));
end;

function StartOfTheMonth(const AValue: TDateTime): TDateTime;
var
LYear, LMonth, LDay: Word;
begin
DecodeDate(AValue, LYear, LMonth, LDay);
Result := EncodeDate(LYear, LMonth, 1);
end;

function EndOfTheMonth(const AValue: TDateTime): TDateTime;
var
LYear, LMonth, LDay: Word;
begin
DecodeDate(AValue, LYear, LMonth, LDay);
Result := EndOfTheDay(EncodeDate(LYear, LMonth, DaysInAMonth(LYear, LMonth)));
end;

function StartOfTheWeek(const AValue: TDateTime): TDateTime;
begin
Result := Trunc(AValue) - (DayOfTheWeek(AValue) - 1);
end;

function EndOfTheWeek(const AValue: TDateTime): TDateTime;
begin
Result := EndOfTheDay(StartOfTheWeek(AValue) + 6);
end;

function StartOfTheDay(const AValue: TDateTime): TDateTime;
begin
Result := Trunc(AValue);
end;

function EndOfTheDay(const AValue: TDateTime): TDateTime;
begin
Result := RecodeTime(AValue, 23, 59, 59, 999);
end;

function StartOfAYear(const AYear: Word): TDateTime;
begin
Result := EncodeDate(AYear, 1, 1);
end;

function EndOfAYear(const AYear: Word): TDateTime;
begin
Result := EndOfTheDay(EncodeDate(AYear, 12, 31));
end;

function StartOfAMonth(const AYear, AMonth: Word): TDateTime;
begin
Result := EncodeDate(AYear, AMonth, 1);
end;

function EndOfAMonth(const AYear, AMonth: Word): TDateTime;
begin
Result := EndOfTheDay(EncodeDate(AYear, AMonth, DaysInAMonth(AYear, AMonth)));
end;

function StartOfAWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): TDateTime;
begin
Result := EncodeDateWeek(AYear, AWeekOfYear, ADayOfWeek);
end;

function EndOfAWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): TDateTime;
begin
Result := EndOfTheDay(EncodeDateWeek(AYear, AWeekOfYear, ADayOfWeek));
end;

function StartOfADay(const AYear, ADayOfYear: Word): TDateTime;
begin
Result := EncodeDateDay(AYear, ADayOfYear);
end;

function EndOfADay(const AYear, ADayOfYear: Word): TDateTime;
begin
Result := EndOfTheDay(EncodeDateDay(AYear, ADayOfYear));
end;

function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime;
begin
Result := StartOfAMonth(AYear, AMonth) + ADay - 1;
end;

function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime;
begin
Result := EndOfAMonth(AYear, AMonth) + ADay - 1;
end;


function MonthOfTheYear(const AValue: TDateTime): Word;
begin
Result := MonthOf(AValue);
end;

function WeekOfTheYear(const AValue: TDateTime): Word;
var
LYear, LDOW: Word;
begin
DecodeDateWeek(AValue, LYear, Result, LDOW);
end;

function WeekOfTheYear(const AValue: TDateTime; var AYear: Word): Word;
var
LDOW: Word;
begin
DecodeDateWeek(AValue, AYear, Result, LDOW);
end;

function DayOfTheYear(const AValue: TDateTime): Word;
begin
Result := Trunc(AValue - StartOfTheYear(AValue)) + 1;
end;

function HourOfTheYear(const AValue: TDateTime): Word;
begin
Result := HourOf(AValue) + (DayOfTheYear(AValue) - 1) * HoursPerDay;
end;

function MinuteOfTheYear(const AValue: TDateTime): LongWord;
begin
Result := MinuteOf(AValue) + HourOfTheYear(AValue) * 60;
end;

function SecondOfTheYear(const AValue: TDateTime): LongWord;
begin
Result := SecondOf(AValue) + MinuteOfTheYear(AValue) * 60;
end;

function MilliSecondOfTheYear(const AValue: TDateTime): Int64;
begin
Result := MilliSecondOf(AValue) + SecondOfTheYear(AValue) + 1000;
end;


function WeekOfTheMonth(const AValue: TDateTime): Word;
var
LYear, LMonth, LDayOfWeek: Word;
begin
DecodeDateMonthWeek(AValue, LYear, LMonth, Result, LDayOfWeek);
end;

function WeekOfTheMonth(const AValue: TDateTime; var AYear, AMonth: Word): Word;
var
LDayOfWeek: Word;
begin
DecodeDateMonthWeek(AValue, AYear, AMonth, Result, LDayOfWeek);
end;

function DayOfTheMonth(const AValue: TDateTime): Word;
begin
Result := DayOf(AValue);
end;

function HourOfTheMonth(const AValue: TDateTime): Word;
begin
Result := HourOf(AValue) + (DayOfTheMonth(AValue) - 1) * HoursPerDay;
end;

function MinuteOfTheMonth(const AValue: TDateTime): Word;
begin
Result := MinuteOf(AValue) + HourOfTheMonth(AValue) * 60;
end;

function SecondOfTheMonth(const AValue: TDateTime): LongWord;
begin
Result := SecondOf(AValue) + MinuteOfTheMonth(AValue) * 60;
end;

function MilliSecondOfTheMonth(const AValue: TDateTime): LongWord;
begin
Result := MilliSecondOf(AValue) + SecondOfTheMonth(AValue) + 1000;
end;


function DayOfTheWeek(const AValue: TDateTime): Word;
begin
Result := (DateTimeToTimeStamp(AValue).Date - 1) mod 7 + 1;
end;

function HourOfTheWeek(const AValue: TDateTime): Word;
begin
Result := HourOf(AValue) + (DayOfTheWeek(AValue) - 1) * HoursPerDay;
end;

function MinuteOfTheWeek(const AValue: TDateTime): Word;
begin
Result := MinuteOf(AValue) + HourOfTheWeek(AValue) * 60;
end;

function SecondOfTheWeek(const AValue: TDateTime): LongWord;
begin
Result := SecondOf(AValue) + MinuteOfTheWeek(AValue) * 60;
end;

function MilliSecondOfTheWeek(const AValue: TDateTime): LongWord;
begin
Result := MilliSecondOf(AValue) + SecondOfTheWeek(AValue) + 1000;
end;


function HourOfTheDay(const AValue: TDateTime): Word;
begin
Result := HourOf(AValue);
end;

function MinuteOfTheDay(const AValue: TDateTime): Word;
var
LHours, LMinutes, LSeconds, LMilliSeconds: Word;
begin
DecodeTime(AValue, LHours, LMinutes, LSeconds, LMilliSeconds);
Result := LMinutes + LHours * 60;
end;

function SecondOfTheDay(const AValue: TDateTime): LongWord;
var
LHours, LMinutes, LSeconds, LMilliSeconds: Word;
begin
DecodeTime(AValue, LHours, LMinutes, LSeconds, LMilliSeconds);
Result := LSeconds + (LMinutes + LHours * 60) * 60;
end;

function MilliSecondOfTheDay(const AValue: TDateTime): LongWord;
var
LHours, LMinutes, LSeconds, LMilliSeconds: Word;
begin
DecodeTime(AValue, LHours, LMinutes, LSeconds, LMilliSeconds);
Result := LMilliSeconds + (LSeconds + (LMinutes + LHours * 60) * 60) * 1000;
end;


function MinuteOfTheHour(const AValue: TDateTime): Word;
begin
Result := MinuteOf(AValue);
end;

function SecondOfTheHour(const AValue: TDateTime): Word;
var
LHours, LMinutes, LSeconds, LMilliSeconds: Word;
begin
DecodeTime(AValue, LHours, LMinutes, LSeconds, LMilliSeconds);
Result := LSeconds + (LMinutes * 60);
end;

function MilliSecondOfTheHour(const AValue: TDateTime): LongWord;
var
LHours, LMinutes, LSeconds, LMilliSeconds: Word;
begin
DecodeTime(AValue, LHours, LMinutes, LSeconds, LMilliSeconds);
Result := LMilliSeconds + (LSeconds + LMinutes * 60) * 1000;
end;


function SecondOfTheMinute(const AValue: TDateTime): Word;
begin
Result := SecondOf(AValue);
end;

function MilliSecondOfTheMinute(const AValue: TDateTime): LongWord;
var
LHours, LMinutes, LSeconds, LMilliSeconds: Word;
begin
DecodeTime(AValue, LHours, LMinutes, LSeconds, LMilliSeconds);
Result := LMilliSeconds + LSeconds * 1000;
end;


function MilliSecondOfTheSecond(const AValue: TDateTime): Word;
begin
Result := MilliSecondOf(AValue);
end;


function WithinPastYears(const ANow, AThen: TDateTime;
const AYears: Integer): Boolean;
begin
Result := YearsBetween(ANow, AThen) <= AYears;
end;

function WithinPastMonths(const ANow, AThen: TDateTime;
const AMonths: Integer): Boolean;
begin
Result := MonthsBetween(ANow, AThen) <= AMonths;
end;

function WithinPastWeeks(const ANow, AThen: TDateTime;
const AWeeks: Integer): Boolean;
begin
Result := WeeksBetween(ANow, AThen) <= AWeeks;
end;

function WithinPastDays(const ANow, AThen: TDateTime;
const ADays: Integer): Boolean;
begin
Result := DaysBetween(ANow, AThen) <= ADays;
end;

function WithinPastHours(const ANow, AThen: TDateTime;
const AHours: Int64): Boolean;
begin
Result := HoursBetween(ANow, AThen) <= AHours;
end;

function WithinPastMinutes(const ANow, AThen: TDateTime;
const AMinutes: Int64): Boolean;
begin
Result := MinutesBetween(ANow, AThen) <= AMinutes;
end;

function WithinPastSeconds(const ANow, AThen: TDateTime;
const ASeconds: Int64): Boolean;
begin
Result := SecondsBetween(ANow, AThen) <= ASeconds;
end;

function WithinPastMilliSeconds(const ANow, AThen: TDateTime;
const AMilliSeconds: Int64): Boolean;
begin
Result := MilliSecondsBetween(ANow, AThen) <= AMilliSeconds;
end;


function YearsBetween(const ANow, AThen: TDateTime): Integer;
begin
Result := Trunc(YearSpan(ANow, AThen));
end;

function MonthsBetween(const ANow, AThen: TDateTime): Integer;
begin
Result := Trunc(MonthSpan(ANow, AThen));
end;

function WeeksBetween(const ANow, AThen: TDateTime): Integer;
begin
Result := Trunc(WeekSpan(ANow, AThen));
end;

function DaysBetween(const ANow, AThen: TDateTime): Integer;
begin
Result := Trunc(DaySpan(ANow, AThen));
end;

function HoursBetween(const ANow, AThen: TDateTime): Int64;
begin
Result := Trunc(HourSpan(ANow, AThen));
end;

function MinutesBetween(const ANow, AThen: TDateTime): Int64;
begin
Result := Trunc(MinuteSpan(ANow, AThen));
end;

function SecondsBetween(const ANow, AThen: TDateTime): Int64;
begin
Result := Trunc(SecondSpan(ANow, AThen));
end;

function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;
begin
Result := Trunc(MilliSecondSpan(ANow, AThen));
end;


function SpanOfNowAndThen(const ANow, AThen: TDateTime): TDateTime;
begin
if ANow < AThen then
Result := AThen - ANow
else
Result := ANow - AThen;
end;

function YearSpan(const ANow, AThen: TDateTime): Double;
begin
Result := DaySpan(ANow, AThen) / ApproxDaysPerYear;
end;

function MonthSpan(const ANow, AThen: TDateTime): Double;
begin
Result := DaySpan(ANow, AThen) / ApproxDaysPerMonth;
end;

function WeekSpan(const ANow, AThen: TDateTime): Double;
begin
Result := DaySpan(ANow, AThen) / DaysPerWeek;
end;

function DaySpan(const ANow, AThen: TDateTime): Double;
begin
Result := SpanOfNowAndThen(ANow, AThen);
end;

function HourSpan(const ANow, AThen: TDateTime): Double;
begin
Result := HoursPerDay * SpanOfNowAndThen(ANow, AThen);
end;

function MinuteSpan(const ANow, AThen: TDateTime): Double;
begin
Result := MinsPerDay * SpanOfNowAndThen(ANow, AThen);
end;

function SecondSpan(const ANow, AThen: TDateTime): Double;
begin
Result := SecsPerDay * SpanOfNowAndThen(ANow, AThen);
end;

function MilliSecondSpan(const ANow, AThen: TDateTime): Double;
begin
Result := MSecsPerDay * SpanOfNowAndThen(ANow, AThen);
end;


function IncYear(const AValue: TDateTime;
const ANumberOfYears: Integer): TDateTime;
begin
Result := IncMonth(AValue, ANumberOfYears * MonthsPerYear);
end;

function IncWeek(const AValue: TDateTime;
const ANumberOfWeeks: Integer): TDateTime;
begin
Result := AValue + ANumberOfWeeks * DaysPerWeek;
end;

function IncDay(const AValue: TDateTime;
const ANumberOfDays: Integer): TDateTime;
begin
Result := AValue + ANumberOfDays;
end;

function IncHour(const AValue: TDateTime;
const ANumberOfHours: Int64): TDateTime;
begin
Result := ((AValue * HoursPerDay) + ANumberOfHours) / HoursPerDay;
end;

function IncMinute(const AValue: TDateTime;
const ANumberOfMinutes: Int64): TDateTime;
begin
Result := ((AValue * MinsPerDay) + ANumberOfMinutes) / MinsPerDay;
end;

function IncSecond(const AValue: TDateTime;
const ANumberOfSeconds: Int64): TDateTime;
begin
Result := ((AValue * SecsPerDay) + ANumberOfSeconds) / SecsPerDay;
end;

function IncMilliSecond(const AValue: TDateTime;
const ANumberOfMilliSeconds: Int64): TDateTime;
begin
Result := ((AValue * MSecsPerDay) + ANumberOfMilliSeconds) / MSecsPerDay;
end;


function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond,
AMilliSecond: Word): TDateTime;
begin
if not TryEncodeDateTime(AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond, Result) then
InvalidDateTimeError(AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond);
end;

procedure DecodeDateTime(const AValue: TDateTime; out AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word);
begin
DecodeDate(AValue, AYear, AMonth, ADay);
DecodeTime(AValue, AHour, AMinute, ASecond, AMilliSecond);
end;

function EncodeDateWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): TDateTime;
begin
if not TryEncodeDateWeek(AYear, AWeekOfYear, Result, ADayOfWeek) then
InvalidDateWeekError(AYear, AWeekOfYear, ADayOfWeek);
end;

const
CDayMap: array [1..7] of Word = (7, 1, 2, 3, 4, 5, 6);

procedure DecodeDateWeek(const AValue: TDateTime; out AYear, AWeekOfYear,
ADayOfWeek: Word);
var
LDayOfYear: Integer;
LMonth, LDay: Word;
LStart: TDateTime;
LStartDayOfWeek, LEndDayOfWeek: Word;
LLeap: Boolean;
begin
LLeap := DecodeDateFully(AValue, AYear, LMonth, LDay, ADayOfWeek);
ADayOfWeek := CDayMap[ADayOfWeek];
LStart := EncodeDate(AYear, 1, 1);
LDayOfYear := Trunc(AValue - LStart + 1);
LStartDayOfWeek := DayOfTheWeek(LStart);
if LStartDayOfWeek in [DayFriday, DaySaturday, DaySunday] then
Dec(LDayOfYear, 8 - LStartDayOfWeek)
else
Inc(LDayOfYear, LStartDayOfWeek - 1);
if LDayOfYear <= 0 then
DecodeDateWeek(LStart - 1, AYear, AWeekOfYear, LDay)
else
begin
AWeekOfYear := LDayOfYear div 7;
if LDayOfYear mod 7 <> 0 then
Inc(AWeekOfYear);
if AWeekOfYear > 52 then
begin
LEndDayOfWeek := LStartDayOfWeek;
if LLeap then
begin
if LEndDayOfWeek = DaySunday then
LEndDayOfWeek := DayMonday
else
Inc(LEndDayOfWeek);
end;
if LEndDayOfWeek in [DayMonday, DayTuesday, DayWednesday] then
begin
Inc(AYear);
AWeekOfYear := 1;
end;
end;
end;
end;

function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;
begin
if not TryEncodeDateDay(AYear, ADayOfYear, Result) then
InvalidDateDayError(AYear, ADayOfYear);
end;

procedure DecodeDateDay(const AValue: TDateTime; out AYear, ADayOfYear: Word);
begin
AYear := YearOf(AValue);
ADayOfYear := DayOfTheYear(AValue);
end;

function EncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth,
ADayOfWeek: Word): TDateTime;
begin
if not TryEncodeDateMonthWeek(AYear, AMonth, AWeekOfMonth, ADayOfWeek,
Result) then
InvalidDateMonthWeekError(AYear, AMonth, AWeekOfMonth, ADayOfWeek);
end;

procedure DecodeDateMonthWeek(const AValue: TDateTime;
out AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
var
LDay, LDaysInMonth: Word;
LDayOfMonth: Integer;
LStart: TDateTime;
LStartDayOfWeek, LEndOfMonthDayOfWeek: Word;
begin
DecodeDateFully(AValue, AYear, AMonth, LDay, ADayOfWeek);
ADayOfWeek := CDayMap[ADayOfWeek];
LStart := EncodeDate(AYear, AMonth, 1);
LStartDayOfWeek := DayOfTheWeek(LStart);
LDayOfMonth := LDay;
if LStartDayOfWeek in [DayFriday, DaySaturday, DaySunday] then
Dec(LDayOfMonth, 8 - LStartDayOfWeek)
else
Inc(LDayOfMonth, LStartDayOfWeek - 1);
if LDayOfMonth <= 0 then
DecodeDateMonthWeek(LStart - 1, AYear, AMonth, AWeekOfMonth, LDay)
else
begin
AWeekOfMonth := LDayOfMonth div 7;
if LDayOfMonth mod 7 <> 0 then
Inc(AWeekOfMonth);
LDaysInMonth := DaysInAMonth(AYear, AMonth);
LEndOfMonthDayOfWeek := DayOfTheWeek(EncodeDate(AYear, AMonth, LDaysInMonth));
if (LEndOfMonthDayOfWeek in [DayMonday, DayTuesday, DayWednesday]) and
(LDaysInMonth - LDay < LEndOfMonthDayOfWeek) then
begin
Inc(AMonth);
if AMonth = 13 then
begin
AMonth := 1;
Inc(AYear);
end;
AWeekOfMonth := 1;
end;
end;
end;


function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond,
AMilliSecond: Word; out AValue: TDateTime): Boolean;
var
LTime: TDateTime;
begin
Result := TryEncodeDate(AYear, AMonth, ADay, AValue);
if Result then
begin
Result := TryEncodeTime(AHour, AMinute, ASecond, AMilliSecond, LTime);
if Result then
AValue := AValue + LTime;
end;
end;

function TryEncodeDateWeek(const AYear, AWeekOfYear: Word;
out AValue: TDateTime; const ADayOfWeek: Word): Boolean;
var
LDayOfYear: Integer;
LStartDayOfWeek: Word;
begin
Result := IsValidDateWeek(AYear, AWeekOfYear, ADayOfWeek);
if Result then
begin
AValue := EncodeDate(AYear, 1, 1);
LStartDayOfWeek := DayOfTheWeek(AValue);
LDayOfYear := (AWeekOfYear - 1) * 7 + ADayOfWeek - 1;
if LStartDayOfWeek in [DayFriday, DaySaturday, DaySunday] then
Inc(LDayOfYear, 8 - LStartDayOfWeek)
else
Dec(LDayOfYear, LStartDayOfWeek - 1);
AValue := AValue + LDayOfYear;
end;
end;

function TryEncodeDateDay(const AYear, ADayOfYear: Word;
out AValue: TDateTime): Boolean;
begin
Result := IsValidDateDay(AYear, ADayOfYear);
if Result then
AValue := StartOfAYear(AYear) + ADayOfYear - 1;
end;

function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth,
ADayOfWeek: Word; var AValue: TDateTime): Boolean;
var
LStartDayOfWeek: Word;
LDayOfMonth: Integer;
begin
Result := IsValidDateMonthWeek(AYear, AMonth, AWeekOfMonth, ADayOfWeek);
if Result then
begin
AValue := EncodeDate(AYear, AMonth, 1);
LStartDayOfWeek := DayOfTheWeek(AValue);
LDayOfMonth := (AWeekOfMonth - 1) * 7 + ADayOfWeek - 1;
if LStartDayOfWeek in [DayFriday, DaySaturday, DaySunday] then
Inc(LDayOfMonth, 8 - LStartDayOfWeek)
else
Dec(LDayOfMonth, LStartDayOfWeek - 1);
AValue := AValue + LDayOfMonth;
end;
end;


function RecodeYear(const AValue: TDateTime; const AYear: Word): TDateTime;
begin
Result := RecodeDateTime(AValue, AYear, RecodeLeaveFieldAsIs,
RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs,
RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs);
end;

function RecodeMonth(const AValue: TDateTime; const AMonth: Word): TDateTime;
begin
Result := RecodeDateTime(AValue, RecodeLeaveFieldAsIs, AMonth,
RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs,
RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs);
end;

function RecodeDay(const AValue: TDateTime; const ADay: Word): TDateTime;
begin
Result := RecodeDateTime(AValue, RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs,
ADay, RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs,
RecodeLeaveFieldAsIs);
end;

function RecodeHour(const AValue: TDateTime; const AHour: Word): TDateTime;
begin
Result := RecodeDateTime(AValue, RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs,
RecodeLeaveFieldAsIs, AHour, RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs,
RecodeLeaveFieldAsIs);
end;

function RecodeMinute(const AValue: TDateTime; const AMinute: Word): TDateTime;
begin
Result := RecodeDateTime(AValue, RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs,
RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs, AMinute, RecodeLeaveFieldAsIs,
RecodeLeaveFieldAsIs);
end;

function RecodeSecond(const AValue: TDateTime; const ASecond: Word): TDateTime;
begin
Result := RecodeDateTime(AValue, RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs,
RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs, ASecond,
RecodeLeaveFieldAsIs);
end;

function RecodeMilliSecond(const AValue: TDateTime;
const AMilliSecond: Word): TDateTime;
begin
Result := RecodeDateTime(AValue, RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs,
RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs,
RecodeLeaveFieldAsIs, AMilliSecond);
end;

function RecodeDate(const AValue: TDateTime; const AYear, AMonth,
ADay: Word): TDateTime;
begin
Result := RecodeDateTime(AValue, AYear, AMonth, ADay, RecodeLeaveFieldAsIs,
RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs);
end;

function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond,
AMilliSecond: Word): TDateTime;
begin
Result := RecodeDateTime(AValue, RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs,
RecodeLeaveFieldAsIs, AHour, AMinute, ASecond, AMilliSecond);
end;

function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
begin
if not TryRecodeDateTime(AValue, AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond, Result) then
InvalidDateTimeError(AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond,
AValue);
end;

function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word; out AResult: TDateTime): Boolean;
var
LYear, LMonth, LDay, LHour, LMinute, LSecond, LMilliSecond: Word;
begin
DecodeDateTime(AValue, LYear, LMonth, LDay,
LHour, LMinute, LSecond, LMilliSecond);
if AYear <> RecodeLeaveFieldAsIs then LYear := AYear;
if AMonth <> RecodeLeaveFieldAsIs then LMonth := AMonth;
if ADay <> RecodeLeaveFieldAsIs then LDay := ADay;
if AHour <> RecodeLeaveFieldAsIs then LHour := AHour;
if AMinute <> RecodeLeaveFieldAsIs then LMinute := AMinute;
if ASecond <> RecodeLeaveFieldAsIs then LSecond := ASecond;
if AMilliSecond <> RecodeLeaveFieldAsIs then LMilliSecond := AMilliSecond;
Result := TryEncodeDateTime(LYear, LMonth, LDay,
LHour, LMinute, LSecond, LMilliSecond, AResult);
end;

{ Fuzzy comparison }

function CompareDateTime(const A, B: TDateTime): TValueRelationship;
begin
if Abs(A - B) < OneMillisecond then
Result := EqualsValue
else if A < B then
Result := LessThanValue
else
Result := GreaterThanValue;
end;

function SameDateTime(const A, B: TDateTime): Boolean;
begin
Result := Abs(A - B) < OneMillisecond;
end;

function CompareDate(const A, B: TDateTime): TValueRelationship;
begin
if Trunc(A) = Trunc(B) then
Result := EqualsValue
else if A < B then
Result := LessThanValue
else
Result := GreaterThanValue;
end;

function SameDate(const A, B: TDateTime): Boolean;
begin
Result := Trunc(A) = Trunc(B);
end;

function CompareTime(const A, B: TDateTime): TValueRelationship;
begin
if Abs(Frac(A) - Frac(B)) < OneMillisecond then
Result := EqualsValue
else if A < B then
Result := LessThanValue
else
Result := GreaterThanValue;
end;

function SameTime(const A, B: TDateTime): Boolean;
begin
Result := Abs(Frac(A) - Frac(B)) < OneMillisecond;
end;


{ NthDayOfWeek conversion }

function NthDayOfWeek(const AValue: TDateTime): Word;
begin
Result := (DayOfTheMonth(AValue) - 1) div 7 + 1;
end;

procedure DecodeDayOfWeekInMonth(const AValue: TDateTime; out AYear, AMonth,
ANthDayOfWeek, ADayOfWeek: Word);
var
ADay: Word;
begin
DecodeDate(AValue, AYear, AMonth, ADay);
ANthDayOfWeek := (ADay - 1) div 7 + 1;
ADayOfWeek := DayOfTheWeek(AValue);
end;

function EncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek,
ADayOfWeek: Word): TDateTime;
begin
if not TryEncodeDayOfWeekInMonth(AYear, AMonth, ANthDayOfWeek, ADayOfWeek, Result) then
InvalidDayOfWeekInMonthError(AYear, AMonth, ANthDayOfWeek, ADayOfWeek);
end;

function TryEncodeDayOfWeekInMonth(const AYear, AMonth,
ANthDayOfWeek, ADayOfWeek: Word; out AValue: TDateTime): Boolean;
var
LStartOfMonth, LDay: Word;
begin
LStartOfMonth := DayOfTheWeek(StartOfAMonth(AYear, AMonth));
if LStartOfMonth <= ADayOfWeek then
LDay := (ADayOfWeek - LStartOfMonth + 1) + 7 * (ANthDayOfWeek - 1)
else
LDay := (7 - LStartOfMonth + 1) + ADayOfWeek + 7 * (ANthDayOfWeek - 1);
Result := TryEncodeDate(AYear, AMonth, LDay, AValue);
end;


{ Julian and Modified Julian Date conversion support }

function DateTimeToJulianDate(const AValue: TDateTime): Double;
var
LYear, LMonth, LDay: Word;
begin
DecodeDate(AValue, LYear, LMonth, LDay);
Result := (1461 * (LYear + 4800 + (LMonth - 14) div 12)) div 4 +
(367 * (LMonth - 2 - 12 * ((LMonth - 14) div 12))) div 12 -
(3 * ((LYear + 4900 + (LMonth - 14) div 12) div 100)) div 4 +
LDay - 32075.5 + Frac(AValue);
end;

function JulianDateToDateTime(const AValue: Double): TDateTime;
begin
if not TryJulianDateToDateTime(AValue, Result) then
raise EConvertError.CreateFmt(SInvalidJulianDate, [AValue]);
end;

function TryJulianDateToDateTime(const AValue: Double;
out ADateTime: TDateTime): Boolean;
var
L, N, LYear, LMonth, LDay: Integer;
begin
L := Trunc(AValue) + 68570;
N := 4 * L div 146097;
L := L - (146097 * N + 3) div 4;
LYear := 4000 * (L + 1) div 1461001;
L := L - 1461 * LYear div 4 + 31;
LMonth := 80 * L div 2447;
LDay := L - 2447 * LMonth div 80;
L := LMonth div 11;
LMonth := LMonth + 2 - 12 * L;
LYear := 100 * (N - 49) + LYear + L;
Result := TryEncodeDate(LYear, LMonth, LDay, ADateTime);
if Result then
ADateTime := ADateTime + Frac(AValue) - 0.5;
end;

const
CJDToMJDOffset = 2400000.5;

function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
begin
Result := DateTimeToJulianDate(AValue) - CJDToMJDOffset;
end;

function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
begin
Result := JulianDateToDateTime(AValue + CJDToMJDOffset);
end;

function TryModifiedJulianDateToDateTime(const AValue: Double;
out ADateTime: TDateTime): Boolean;
begin
Result := TryJulianDateToDateTime(AValue + CJDToMJDOffset, ADateTime);
end;


{ Unix date conversion support }

function DateTimeToUnix(const AValue: TDateTime): Int64;
begin
Result := Round((AValue - UnixDateDelta) * SecsPerDay);
end;

function UnixToDateTime(const AValue: Int64): TDateTime;
begin
Result := AValue / SecsPerDay + UnixDateDelta;
end;


{ Error reporting }

procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute,
ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
function Translate(AOrig, AValue: Word): string;
begin
if AValue = RecodeLeaveFieldAsIs then
if ABaseDate = 0 then
Result := SMissingDateTimeField
else
Result := IntToStr(AOrig)
else
Result := IntToStr(AValue);
end;
begin
raise EConvertError.CreateFmt(SInvalidDateTime,
[Translate(YearOf(ABaseDate), AYear) + DateSeparator +
Translate(MonthOf(ABaseDate), AMonth) + DateSeparator +
Translate(DayOf(ABaseDate), ADay) + ' ' +
Translate(HourOf(ABaseDate), AHour) + TimeSeparator +
Translate(MinuteOf(ABaseDate), AMinute) + TimeSeparator +
Translate(SecondOf(ABaseDate), ASecond) + DecimalSeparator +
Translate(MilliSecondOf(ABaseDate), AMilliSecond)]);
end;

procedure InvalidDateWeekError(const AYear, AWeekOfYear, ADayOfWeek: Word);
begin
raise EConvertError.CreateFmt(SInvalidDateWeek, [AYear, AWeekOfYear, ADayOfWeek]);
end;

procedure InvalidDateDayError(const AYear, ADayOfYear: Word);
begin
raise EConvertError.CreateFmt(SInvalidDateDay, [AYear, ADayOfYear]);
end;

procedure InvalidDateMonthWeekError(const AYear, AMonth, AWeekOfMonth,
ADayOfWeek: Word);
begin
raise EConvertError.CreateFmt(SInvalidDateMonthWeek, [AYear, AMonth,
AWeekOfMonth, ADayOfWeek]);
end;

procedure InvalidDayOfWeekInMonthError(const AYear, AMonth, ANthDayOfWeek,
ADayOfWeek: Word);
begin
raise EConvertError.CreateFmt(SInvalidDayOfWeekInMonth, [AYear, AMonth,
ANthDayOfWeek, ADayOfWeek]);
end;

end.