123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373 |
- {$mode objfpc}
- {$h+}
- {
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2000 by the Free Pascal development team
- Delphi/Kylix compatibility unit, provides Date/Time handling routines.
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit dateutils;
- interface
- uses
- SysUtils, Math, Types;
- { ---------------------------------------------------------------------
- Various constants
- ---------------------------------------------------------------------}
- const
- DaysPerWeek = 7;
- WeeksPerFortnight = 2;
- MonthsPerYear = 12;
- YearsPerDecade = 10;
- YearsPerCentury = 100;
- YearsPerMillennium = 1000;
- // ISO day numbers.
- DayMonday = 1;
- DayTuesday = 2;
- DayWednesday = 3;
- DayThursday = 4;
- DayFriday = 5;
- DaySaturday = 6;
- DaySunday = 7;
- // Fraction of a day
- 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 variables used in this unit
- ---------------------------------------------------------------------}
- Const
- { Average over a 4 year span. Valid for next 100 years }
- ApproxDaysPerMonth: Double = 30.4375;
- ApproxDaysPerYear: Double = 365.25;
- { ---------------------------------------------------------------------
- Simple trimming functions.
- ---------------------------------------------------------------------}
- Function DateOf(const AValue: TDateTime): TDateTime;
- Function TimeOf(const AValue: TDateTime): TDateTime;
- { ---------------------------------------------------------------------
- Identification 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, ADayOfWeek: Word): Boolean;
- Function IsValidDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): Boolean;
- { ---------------------------------------------------------------------
- Enumeration functions.
- ---------------------------------------------------------------------}
- Function WeeksInYear(const AValue: TDateTime): Word;
- Function WeeksInAYear(const AYear: Word): Word;
- 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;
- { ---------------------------------------------------------------------
- Variations on current date/time.
- ---------------------------------------------------------------------}
- Function Today: TDateTime;
- Function Yesterday: TDateTime;
- Function Tomorrow: TDateTime;
- Function IsToday(const AValue: TDateTime): Boolean;
- Function IsSameDay(const AValue, ABasis: TDateTime): Boolean;
- Function PreviousDayOfWeek (DayOfWeek : Word) : Word;
- { ---------------------------------------------------------------------
- Extraction functions.
- ---------------------------------------------------------------------}
- Function YearOf(const AValue: TDateTime): Word;
- Function MonthOf(const AValue: TDateTime): Word;
- Function WeekOf(const AValue: TDateTime): Word;
- 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 of year 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;
- { ---------------------------------------------------------------------
- Start/End of month functions.
- ---------------------------------------------------------------------}
- 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;
- { ---------------------------------------------------------------------
- Start/End of week functions.
- ---------------------------------------------------------------------}
- Function StartOfTheWeek(const AValue: TDateTime): TDateTime;
- Function EndOfTheWeek(const AValue: TDateTime): TDateTime;
- Function StartOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
- Function StartOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // ADayOFWeek 1
- Function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
- Function EndOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // const ADayOfWeek: Word = 7
- { ---------------------------------------------------------------------
- Start/End of day functions.
- ---------------------------------------------------------------------}
- Function StartOfTheDay(const AValue: TDateTime): TDateTime;
- Function EndOfTheDay(const AValue: TDateTime): TDateTime;
- Function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime; overload;
- Function StartOfADay(const AYear, ADayOfYear: Word): TDateTime; overload;
- Function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime; overload;
- Function EndOfADay(const AYear, ADayOfYear: Word): TDateTime; overload;
- { ---------------------------------------------------------------------
- Part of year functions.
- ---------------------------------------------------------------------}
- Function MonthOfTheYear(const AValue: TDateTime): Word;
- Function WeekOfTheYear(const AValue: TDateTime): Word; overload;
- Function WeekOfTheYear(const AValue: TDateTime; 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;
- { ---------------------------------------------------------------------
- Part of month functions.
- ---------------------------------------------------------------------}
- Function WeekOfTheMonth(const AValue: TDateTime): Word; overload;
- Function WeekOfTheMonth(const AValue: TDateTime; var AYear, 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;
- { ---------------------------------------------------------------------
- Part of week functions.
- ---------------------------------------------------------------------}
- Function DayOfTheWeek(const AValue: TDateTime): Word;
- Function HourOfTheWeek(const AValue: TDateTime): Word;
- Function MinuteOfTheWeek(const AValue: TDateTime): Word;
- Function SecondOfTheWeek(const AValue: TDateTime): LongWord;
- Function MilliSecondOfTheWeek(const AValue: TDateTime): LongWord;
- { ---------------------------------------------------------------------
- Part of day functions.
- ---------------------------------------------------------------------}
- Function HourOfTheDay(const AValue: TDateTime): Word;
- Function MinuteOfTheDay(const AValue: TDateTime): Word;
- Function SecondOfTheDay(const AValue: TDateTime): LongWord;
- Function MilliSecondOfTheDay(const AValue: TDateTime): LongWord;
- { ---------------------------------------------------------------------
- Part of hour functions.
- ---------------------------------------------------------------------}
- Function MinuteOfTheHour(const AValue: TDateTime): Word;
- Function SecondOfTheHour(const AValue: TDateTime): Word;
- Function MilliSecondOfTheHour(const AValue: TDateTime): LongWord;
- { ---------------------------------------------------------------------
- Part of minute functions.
- ---------------------------------------------------------------------}
- Function SecondOfTheMinute(const AValue: TDateTime): Word;
- Function MilliSecondOfTheMinute(const AValue: TDateTime): LongWord;
- { ---------------------------------------------------------------------
- Part of second functions.
- ---------------------------------------------------------------------}
- 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;
- { ---------------------------------------------------------------------
- Period 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;
- { ---------------------------------------------------------------------
- Timespan in xxx functions.
- ---------------------------------------------------------------------}
- { YearSpan and MonthSpan are approximate values }
- 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 functions.
- ---------------------------------------------------------------------}
- Function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer ): TDateTime;
- Function IncYear(const AValue: TDateTime): TDateTime; // ; const ANumberOfYears: Integer = 1)
- // Function IncMonth is in SysUtils
- Function IncWeek(const AValue: TDateTime; const ANumberOfWeeks: Integer): TDateTime;
- Function IncWeek(const AValue: TDateTime): TDateTime; // ; const ANumberOfWeeks: Integer = 1)
- Function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer): TDateTime;
- Function IncDay(const AValue: TDateTime): TDateTime; //; const ANumberOfDays: Integer = 1)
- Function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;
- Function IncHour(const AValue: TDateTime): TDateTime; //; const ANumberOfHours: Int64 = 1
- Function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;
- Function IncMinute(const AValue: TDateTime): TDateTime; // ; const ANumberOfMinutes: Int64 = 1
- Function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64): TDateTime;
- Function IncSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfSeconds: Int64 = 1
- Function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64): TDateTime;
- Function IncMilliSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfMilliSeconds: Int64 = 1
- { ---------------------------------------------------------------------
- Encode/Decode of complete timestamp
- ---------------------------------------------------------------------}
- Function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
- Procedure DecodeDateTime(const AValue: TDateTime; var AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);
- Function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AValue: TDateTime): Boolean;
- { ---------------------------------------------------------------------
- Encode/decode date, specifying week of year and day of week
- ---------------------------------------------------------------------}
- Function EncodeDateWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
- Function EncodeDateWeek(const AYear, AWeekOfYear: Word): TDateTime; //; const ADayOfWeek: Word = 1
- Procedure DecodeDateWeek(const AValue: TDateTime; var AYear, AWeekOfYear, ADayOfWeek: Word);
- Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime; const ADayOfWeek: Word): Boolean;
- Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime): Boolean; //; const ADayOfWeek: Word = 1
- { ---------------------------------------------------------------------
- Encode/decode date, specifying day of year
- ---------------------------------------------------------------------}
- Function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;
- Procedure DecodeDateDay(const AValue: TDateTime; var AYear, ADayOfYear: Word);
- Function TryEncodeDateDay(const AYear, ADayOfYear: Word; var AValue: TDateTime): Boolean;
- { ---------------------------------------------------------------------
- Encode/decode date, specifying week of month
- ---------------------------------------------------------------------}
- Function EncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): TDateTime;
- Procedure DecodeDateMonthWeek(const AValue: TDateTime; var AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
- Function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
- { ---------------------------------------------------------------------
- Replace given element with supplied value.
- ---------------------------------------------------------------------}
- 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;
- Function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AResult: TDateTime): Boolean;
- { ---------------------------------------------------------------------
- Comparision of date/time
- ---------------------------------------------------------------------}
- Function CompareDateTime(const A, B: TDateTime): TValueRelationship;
- Function CompareDate(const A, B: TDateTime): TValueRelationship;
- Function CompareTime(const A, B: TDateTime): TValueRelationship;
- Function SameDateTime(const A, B: TDateTime): Boolean;
- Function SameDate(const A, B: TDateTime): Boolean;
- 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; var AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
- Function EncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word): TDateTime;
- Function TryEncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
- { ---------------------------------------------------------------------
- Exception throwing routines
- ---------------------------------------------------------------------}
- Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
- 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
- ---------------------------------------------------------------------}
- Function DateTimeToJulianDate(const AValue: TDateTime): Double;
- Function JulianDateToDateTime(const AValue: Double): TDateTime;
- Function TryJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
- Function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
- Function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
- Function TryModifiedJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
- { ---------------------------------------------------------------------
- Unix timestamp support.
- ---------------------------------------------------------------------}
- Function DateTimeToUnix(const AValue: TDateTime): Int64;
- Function UnixToDateTime(const AValue: Int64): TDateTime;
- Function UnixTimeStampToMac(const AValue: Int64): Int64;
- { ---------------------------------------------------------------------
- Mac timestamp support.
- ---------------------------------------------------------------------}
- Function DateTimeToMac(const AValue: TDateTime): Int64;
- Function MacToDateTime(const AValue: Int64): TDateTime;
- Function MacTimeStampToUnix(const AValue: Int64): Int64;
- { ScanDateTime is a limited inverse of formatdatetime }
- function ScanDateTime(const Pattern:string;const s:string;const fmt:TFormatSettings;startpos:integer=1) : tdatetime; overload;
- function ScanDateTime(const Pattern:string;const s:string;startpos:integer=1) : tdatetime; overload;
- implementation
- uses sysconst;
- { ---------------------------------------------------------------------
- Auxiliary routines
- ---------------------------------------------------------------------}
- Procedure NotYetImplemented (FN : String);
- begin
- Raise Exception.CreateFmt('Function "%s" (dateutils) is not yet implemented',[FN]);
- end;
- { ---------------------------------------------------------------------
- Simple trimming functions.
- ---------------------------------------------------------------------}
- Function DateOf(const AValue: TDateTime): TDateTime;
- begin
- Result:=Trunc(AValue);
- end;
- Function TimeOf(const AValue: TDateTime): TDateTime;
- begin
- Result:=Frac(Avalue);
- end;
- { ---------------------------------------------------------------------
- Identification functions.
- ---------------------------------------------------------------------}
- Function IsInLeapYear(const AValue: TDateTime): Boolean;
- Var
- D,Y,M : Word;
- begin
- DecodeDate(AValue,Y,M,D);
- Result:=IsLeapYear(Y);
- end;
- Function IsPM(const AValue: TDateTime): Boolean;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=(H>=12);
- end;
- Function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;
- begin
- Result:=(AYear<>0) and (AYear<10000)
- and (AMonth in [1..12])
- and (ADay<>0) and (ADay<=MonthDays[IsleapYear(AYear),AMonth]);
- end;
- Function IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
- begin
- Result:=(AHour=HoursPerDay) and (AMinute=0) and (ASecond=0) and (AMillisecond=0);
- Result:=Result or
- ((AHour<HoursPerDay) and (AMinute<MinsPerHour) and (ASecond<SecsPerMin) and
- (AMillisecond<MSecsPerSec));
- 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 IsValidDateDay(const AYear, ADayOfYear: Word): Boolean;
- begin
- Result:=(AYear<>0) and (ADayOfYear<>0) and (AYear<10000) and
- (ADayOfYear<=DaysPerYear[IsLeapYear(AYear)]);
- end;
- Function IsValidDateWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): Boolean;
- begin
- Result:=(AYear<>0) and (AYear<10000)
- and (ADayOfWeek in [1..7])
- and (AWeekOfYear<>0)
- and (AWeekOfYear<=WeeksInaYear(AYear));
- { should we not also check whether the day of the week is not
- larger than the last day of the last week in the year 9999 ?? }
- end;
- Function IsValidDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): Boolean;
- begin
- Result:=(AYear<>0) and (AYear<10000)
- and (AMonth in [1..12])
- and (AWeekOfMonth in [1..5])
- and (ADayOfWeek in [1..7]);
- end;
- { ---------------------------------------------------------------------
- Enumeration functions.
- ---------------------------------------------------------------------}
- Function WeeksInYear(const AValue: TDateTime): Word;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(AValue,Y,M,D);
- Result:=WeeksInAYear(Y);
- end;
- Function WeeksInAYear(const AYear: Word): Word;
- Var
- DOW : Word;
- begin
- Result:=52;
- DOW:=DayOfTheWeek(StartOfAYear(AYear));
- If (DOW=4) or ((DOW=3) and IsLeapYear(AYear)) then
- Inc(Result);
- end;
- Function DaysInYear(const AValue: TDateTime): Word;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(AValue,Y,M,D);
- Result:=DaysPerYear[IsLeapYear(Y)];
- end;
- Function DaysInAYear(const AYear: Word): Word;
- begin
- Result:=DaysPerYear[Isleapyear(AYear)];
- end;
- Function DaysInMonth(const AValue: TDateTime): Word;
- Var
- Y,M,D : Word;
- begin
- Decodedate(AValue,Y,M,D);
- Result:=MonthDays[IsLeapYear(Y),M];
- end;
- Function DaysInAMonth(const AYear, AMonth: Word): Word;
- begin
- Result:=MonthDays[IsLeapYear(AYear),AMonth];
- end;
- { ---------------------------------------------------------------------
- Variations on current date/time.
- ---------------------------------------------------------------------}
- 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;
- Var
- D : TDateTime;
- begin
- D:=AValue-Trunc(ABasis);
- Result:=(D>=0) and (D<1);
- end;
- const
- DOWMap: array [1..7] of Word = (7, 1, 2, 3, 4, 5, 6);
- Function PreviousDayOfWeek (DayOfWeek : Word) : Word;
- begin
- If Not (DayOfWeek in [1..7]) then
- Raise EConvertError.CreateFmt(SErrInvalidDayOfWeek,[DayOfWeek]);
- Result:=DOWMap[DayOfWeek];
- end;
- { ---------------------------------------------------------------------
- Extraction functions.
- ---------------------------------------------------------------------}
- Function YearOf(const AValue: TDateTime): Word;
- Var
- D,M : Word;
- begin
- DecodeDate(AValue,Result,D,M);
- end;
- Function MonthOf(const AValue: TDateTime): Word;
- Var
- Y,D : Word;
- begin
- DecodeDate(AValue,Y,Result,D);
- end;
- Function WeekOf(const AValue: TDateTime): Word;
- begin
- Result:=WeekOfTheYear(AValue);
- end;
- Function DayOf(const AValue: TDateTime): Word;
- Var
- Y,M : Word;
- begin
- DecodeDate(AValue,Y,M,Result);
- end;
- Function HourOf(const AValue: TDateTime): Word;
- Var
- N,S,MS : Word;
- begin
- DecodeTime(AValue,Result,N,S,MS);
- end;
- Function MinuteOf(const AValue: TDateTime): Word;
- Var
- H,S,MS : Word;
- begin
- DecodeTime(AValue,H,Result,S,MS);
- end;
- Function SecondOf(const AValue: TDateTime): Word;
- Var
- H,N,MS : Word;
- begin
- DecodeTime(AVAlue,H,N,Result,MS);
- end;
- Function MilliSecondOf(const AValue: TDateTime): Word;
- Var
- H,N,S : Word;
- begin
- DecodeTime(AValue,H,N,S,Result);
- end;
- { ---------------------------------------------------------------------
- Start/End of year functions.
- ---------------------------------------------------------------------}
- Function StartOfTheYear(const AValue: TDateTime): TDateTime;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(AValue,Y,M,D);
- Result:=EncodeDate(Y,1,1);
- end;
- Function EndOfTheYear(const AValue: TDateTime): TDateTime;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(AValue,Y,M,D);
- Result:=EncodeDateTime(Y,12,31,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:=(EncodeDateTime(AYear,12,31,23,59,59,999));
- end;
- { ---------------------------------------------------------------------
- Start/End of month functions.
- ---------------------------------------------------------------------}
- Function StartOfTheMonth(const AValue: TDateTime): TDateTime;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(AValue,Y,M,D);
- Result:=EncodeDate(Y,M,1);
- // MonthDays[IsLeapYear(Y),M])
- end;
- Function EndOfTheMonth(const AValue: TDateTime): TDateTime;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(AValue,Y,M,D);
- Result:=EncodeDateTime(Y,M,MonthDays[IsLeapYear(Y),M],23,59,59,999);
- end;
- Function StartOfAMonth(const AYear, AMonth: Word): TDateTime;
- begin
- Result:=EncodeDate(AYear,AMonth,1);
- end;
- Function EndOfAMonth(const AYear, AMonth: Word): TDateTime;
- begin
- Result:=EncodeDateTime(AYear,AMonth,MonthDays[IsLeapYear(AYear),AMonth],23,59,59,999);
- end;
- { ---------------------------------------------------------------------
- Start/End of week functions.
- ---------------------------------------------------------------------}
- Function StartOfTheWeek(const AValue: TDateTime): TDateTime;
- begin
- Result:=Trunc(AValue)-DayOfTheWeek(AValue)+1;
- end;
- Function EndOfTheWeek(const AValue: TDateTime): TDateTime;
- begin
- Result:=EndOfTheDay(AValue-DayOfTheWeek(AValue)+7);
- end;
- Function StartOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
- begin
- Result:=EncodeDateWeek(AYear,AWeekOfYear,ADayOfWeek);
- end;
- Function StartOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // ADayOFWeek 1
- begin
- Result:=StartOfAWeek(AYear,AWeekOfYear,1)
- end;
- Function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
- begin
- Result := EndOfTheDay(EncodeDateWeek(AYear, AWeekOfYear, ADayOfWeek));
- end;
- Function EndOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // const ADayOfWeek: Word = 7
- begin
- Result:=EndOfAWeek(AYear,AWeekOfYear,7);
- end;
- { ---------------------------------------------------------------------
- Start/End of day functions.
- ---------------------------------------------------------------------}
- Function StartOfTheDay(const AValue: TDateTime): TDateTime;
- begin
- StartOfTheDay:=Trunc(Avalue);
- end;
- Function EndOfTheDay(const AValue: TDateTime): TDateTime;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(AValue,Y,M,D);
- Result:=EncodeDateTime(Y,M,D,23,59,59,999);
- end;
- Function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime;
- begin
- Result:=EncodeDate(AYear,AMonth,ADay);
- end;
- Function StartOfADay(const AYear, ADayOfYear: Word): TDateTime;
- begin
- Result:=StartOfAYear(AYear)+ADayOfYear-1;
- end;
- Function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime;
- begin
- Result:=EndOfTheDay(EncodeDate(AYear,AMonth,ADay));
- end;
- Function EndOfADay(const AYear, ADayOfYear: Word): TDateTime;
- begin
- Result:=StartOfAYear(AYear)+ADayOfYear-1+EncodeTime(23,59,59,999);
- end;
- { ---------------------------------------------------------------------
- Part of year functions.
- ---------------------------------------------------------------------}
- Function MonthOfTheYear(const AValue: TDateTime): Word;
- Var
- Y,D : Word;
- begin
- DecodeDate(AValue,Y,Result,D);
- end;
- Function WeekOfTheYear(const AValue: TDateTime): Word;
- Var
- Y,DOW : Word;
- begin
- DecodeDateWeek(AValue,Y,Result,DOW)
- end;
- Function WeekOfTheYear(const AValue: TDateTime; var AYear: Word): Word;
- Var
- DOW : Word;
- begin
- DecodeDateWeek(AValue,AYear,Result,DOW);
- end;
- Function DayOfTheYear(const AValue: TDateTime): Word;
- begin
- Result:=Trunc(AValue-StartOfTheYear(AValue)+1);
- end;
- Function HourOfTheYear(const AValue: TDateTime): Word;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=H+((DayOfTheYear(AValue)-1)*24);
- end;
- Function MinuteOfTheYear(const AValue: TDateTime): LongWord;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=M+(H+((DayOfTheYear(AValue)-1)*24))*60;
- end;
- Function SecondOfTheYear(const AValue: TDateTime): LongWord;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=(M+(H+((DayOfTheYear(AValue)-1)*24))*60)*60+S;
- end;
- Function MilliSecondOfTheYear(const AValue: TDateTime): Int64;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=((M+(H+((int64(DayOfTheYear(AValue))-1)*24))*60)*60+S)*1000+MS;
- end;
- { ---------------------------------------------------------------------
- Part of month functions.
- ---------------------------------------------------------------------}
- Function WeekOfTheMonth(const AValue: TDateTime): Word;
- var
- Y,M,DOW : word;
- begin
- DecodeDateMonthWeek(AValue,Y,M,Result,DOW);
- end;
- Function WeekOfTheMonth(const AValue: TDateTime; var AYear, AMonth: Word): Word;
- Var
- DOW : Word;
- begin
- DecodeDateMonthWeek(AValue,AYear,AMonth,Result,DOW);
- end;
- Function DayOfTheMonth(const AValue: TDateTime): Word;
- Var
- Y,M : Word;
- begin
- DecodeDate(AValue,Y,M,Result);
- end;
- Function HourOfTheMonth(const AValue: TDateTime): Word;
- Var
- Y,M,D,H,N,S,MS : Word;
- begin
- DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
- Result:=(D-1)*24+H;
- end;
- Function MinuteOfTheMonth(const AValue: TDateTime): Word;
- Var
- Y,M,D,H,N,S,MS : Word;
- begin
- DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
- Result:=((D-1)*24+H)*60+N;
- end;
- Function SecondOfTheMonth(const AValue: TDateTime): LongWord;
- Var
- Y,M,D,H,N,S,MS : Word;
- begin
- DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
- Result:=(((D-1)*24+H)*60+N)*60+S;
- end;
- Function MilliSecondOfTheMonth(const AValue: TDateTime): LongWord;
- Var
- Y,M,D,H,N,S,MS : Word;
- begin
- DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
- Result:=((((D-1)*24+H)*60+N)*60+S)*1000+MS;
- end;
- { ---------------------------------------------------------------------
- Part of week functions.
- ---------------------------------------------------------------------}
- Function DayOfTheWeek(const AValue: TDateTime): Word;
- begin
- Result:=DowMAP[DayOfWeek(AValue)];
- end;
- Function HourOfTheWeek(const AValue: TDateTime): Word;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=(DayOfTheWeek(AValue)-1)*24+H;
- end;
- Function MinuteOfTheWeek(const AValue: TDateTime): Word;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=((DayOfTheWeek(AValue)-1)*24+H)*60+M;
- end;
- Function SecondOfTheWeek(const AValue: TDateTime): LongWord;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=(((DayOfTheWeek(AValue)-1)*24+H)*60+M)*60+S;
- end;
- Function MilliSecondOfTheWeek(const AValue: TDateTime): LongWord;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=((((DayOfTheWeek(AValue)-1)*24+H)*60+M)*60+S)*1000+MS;
- end;
- { ---------------------------------------------------------------------
- Part of day functions.
- ---------------------------------------------------------------------}
- Function HourOfTheDay(const AValue: TDateTime): Word;
- Var
- M,S,MS : Word;
- begin
- DecodeTime(AValue,Result,M,S,MS);
- end;
- Function MinuteOfTheDay(const AValue: TDateTime): Word;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=(H*60)+M;
- end;
- Function SecondOfTheDay(const AValue: TDateTime): LongWord;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=((H*60)+M)*60+S;
- end;
- Function MilliSecondOfTheDay(const AValue: TDateTime): LongWord;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=(((H*60)+M)*60+S)*1000+MS;
- end;
- { ---------------------------------------------------------------------
- Part of hour functions.
- ---------------------------------------------------------------------}
- Function MinuteOfTheHour(const AValue: TDateTime): Word;
- Var
- H,S,MS : Word;
- begin
- DecodeTime(AValue,H,Result,S,MS);
- end;
- Function SecondOfTheHour(const AValue: TDateTime): Word;
- Var
- H,S,M,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=M*60+S;
- end;
- Function MilliSecondOfTheHour(const AValue: TDateTime): LongWord;
- Var
- H,S,M,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=(M*60+S)*1000+MS;
- end;
- { ---------------------------------------------------------------------
- Part of minute functions.
- ---------------------------------------------------------------------}
- Function SecondOfTheMinute(const AValue: TDateTime): Word;
- Var
- H,M,MS : Word;
- begin
- DecodeTime(AValue,H,M,Result,MS);
- end;
- Function MilliSecondOfTheMinute(const AValue: TDateTime): LongWord;
- Var
- H,S,M,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=S*1000+MS;
- end;
- { ---------------------------------------------------------------------
- Part of second functions.
- ---------------------------------------------------------------------}
- Function MilliSecondOfTheSecond(const AValue: TDateTime): Word;
- Var
- H,M,S : Word;
- begin
- DecodeTime(AValue,H,M,S,Result);
- end;
- { ---------------------------------------------------------------------
- Range checking functions.
- ---------------------------------------------------------------------}
- 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;
- { ---------------------------------------------------------------------
- Period functions.
- ---------------------------------------------------------------------}
- {
- These functions are declared as approximate by Borland.
- A bit strange, since it can be calculated exactly ?
- }
- Function YearsBetween(const ANow, AThen: TDateTime): Integer;
- begin
- Result:=Trunc(Abs(ANow-AThen)/ApproxDaysPerYear);
- end;
- Function MonthsBetween(const ANow, AThen: TDateTime): Integer;
- begin
- Result:=Trunc(Abs(ANow-Athen)/ApproxDaysPerMonth);
- end;
- Function WeeksBetween(const ANow, AThen: TDateTime): Integer;
- begin
- Result:=Trunc(Abs(ANow-AThen)) div 7;
- end;
- Function DaysBetween(const ANow, AThen: TDateTime): Integer;
- begin
- Result:=Trunc(Abs(ANow-AThen));
- end;
- Function HoursBetween(const ANow, AThen: TDateTime): Int64;
- begin
- Result:=Trunc(Abs(ANow-AThen)*HoursPerDay);
- end;
- Function MinutesBetween(const ANow, AThen: TDateTime): Int64;
- begin
- Result:=Trunc(Abs(ANow-AThen)*MinsPerDay);
- end;
- Function SecondsBetween(const ANow, AThen: TDateTime): Int64;
- begin
- Result:=Trunc(Abs(ANow-AThen)*SecsPerDay);
- end;
- Function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;
- begin
- Result:=Trunc(Abs(ANow-AThen)*MSecsPerDay);
- end;
- { ---------------------------------------------------------------------
- Timespan in xxx functions.
- ---------------------------------------------------------------------}
- Function YearSpan(const ANow, AThen: TDateTime): Double;
- begin
- Result:=Abs(Anow-Athen)/ApproxDaysPerYear;
- end;
- Function MonthSpan(const ANow, AThen: TDateTime): Double;
- begin
- Result:=Abs(ANow-AThen)/ApproxDaysPerMonth;
- end;
- Function WeekSpan(const ANow, AThen: TDateTime): Double;
- begin
- Result:=Abs(ANow-AThen) / 7
- end;
- Function DaySpan(const ANow, AThen: TDateTime): Double;
- begin
- Result:=Abs(ANow-AThen);
- end;
- Function HourSpan(const ANow, AThen: TDateTime): Double;
- begin
- Result:=Abs(ANow-AThen)*HoursPerDay;
- end;
- Function MinuteSpan(const ANow, AThen: TDateTime): Double;
- begin
- Result:=Abs(ANow-AThen)*MinsPerDay;
- end;
- Function SecondSpan(const ANow, AThen: TDateTime): Double;
- begin
- Result:=Abs(ANow-AThen)*SecsPerDay;
- end;
- Function MilliSecondSpan(const ANow, AThen: TDateTime): Double;
- begin
- Result:=Abs(ANow-AThen)*MSecsPerDay;
- end;
- { ---------------------------------------------------------------------
- Increment/decrement functions.
- ---------------------------------------------------------------------}
- Function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer ): TDateTime;
- Var
- Y,M,D,H,N,S,MS : Word;
- begin
- DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
- Y:=Y+ANumberOfYears;
- If (M=2) and (D=29) And (Not IsLeapYear(Y)) then
- D:=28;
- Result:=EncodeDateTime(Y,M,D,H,N,S,MS);
- end;
- Function IncYear(const AValue: TDateTime): TDateTime; // ; const ANumberOfYears: Integer = 1)
- begin
- Result:=IncYear(Avalue,1);
- end;
- Function IncWeek(const AValue: TDateTime; const ANumberOfWeeks: Integer): TDateTime;
- begin
- Result:=AValue+ANumberOfWeeks*7;
- end;
- Function IncWeek(const AValue: TDateTime): TDateTime; // ; const ANumberOfWeeks: Integer = 1)
- begin
- Result:=IncWeek(Avalue,1);
- end;
- Function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer): TDateTime;
- begin
- Result:=AValue+ANumberOfDays;
- end;
- Function IncDay(const AValue: TDateTime): TDateTime; //; const ANumberOfDays: Integer = 1)
- begin
- Result:=IncDay(Avalue,1);
- end;
- Function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;
- begin
- Result:=AValue+ANumberOfHours/HoursPerDay;
- end;
- Function IncHour(const AValue: TDateTime): TDateTime; //; const ANumberOfHours: Int64 = 1
- begin
- Result:=IncHour(AValue,1);
- end;
- Function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;
- begin
- Result:=AValue+ANumberOfMinutes / MinsPerDay;
- end;
- Function IncMinute(const AValue: TDateTime): TDateTime; // ; const ANumberOfMinutes: Int64 = 1
- begin
- Result:=IncMinute(AValue,1);
- end;
- Function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64): TDateTime;
- begin
- Result:=AValue+ANumberOfSeconds / SecsPerDay;
- end;
- Function IncSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfSeconds: Int64 = 1
- begin
- Result:=IncSecond(Avalue,1);
- end;
- Function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64): TDateTime;
- begin
- Result:=AValue+ANumberOfMilliSeconds/MSecsPerDay;
- end;
- Function IncMilliSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfMilliSeconds: Int64 = 1
- begin
- Result:=IncMilliSecond(AValue,1);
- end;
- { ---------------------------------------------------------------------
- Encode/Decode of complete timestamp
- ---------------------------------------------------------------------}
- 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; var AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);
- begin
- DecodeDate(AValue,AYear,AMonth,ADay);
- DecodeTime(AValue,AHour,AMinute,ASecond,AMilliSecond);
- end;
- Function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AValue: TDateTime): Boolean;
- Var
- tmp : TDateTime;
- begin
- Result:=TryEncodeDate(AYear,AMonth,ADay,AValue);
- Result:=Result and TryEncodeTime(AHour,AMinute,ASecond,Amillisecond,Tmp);
- If Result then
- Avalue:=AValue+Tmp;
- end;
- { ---------------------------------------------------------------------
- Encode/decode date, specifying week of year and day of week
- ---------------------------------------------------------------------}
- Function EncodeDateWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
- begin
- If Not TryEncodeDateWeek(AYear,AWeekOfYear,Result,ADayOfWeek) then
- InvalidDateWeekError(AYear,AWeekOfYear,ADayOfWeek);
- end;
- Function EncodeDateWeek(const AYear, AWeekOfYear: Word): TDateTime; //; const ADayOfWeek: Word = 1
- begin
- Result := EncodeDateWeek(AYear,AWeekOfYear,1);
- end;
- Procedure DecodeDateWeek(const AValue: TDateTime; var AYear, AWeekOfYear, ADayOfWeek: Word);
- var
- DOY : Integer;
- D: Word;
- YS : TDateTime;
- YSDOW, YEDOW: Word;
- begin
- AYear:=YearOf(AValue);
- // Correct to ISO DOW
- ADayOfWeek:=DayOfWeek(AValue)-1;
- If ADAyOfWeek=0 then
- ADayofweek:=7;
- YS:=StartOfAYear(AYear);
- DOY:=Trunc(AValue-YS)+1;
- YSDOW:=DayOfTheWeek(YS);
- // Correct week if later than wednesday. First week never starts later than wednesday
- if (YSDOW<5) then
- Inc(DOY,YSDOW-1)
- else
- Dec(DOY,8-YSDOW);
- if (DOY<=0) then // Day is in last week of previous year.
- DecodeDateWeek(YS-1,AYear,AWeekOfYear,D)
- else
- begin
- AWeekOfYear:=DOY div 7;
- if ((DOY mod 7)<>0) then
- Inc(AWeekOfYear);
- if (AWeekOfYear>52) then // Maybe in first week of next year ?
- begin
- YEDOW:=YSDOW;
- if IsLeapYear(AYear) then
- begin
- Inc(YEDOW);
- if (YEDOW>7) then
- YEDOW:=1
- else
- end;
- if (YEDOW<4) then // Really next year.
- begin
- Inc(AYear);
- AWeekOfYear:=1;
- end;
- end;
- end;
- end;
- Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime; const ADayOfWeek: Word): Boolean;
- Var
- DOW : Word;
- Rest : Integer;
- begin
- Result:=IsValidDateWeek(Ayear,AWeekOfYear,ADayOfWeek);
- If Result then
- begin
- AValue:=EncodeDate(AYear,1,1)+(7*(AWeekOfYear-1));
- DOW:=DayOfTheWeek(AValue);
- Rest:=ADayOfWeek-DOW;
- If (DOW>4) then
- Inc(Rest,7);
- AValue:=AValue+Rest;
- end;
- end;
- Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime): Boolean; //; const ADayOfWeek: Word = 1
- begin
- Result:=TryEncodeDateWeek(AYear,AWeekOfYear,AValue,1);
- end;
- { ---------------------------------------------------------------------
- Encode/decode date, specifying day of year
- ---------------------------------------------------------------------}
- Function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;
- begin
- If Not TryEncodeDateDay(AYear,ADayOfYear,Result) then
- InvalidDateDayError(AYear,ADayOfYear);
- end;
- Procedure DecodeDateDay(const AValue: TDateTime; var AYear, ADayOfYear: Word);
- Var
- M,D : Word;
- begin
- DecodeDate(AValue,AYear,M,D);
- ADayOfyear:=Trunc(AValue-EncodeDate(AYear,1,1))+1;
- end;
- Function TryEncodeDateDay(const AYear, ADayOfYear: Word; var AValue: TDateTime): Boolean;
- begin
- Result:=(ADayOfYear<>0) and (ADayOfYear<=DaysPerYear [IsleapYear(AYear)]);
- If Result then
- AValue:=EncodeDate(AYear,1,1)+ADayOfYear-1;
- end;
- { ---------------------------------------------------------------------
- Encode/decode date, specifying week of month
- ---------------------------------------------------------------------}
- 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; var AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
- Var
- D,SDOM,EDOM : Word;
- SOM : TdateTime;
- DOM : Integer;
- begin
- DecodeDate(AValue,AYear,AMonth,D);
- ADayOfWeek:=DayOfTheWeek(AValue);
- SOM:=EncodeDate(Ayear,Amonth,1);
- SDOM:=DayOfTheWeek(SOM);
- DOM:=D-1+SDOM;
- If SDOM>4 then
- Dec(DOM,7);
- // Too early in the month. First full week is next week, day is after thursday.
- If DOM<=0 Then
- DecodeDateMonthWeek(SOM-1,AYear,AMonth,AWeekOfMonth,D)
- else
- begin
- AWeekOfMonth:=(DOM div 7)+Ord((DOM mod 7)<>0);
- EDOM:=DayOfTheWeek(EndOfAMonth(Ayear,AMonth));
- // In last days of last long week, so in next month...
- If (EDOM<4) and ((DaysInAMonth(AYear,Amonth)-D)<EDOM) then
- begin
- AWeekOfMonth:=1;
- Inc(AMonth);
- If (AMonth=13) then
- begin
- AMonth:=1;
- Inc(AYear);
- end;
- end;
- end;
- end;
- Function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
- var
- S : Word;
- DOM : Integer;
- begin
- Result:=IsValidDateMonthWeek(AYear,AMonth,AWeekOfMonth,ADayOfWeek);
- if Result then
- begin
- AValue:=EncodeDate(AYear,AMonth,1);
- DOM:=(AWeekOfMonth-1)*7+ADayOfWeek-1;
- { Correct for first week in last month.}
- S:=DayOfTheWeek(AValue);
- Dec(DOM,S-1);
- if S in [DayFriday..DaySunday] then
- Inc(DOM,7);
- AValue:=AValue+DOM;
- end;
- end;
- { ---------------------------------------------------------------------
- Replace given element with supplied value.
- ---------------------------------------------------------------------}
- Const
- LFAI = RecodeLeaveFieldAsIS; // Less typing, readable code
- {
- Note: We have little choice but to implement it like Borland did:
- If AValue contains some 'wrong' value, it will throw an error.
- To simulate this we'd have to check in each function whether
- both arguments are correct. To avoid it, all is routed through
- the 'central' RecodeDateTime function as in Borland's implementation.
- }
- Function RecodeYear(const AValue: TDateTime; const AYear: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,AYear,LFAI,LFAI,LFAI,LFAI,LFAI,LFAI);
- end;
- Function RecodeMonth(const AValue: TDateTime; const AMonth: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,LFAI,AMonth,LFAI,LFAI,LFAI,LFAI,LFAI);
- end;
- Function RecodeDay(const AValue: TDateTime; const ADay: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,LFAI,LFAI,ADay,LFAI,LFAI,LFAI,LFAI);
- end;
- Function RecodeHour(const AValue: TDateTime; const AHour: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,AHour,LFAI,LFAI,LFAI);
- end;
- Function RecodeMinute(const AValue: TDateTime; const AMinute: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,AMinute,LFAI,LFAI);
- end;
- Function RecodeSecond(const AValue: TDateTime; const ASecond: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,LFAI,ASecond,LFAI);
- end;
- Function RecodeMilliSecond(const AValue: TDateTime; const AMilliSecond: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,LFAI,LFAI,AMilliSecond);
- end;
- Function RecodeDate(const AValue: TDateTime; const AYear, AMonth, ADay: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,AYear,AMonth,ADay,LFAI,LFAI,LFAI,LFAI);
- end;
- Function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,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; var AResult: TDateTime): Boolean;
- Procedure FV (Var AV : Word; Arg : Word);
- begin
- If (Arg<>LFAI) then
- AV:=Arg;
- end;
- Var
- Y,M,D,H,N,S,MS : Word;
- begin
- DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
- FV(Y,AYear);
- FV(M,AMonth);
- FV(D,ADay);
- FV(H,AHour);
- FV(N,AMinute);
- FV(S,ASecond);
- FV(MS,AMillisecond);
- Result:=TryEncodeDateTime(Y,M,D,H,N,S,MS,AResult);
- end;
- { ---------------------------------------------------------------------
- Comparision of date/time
- ---------------------------------------------------------------------}
- Function CompareDateTime(const A, B: TDateTime): TValueRelationship;
- begin
- If SameDateTime(A,B) then
- Result:=EqualsValue
- else If A>B then
- Result:=GreaterThanValue
- else
- Result:=LessThanValue
- end;
- Function CompareDate(const A, B: TDateTime): TValueRelationship;
- begin
- If SameDate(A,B) then
- Result:=EQualsValue
- else if A<B then
- Result:=LessThanValue
- else
- Result:=GreaterThanValue;
- end;
- Function CompareTime(const A, B: TDateTime): TValueRelationship;
- begin
- If SameTime(A,B) then
- Result:=EQualsValue
- else If Frac(A)<Frac(B) then
- Result:=LessThanValue
- else
- Result:=GreaterThanValue;
- end;
- Function SameDateTime(const A, B: TDateTime): Boolean;
- begin
- Result:=Abs(A-B)<OneMilliSecond;
- end;
- Function SameDate(const A, B: TDateTime): Boolean;
- begin
- Result:=Trunc(A)=Trunc(B);
- end;
- Function SameTime(const A, B: TDateTime): Boolean;
- begin
- Result:=Frac(Abs(A-B))<OneMilliSecond;
- end;
- Function InternalNthDayOfWeek(DoM : Word) : Word;
- begin
- Result:=(Dom-1) div 7 +1;
- end;
- Function NthDayOfWeek(const AValue: TDateTime): Word;
- begin
- Result:=InternalNthDayOfWeek(DayOfTheMonth(AValue));
- end;
- Procedure DecodeDayOfWeekInMonth(const AValue: TDateTime; var AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
- var
- D: Word;
- begin
- DecodeDate(AValue,AYear,AMonth,D);
- ADayOfWeek:=DayOfTheWeek(AValue);
- ANthDayOfWeek:=InternalNthDayOfWeek(D);
- 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; var AValue: TDateTime): Boolean;
- Var
- SOM,D : Word;
- begin
- SOM:=DayOfTheWeek(EncodeDate(Ayear,AMonth,1));
- D:=1+ADayOfWeek-SOM+7*(ANthDayOfWeek-1);
- If SOM>ADayOfWeek then
- D:=D+7; // Clearer would have been Inc(ANthDayOfweek) but it's a const
- Result:=TryEncodeDate(Ayear,AMonth,D,AValue);
- end;
- { ---------------------------------------------------------------------
- Exception throwing routines
- ---------------------------------------------------------------------}
- Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
- Function DoField(Arg,Def : Word; Unknown: String) : String;
- begin
- If (Arg<>LFAI) then
- Result:=Format('%.*d',[Length(Unknown),Arg])
- else if (ABaseDate=0) then
- Result:=Unknown
- else
- Result:=Format('%.*d',[Length(Unknown),Arg]);
- end;
- Var
- Y,M,D,H,N,S,MS : Word;
- Msg : String;
- begin
- DecodeDateTime(ABasedate,Y,M,D,H,N,S,MS);
- Msg:=DoField(AYear,Y,'????');
- Msg:=Msg+DateSeparator+DoField(AMonth,M,'??');
- Msg:=Msg+DateSeparator+DoField(ADay,D,'??');
- Msg:=Msg+' '+DoField(AHour,H,'??');
- Msg:=Msg+TimeSeparator+DoField(AMinute,N,'??');
- Msg:=Msg+TimeSeparator+Dofield(ASecond,S,'??');
- Msg:=Msg+DecimalSeparator+DoField(AMilliSecond,MS,'???');
- Raise EConvertError.CreateFmt(SErrInvalidTimeStamp,[Msg]);
- end;
- Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word); // const ABaseDate: TDateTime = 0
- begin
- InvalidDateTimeError(AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,0);
- end;
- Procedure InvalidDateWeekError(const AYear, AWeekOfYear, ADayOfWeek: Word);
- begin
- Raise EConvertError.CreateFmt(SErrInvalidDateWeek,[AYear,AWeekOfYear,ADayOfWeek]);
- end;
- Procedure InvalidDateDayError(const AYear, ADayOfYear: Word);
- begin
- Raise EConvertError.CreateFmt(SErrInvalidDayOfYear,[AYear,ADayOfYear]);
- end;
- Procedure InvalidDateMonthWeekError(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
- begin
- Raise EConvertError.CreateFmt(SErrInvalidDateMonthWeek,[Ayear,AMonth,AWeekOfMonth,ADayOfWeek]);
- end;
- Procedure InvalidDayOfWeekInMonthError(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
- begin
- Raise EConvertError.CreateFmt(SErrInvalidDayOfWeekInMonth,[AYear,AMonth,ANthDayOfWeek,ADayOfWeek]);
- end;
- { ---------------------------------------------------------------------
- Julian and Modified Julian Date conversion support
- ---------------------------------------------------------------------}
- {$warnings off}
- Function DateTimeToJulianDate(const AValue: TDateTime): Double;
- begin
- NotYetImplemented('DateTimeToJulianDate');
- end;
- Function JulianDateToDateTime(const AValue: Double): TDateTime;
- begin
- NotYetImplemented('JulianDateToDateTime');
- end;
- Function TryJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
- begin
- NotYetImplemented('TryJulianDateToDateTime');
- end;
- Function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
- begin
- NotYetImplemented('DateTimeToModifiedJulianDate');
- end;
- Function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
- begin
- NotYetImplemented('ModifiedJulianDateToDateTime');
- end;
- Function TryModifiedJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
- begin
- NotYetImplemented('TryModifiedJulianDateToDateTime');
- end;
- {$warnings on}
- { ---------------------------------------------------------------------
- Unix timestamp support.
- ---------------------------------------------------------------------}
- Function DateTimeToUnix(const AValue: TDateTime): Int64;
- var
- Epoch:TDateTime;
- begin
- Epoch:=EncodeDateTime( 1970, 1, 1, 0, 0, 0, 0 );
- Result:=SecondsBetween( Epoch, AValue );
- end;
- Function UnixToDateTime(const AValue: Int64): TDateTime;
- var
- Epoch:TDateTime;
- begin
- Epoch:=EncodeDateTime( 1970, 1, 1, 0, 0, 0, 0 );
- Result:=IncSecond( Epoch, AValue );
- end;
- Function UnixTimeStampToMac(const AValue: Int64): Int64;
- const
- Epoch=24107 * 24 * 3600;
- begin
- Result:=AValue + Epoch;
- end;
- { ---------------------------------------------------------------------
- Mac timestamp support.
- ---------------------------------------------------------------------}
- Function DateTimeToMac(const AValue: TDateTime): Int64;
- var
- Epoch:TDateTime;
- begin
- Epoch:=EncodeDateTime( 1904, 1, 1, 0, 0, 0, 0 );
- Result:=SecondsBetween( Epoch, AValue );
- end;
- Function MacToDateTime(const AValue: Int64): TDateTime;
- var
- Epoch:TDateTime;
- begin
- Epoch:=EncodeDateTime( 1904, 1, 1, 0, 0, 0, 0 );
- Result:=IncSecond( Epoch, AValue );
- end;
- Function MacTimeStampToUnix(const AValue: Int64): Int64;
- const
- Epoch=24107 * 24 * 3600;
- begin
- Result:=AValue - Epoch;
- end;
- {
- Inverse of formatdatetime, destined for the dateutils unit of FPC.
- Limitations/implementation details:
- - An inverse of FormatDateTime is not 100% an inverse, simply because one can put e.g. time tokens twice in the format string,
- and scandatetime wouldn't know which time to pick.
- - Strings like hn can't be reversed safely. E.g. 1:2 (2 minutes after 1) delivers 12 which is parsed as 12:00 and then
- misses chars for the "n" part.
- - trailing characters are ignored.
- - no support for Eastern Asian formatting characters since they are windows only.
- - no MBCS support.
- Extensions
- - #9 eats whitespace.
- - whitespace at the end of a pattern is optional.
- - ? matches any char.
- - Quote the above chars to really match the char.
- }
- const whitespace = [' ',#13,#10];
- hrfactor = 1/(24);
- minfactor = 1/(24*60);
- secfactor = 1/(24*60*60);
- mssecfactor = 1/(24*60*60*1000);
- const AMPMformatting : array[0..2] of string =('am/pm','a/p','ampm');
- procedure raiseexception(const s:string);
- begin
- raise EConvertError.Create(s);
- end;
- function scandatetime(const pattern:string;const s:string;const fmt:TFormatSettings;startpos:integer=1) : tdatetime;
- var len ,ind : integer;
- yy,mm,dd : integer;
- timeval : TDateTime;
- activequote: char;
- procedure intscandate(ptrn:pchar;plen:integer;poffs:integer);
- // poffs is the offset to
- var
- pind : integer;
- function findimatch(const mnts:array of string;p:pchar):integer;
- var i : integer;
- begin
- result:=-1;
- i:=0;
- while (i<=high(mnts)) and (result=-1) do
- begin
- if AnsiStrLIComp(p,@mnts[i][1],length(mnts[i]))=0 then
- result:=i;
- inc(i);
- end;
- end;
- procedure arraymatcherror;
- begin
- raiseexception(format(SNoArrayMatch,[pind+1,ind]))
- end;
- function findmatch(const mnts : array of string;const s:string):integer;
- begin
- result:=findimatch(mnts,@s[ind]);
- if result=-1 then
- arraymatcherror
- else
- begin
- inc(ind,length(mnts[result])+1);
- inc(pind,length(mnts[result])+1);
- inc(result); // was 0 based.
- end;
- end;
- var
- pivot,
- i : integer;
- function scanfixedint(maxv:integer):integer;
- var c : char;
- oi:integer;
- begin
- result:=0;
- oi:=ind;
- c:=ptrn[pind];
- while (pind<plen) and (ptrn[pind]=c) do inc(pind);
- while (maxv>0) and (ind<=len) and (s[ind] IN ['0'..'9']) do
- begin
- result:=result*10+ord(s[ind])-48;
- inc(ind);
- dec(maxv);
- end;
- if oi=ind then
- raiseexception(format(SPatternCharMismatch,[c,oi]));
- end;
- procedure matchchar(c:char);
- begin
- if (ind>len) or (s[ind]<>c) then
- raiseexception(format(SNoCharMatch,[s[ind],c,pind+poffs+1,ind]));
- inc(pind);
- inc(ind);
- end;
- function scanpatlen:integer;
- var c : char;
- lind : Integer;
- begin
- result:=pind;
- lind:=pind;
- c:=ptrn[lind];
- while (lind<=plen) and (ptrn[lind]=c) do
- inc(lind);
- result:=lind-result;
- end;
- procedure matchpattern(const lptr:string);
- var len:integer;
- begin
- len:=length(lptr);
- if len>0 then
- intscandate(@lptr[1],len,pind+poffs);
- end;
- var lasttoken,lch : char;
- begin
- pind:=0; lasttoken:=' ';
- while (ind<=len) and (pind<plen) do
- begin
- lch:=upcase(ptrn[pind]);
- if activequote=#0 then
- begin
- if (lch='M') and (lasttoken='H') then
- begin
- i:=scanpatlen;
- if i>2 then
- raiseexception(format(Shhmmerror,[poffs+pind+1]));
- timeval:=timeval+scanfixedint(2)* minfactor;
- end
- else
- case lch of
- 'H': timeval:=timeval+scanfixedint(2)* hrfactor;
- 'D': begin
- i:=scanpatlen;
- case i of
- 1,2 : dd:=scanfixedint(2);
- 3 : dd:=findmatch(fmt.shortDayNames,s);
- 4 : dd:=findmatch(fmt.longDayNames,s);
- 5 : matchpattern(fmt.shortdateformat);
- 6 : matchpattern(fmt.longdateformat);
- end;
- end;
- 'N': timeval:=timeval+scanfixedint(2)* minfactor;
- 'S': timeval:=timeval+scanfixedint(2)* secfactor;
- 'Z': timeval:=timeval+scanfixedint(3)* mssecfactor;
- 'Y': begin
- i:=scanpatlen;
- yy:=scanfixedint(i);
- if i<=2 then
- begin
- pivot:=YearOf(now)-fmt.TwoDigitYearCenturyWindow;
- inc(yy, pivot div 100 * 100);
- if (fmt.TwoDigitYearCenturyWindow > 0) and (yy < pivot) then
- inc(yy, 100);
- end;
- end;
- 'M': begin
- i:=scanpatlen;
- case i of
- 1,2: mm:=scanfixedint(2);
- 3: mm:=findmatch(fmt.ShortMonthNames,s);
- 4: mm:=findmatch(fmt.LongMonthNames,s);
- end;
- end;
- 'T' : begin
- i:=scanpatlen;
- case i of
- 1: matchpattern(fmt.shortdateformat);
- 2: matchpattern(fmt.longtimeformat);
- end;
- end;
- 'A' : begin
- i:=findimatch(AMPMformatting,@ptrn[pind]);
- case i of
- 0: begin
- i:=findimatch(['AM','PM'],@s[ind]);
- case i of
- 0: ;
- 1: timeval:=timeval+12*hrfactor;
- else
- arraymatcherror
- end;
- inc(pind,length(AMPMformatting[0]));
- inc(ind,2);
- end;
- 1: begin
- case upcase(s[ind]) of
- 'A' : ;
- 'P' : timeval:=timeval+12*hrfactor;
- else
- arraymatcherror
- end;
- inc(pind,length(AMPMformatting[1]));
- inc(ind);
- end;
- 2: begin
- i:=findimatch([fmt.timeamstring,fmt.timepmstring],@s[ind]);
- case i of
- 0: inc(ind,length(fmt.timeamstring));
- 1: begin
- timeval:=timeval+12*hrfactor;
- inc(ind,length(fmt.timepmstring));
- end;
- else
- arraymatcherror
- end;
- inc(pind,length(AMPMformatting[2]));
- inc(pind,2);
- inc(ind,2);
- end;
- else // no AM/PM match. Assume 'a' is simply a char
- matchchar(ptrn[pind]);
- end;
- end;
- '/' : matchchar(fmt.dateSeparator);
- ':' : begin
- matchchar(fmt.TimeSeparator);
- lch:=lasttoken;
- end;
- #39,'"' : begin
- activequote:=lch;
- inc(pind);
- end;
- 'C' : begin
- intscandate(@fmt.shortdateformat[1],length(fmt.ShortDateFormat),pind+poffs);
- intscandate(@fmt.longtimeformat[1],length(fmt.longtimeformat),pind+poffs);
- inc(pind);
- end;
- '?' : begin
- inc(pind);
- inc(ind);
- end;
- #9 : begin
- while (ind<=len) and (s[ind] in whitespace) do
- inc(ind);
- inc(pind);
- end;
- else
- matchchar(ptrn[pind]);
- end; {case}
- lasttoken:=lch;
- end
- else
- begin
- if activequote=lch then
- begin
- activequote:=#0;
- inc(pind);
- end
- else
- matchchar(ptrn[pind]);
- end;
- end;
- if (pind<plen) and (plen>0) and (ptrn[plen-1]<>#9) then // allow omission of trailing whitespace
- RaiseException(format(SFullpattern,[poffs+pind+1]));
- end;
- var plen:integer;
- begin
- activequote:=#0;
- yy:=0; mm:=0; dd:=0;
- timeval:=0.0;
- len:=length(s); ind:=startpos;
- plen:=length(pattern);
- intscandate(@pattern[1],plen,0);
- result:=timeval;
- if (yy>0) and (mm>0) and (dd>0) then
- result:=result+encodedate(yy,mm,dd);
- end;
- function scandatetime(const pattern:string;const s:string;startpos:integer=1) : tdatetime; overload;
- begin
- result:=scandatetime(pattern,s,defaultformatsettings);
- end;
- end.
|