dateutil.inc 105 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574
  1. {$mode objfpc}
  2. {$h+}
  3. {$modeswitch typehelpers}
  4. {
  5. This file is part of the Free Pascal run time library.
  6. Copyright (c) 1999-2000 by the Free Pascal development team
  7. Delphi/Kylix compatibility unit, provides Date/Time handling routines.
  8. See the file COPYING.FPC, included in this distribution,
  9. for details about the copyright.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13. **********************************************************************}
  14. {$IFNDEF FPC_DOTTEDUNITS}
  15. unit DateUtils;
  16. {$ENDIF}
  17. interface
  18. {$ifndef FPUNONE}
  19. {$IFDEF FPC_DOTTEDUNITS}
  20. uses
  21. System.SysUtils, System.Math;
  22. {$ELSE}
  23. uses
  24. SysUtils, Math;
  25. {$ENDIF}
  26. { ---------------------------------------------------------------------
  27. Various constants
  28. ---------------------------------------------------------------------}
  29. const
  30. DaysPerWeek = 7;
  31. WeeksPerFortnight = 2;
  32. MonthsPerYear = 12;
  33. YearsPerDecade = 10;
  34. YearsPerCentury = 100;
  35. YearsPerMillennium = 1000;
  36. // ISO day numbers.
  37. DayMonday = 1;
  38. DayTuesday = 2;
  39. DayWednesday = 3;
  40. DayThursday = 4;
  41. DayFriday = 5;
  42. DaySaturday = 6;
  43. DaySunday = 7;
  44. MonthJanuary = 1;
  45. MonthFebruary = 2;
  46. MonthMarch = 3;
  47. MonthApril = 4;
  48. MonthMay = 5;
  49. MonthJune = 6;
  50. MonthJuly = 7;
  51. MonthAugust = 8;
  52. MonthSeptember = 9;
  53. MonthOctober = 10;
  54. MonthNovember = 11;
  55. MonthDecember = 12;
  56. // Fraction of a day
  57. OneHour = TDateTime(1)/HoursPerDay;
  58. OneMinute = TDateTime(1)/MinsPerDay;
  59. OneSecond = TDateTime(1)/SecsPerDay;
  60. OneMillisecond = TDateTime(1)/MSecsPerDay;
  61. { This is actual days per year but you need to know if it's a leap year}
  62. DaysPerYear: array [Boolean] of Word = (365, 366);
  63. { Used in RecodeDate, RecodeTime and RecodeDateTime for those datetime }
  64. { fields you want to leave alone }
  65. RecodeLeaveFieldAsIs = High(Word);
  66. { ---------------------------------------------------------------------
  67. Global variables used in this unit
  68. ---------------------------------------------------------------------}
  69. Const
  70. { Average over a 4 year span. Valid for next 100 years }
  71. ApproxDaysPerMonth: Double = 30.4375;
  72. ApproxDaysPerYear: Double = 365.25;
  73. { ---------------------------------------------------------------------
  74. Simple trimming functions.
  75. ---------------------------------------------------------------------}
  76. Function DateOf(const AValue: TDateTime): TDateTime;
  77. Function TimeOf(const AValue: TDateTime): TDateTime;
  78. { ---------------------------------------------------------------------
  79. Identification functions.
  80. ---------------------------------------------------------------------}
  81. Function IsInLeapYear(const AValue: TDateTime): Boolean;
  82. Function IsPM(const AValue: TDateTime): Boolean; inline;
  83. function IsAM(const AValue: TDateTime): Boolean; inline;
  84. Function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;
  85. Function IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
  86. Function IsValidDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
  87. Function IsValidDateDay(const AYear, ADayOfYear: Word): Boolean;
  88. Function IsValidDateWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): Boolean;
  89. Function IsValidDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): Boolean;
  90. { ---------------------------------------------------------------------
  91. Enumeration functions.
  92. ---------------------------------------------------------------------}
  93. Function WeeksInYear(const AValue: TDateTime): Word;
  94. Function WeeksInAYear(const AYear: Word): Word;
  95. Function DaysInYear(const AValue: TDateTime): Word;
  96. Function DaysInAYear(const AYear: Word): Word;
  97. Function DaysInMonth(const AValue: TDateTime): Word;
  98. Function DaysInAMonth(const AYear, AMonth: Word): Word;
  99. { ---------------------------------------------------------------------
  100. Variations on current date/time.
  101. ---------------------------------------------------------------------}
  102. Function Today: TDateTime;
  103. Function Yesterday: TDateTime;
  104. Function Tomorrow: TDateTime;
  105. Function IsToday(const AValue: TDateTime): Boolean;
  106. Function IsSameDay(const AValue, ABasis: TDateTime): Boolean;
  107. function IsSameMonth(const Avalue, ABasis: TDateTime): Boolean;
  108. Function PreviousDayOfWeek (DayOfWeek : Word) : Word;
  109. { ---------------------------------------------------------------------
  110. Extraction functions.
  111. ---------------------------------------------------------------------}
  112. Function YearOf(const AValue: TDateTime): Word;
  113. Function MonthOf(const AValue: TDateTime): Word;
  114. Function WeekOf(const AValue: TDateTime): Word;
  115. Function DayOf(const AValue: TDateTime): Word;
  116. Function HourOf(const AValue: TDateTime): Word;
  117. Function MinuteOf(const AValue: TDateTime): Word;
  118. Function SecondOf(const AValue: TDateTime): Word;
  119. Function MilliSecondOf(const AValue: TDateTime): Word;
  120. { ---------------------------------------------------------------------
  121. Start/End of year functions.
  122. ---------------------------------------------------------------------}
  123. Function StartOfTheYear(const AValue: TDateTime): TDateTime;
  124. Function EndOfTheYear(const AValue: TDateTime): TDateTime;
  125. Function StartOfAYear(const AYear: Word): TDateTime;
  126. Function EndOfAYear(const AYear: Word): TDateTime;
  127. { ---------------------------------------------------------------------
  128. Start/End of month functions.
  129. ---------------------------------------------------------------------}
  130. Function StartOfTheMonth(const AValue: TDateTime): TDateTime;
  131. Function EndOfTheMonth(const AValue: TDateTime): TDateTime;
  132. Function StartOfAMonth(const AYear, AMonth: Word): TDateTime;
  133. Function EndOfAMonth(const AYear, AMonth: Word): TDateTime;
  134. { ---------------------------------------------------------------------
  135. Start/End of week functions.
  136. ---------------------------------------------------------------------}
  137. Function StartOfTheWeek(const AValue: TDateTime): TDateTime;
  138. Function EndOfTheWeek(const AValue: TDateTime): TDateTime;
  139. Function StartOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  140. Function StartOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // ADayOFWeek 1
  141. Function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  142. Function EndOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // const ADayOfWeek: Word = 7
  143. { ---------------------------------------------------------------------
  144. Start/End of day functions.
  145. ---------------------------------------------------------------------}
  146. Function StartOfTheDay(const AValue: TDateTime): TDateTime;
  147. Function EndOfTheDay(const AValue: TDateTime): TDateTime;
  148. Function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime; overload;
  149. Function StartOfADay(const AYear, ADayOfYear: Word): TDateTime; overload;
  150. Function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime; overload;
  151. Function EndOfADay(const AYear, ADayOfYear: Word): TDateTime; overload;
  152. { ---------------------------------------------------------------------
  153. Part of year functions.
  154. ---------------------------------------------------------------------}
  155. Function MonthOfTheYear(const AValue: TDateTime): Word;
  156. Function WeekOfTheYear(const AValue: TDateTime): Word; overload;
  157. Function WeekOfTheYear(const AValue: TDateTime; out AYear: Word): Word; overload;
  158. Function DayOfTheYear(const AValue: TDateTime): Word;
  159. Function HourOfTheYear(const AValue: TDateTime): Word;
  160. Function MinuteOfTheYear(const AValue: TDateTime): LongWord;
  161. Function SecondOfTheYear(const AValue: TDateTime): LongWord;
  162. Function MilliSecondOfTheYear(const AValue: TDateTime): Int64;
  163. { ---------------------------------------------------------------------
  164. Part of month functions.
  165. ---------------------------------------------------------------------}
  166. Function WeekOfTheMonth(const AValue: TDateTime): Word; overload;
  167. Function WeekOfTheMonth(const AValue: TDateTime; out AYear, AMonth: Word): Word; overload;
  168. Function DayOfTheMonth(const AValue: TDateTime): Word;
  169. Function HourOfTheMonth(const AValue: TDateTime): Word;
  170. Function MinuteOfTheMonth(const AValue: TDateTime): Word;
  171. Function SecondOfTheMonth(const AValue: TDateTime): LongWord;
  172. Function MilliSecondOfTheMonth(const AValue: TDateTime): LongWord;
  173. { ---------------------------------------------------------------------
  174. Part of week functions.
  175. ---------------------------------------------------------------------}
  176. Function DayOfTheWeek(const AValue: TDateTime): Word;
  177. Function HourOfTheWeek(const AValue: TDateTime): Word;
  178. Function MinuteOfTheWeek(const AValue: TDateTime): Word;
  179. Function SecondOfTheWeek(const AValue: TDateTime): LongWord;
  180. Function MilliSecondOfTheWeek(const AValue: TDateTime): LongWord;
  181. { ---------------------------------------------------------------------
  182. Part of day functions.
  183. ---------------------------------------------------------------------}
  184. Function HourOfTheDay(const AValue: TDateTime): Word;
  185. Function MinuteOfTheDay(const AValue: TDateTime): Word;
  186. Function SecondOfTheDay(const AValue: TDateTime): LongWord;
  187. Function MilliSecondOfTheDay(const AValue: TDateTime): LongWord;
  188. { ---------------------------------------------------------------------
  189. Part of hour functions.
  190. ---------------------------------------------------------------------}
  191. Function MinuteOfTheHour(const AValue: TDateTime): Word;
  192. Function SecondOfTheHour(const AValue: TDateTime): Word;
  193. Function MilliSecondOfTheHour(const AValue: TDateTime): LongWord;
  194. { ---------------------------------------------------------------------
  195. Part of minute functions.
  196. ---------------------------------------------------------------------}
  197. Function SecondOfTheMinute(const AValue: TDateTime): Word;
  198. Function MilliSecondOfTheMinute(const AValue: TDateTime): LongWord;
  199. { ---------------------------------------------------------------------
  200. Part of second functions.
  201. ---------------------------------------------------------------------}
  202. Function MilliSecondOfTheSecond(const AValue: TDateTime): Word;
  203. { ---------------------------------------------------------------------
  204. Range checking functions.
  205. ---------------------------------------------------------------------}
  206. Function WithinPastYears(const ANow, AThen: TDateTime; const AYears: Integer): Boolean;
  207. Function WithinPastMonths(const ANow, AThen: TDateTime; const AMonths: Integer): Boolean;
  208. Function WithinPastWeeks(const ANow, AThen: TDateTime; const AWeeks: Integer): Boolean;
  209. Function WithinPastDays(const ANow, AThen: TDateTime; const ADays: Integer): Boolean;
  210. Function WithinPastHours(const ANow, AThen: TDateTime; const AHours: Int64): Boolean;
  211. Function WithinPastMinutes(const ANow, AThen: TDateTime; const AMinutes: Int64): Boolean;
  212. Function WithinPastSeconds(const ANow, AThen: TDateTime; const ASeconds: Int64): Boolean;
  213. Function WithinPastMilliSeconds(const ANow, AThen: TDateTime; const AMilliSeconds: Int64): Boolean;
  214. { ---------------------------------------------------------------------
  215. Period functions.
  216. ---------------------------------------------------------------------}
  217. Function YearsBetween(const ANow, AThen: TDateTime; AExact : Boolean = False): Integer;
  218. Function MonthsBetween(const ANow, AThen: TDateTime; AExact : Boolean = False): Integer;
  219. Function WeeksBetween(const ANow, AThen: TDateTime): Integer;
  220. Function DaysBetween(const ANow, AThen: TDateTime): Integer;
  221. Function HoursBetween(const ANow, AThen: TDateTime): Int64;
  222. Function MinutesBetween(const ANow, AThen: TDateTime): Int64;
  223. Function SecondsBetween(const ANow, AThen: TDateTime): Int64;
  224. Function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;
  225. Procedure PeriodBetween(const ANow, AThen: TDateTime; Out Years, months, days : Word);
  226. { ---------------------------------------------------------------------
  227. Timespan in xxx functions.
  228. ---------------------------------------------------------------------}
  229. { YearSpan and MonthSpan are approximate values }
  230. Function YearSpan(const ANow, AThen: TDateTime): Double;
  231. Function MonthSpan(const ANow, AThen: TDateTime): Double;
  232. Function WeekSpan(const ANow, AThen: TDateTime): Double;
  233. Function DaySpan(const ANow, AThen: TDateTime): Double;
  234. Function HourSpan(const ANow, AThen: TDateTime): Double;
  235. Function MinuteSpan(const ANow, AThen: TDateTime): Double;
  236. Function SecondSpan(const ANow, AThen: TDateTime): Double;
  237. Function MilliSecondSpan(const ANow, AThen: TDateTime): Double;
  238. { ---------------------------------------------------------------------
  239. Increment/decrement functions.
  240. ---------------------------------------------------------------------}
  241. Function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer ): TDateTime;
  242. Function IncYear(const AValue: TDateTime): TDateTime; // ; const ANumberOfYears: Integer = 1)
  243. // Function IncMonth is in SysUtils
  244. Function IncWeek(const AValue: TDateTime; const ANumberOfWeeks: Integer): TDateTime;
  245. Function IncWeek(const AValue: TDateTime): TDateTime; // ; const ANumberOfWeeks: Integer = 1)
  246. Function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer): TDateTime;
  247. Function IncDay(const AValue: TDateTime): TDateTime; //; const ANumberOfDays: Integer = 1)
  248. Function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;
  249. Function IncHour(const AValue: TDateTime): TDateTime; //; const ANumberOfHours: Int64 = 1
  250. Function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;
  251. Function IncMinute(const AValue: TDateTime): TDateTime; // ; const ANumberOfMinutes: Int64 = 1
  252. Function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64): TDateTime;
  253. Function IncSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfSeconds: Int64 = 1
  254. Function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64): TDateTime;
  255. Function IncMilliSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfMilliSeconds: Int64 = 1
  256. { ---------------------------------------------------------------------
  257. Encode/Decode of complete timestamp
  258. ---------------------------------------------------------------------}
  259. Function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  260. Procedure DecodeDateTime(const AValue: TDateTime; out AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);
  261. Function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; out AValue: TDateTime): Boolean;
  262. { ---------------------------------------------------------------------
  263. Encode/decode date, specifying week of year and day of week
  264. ---------------------------------------------------------------------}
  265. Function EncodeDateWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  266. Function EncodeDateWeek(const AYear, AWeekOfYear: Word): TDateTime; //; const ADayOfWeek: Word = 1
  267. Procedure DecodeDateWeek(const AValue: TDateTime; out AYear, AWeekOfYear, ADayOfWeek: Word);
  268. Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; out AValue: TDateTime; const ADayOfWeek: Word): Boolean;
  269. Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; out AValue: TDateTime): Boolean; //; const ADayOfWeek: Word = 1
  270. { ---------------------------------------------------------------------
  271. Encode/decode date, specifying day of year
  272. ---------------------------------------------------------------------}
  273. Function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;
  274. Procedure DecodeDateDay(const AValue: TDateTime; out AYear, ADayOfYear: Word);
  275. Function TryEncodeDateDay(const AYear, ADayOfYear: Word; out AValue: TDateTime): Boolean;
  276. { ---------------------------------------------------------------------
  277. Encode/decode date, specifying week of month
  278. ---------------------------------------------------------------------}
  279. Function EncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): TDateTime;
  280. Procedure DecodeDateMonthWeek(const AValue: TDateTime; out AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
  281. Function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word; out AValue: TDateTime): Boolean;
  282. { ---------------------------------------------------------------------
  283. Encode time interval, allowing hours>24
  284. ---------------------------------------------------------------------}
  285. function TryEncodeTimeInterval(Hour, Min, Sec, MSec:word; Out Time : TDateTime) : boolean;
  286. function EncodeTimeInterval(Hour, Minute, Second, MilliSecond:word): TDateTime;
  287. { ---------------------------------------------------------------------
  288. Replace given element with supplied value.
  289. ---------------------------------------------------------------------}
  290. Function RecodeYear(const AValue: TDateTime; const AYear: Word): TDateTime;
  291. Function RecodeMonth(const AValue: TDateTime; const AMonth: Word): TDateTime;
  292. Function RecodeDay(const AValue: TDateTime; const ADay: Word): TDateTime;
  293. Function RecodeHour(const AValue: TDateTime; const AHour: Word): TDateTime;
  294. Function RecodeMinute(const AValue: TDateTime; const AMinute: Word): TDateTime;
  295. Function RecodeSecond(const AValue: TDateTime; const ASecond: Word): TDateTime;
  296. Function RecodeMilliSecond(const AValue: TDateTime; const AMilliSecond: Word): TDateTime;
  297. Function RecodeDate(const AValue: TDateTime; const AYear, AMonth, ADay: Word): TDateTime;
  298. Function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  299. Function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  300. Function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; out AResult: TDateTime): Boolean;
  301. { ---------------------------------------------------------------------
  302. Comparision of date/time
  303. ---------------------------------------------------------------------}
  304. Function CompareDateTime(const A, B: TDateTime): TValueRelationship;
  305. Function CompareDate(const A, B: TDateTime): TValueRelationship;
  306. Function CompareTime(const A, B: TDateTime): TValueRelationship;
  307. Function SameDateTime(const A, B: TDateTime): Boolean;
  308. Function SameDate(const A, B: TDateTime): Boolean;
  309. Function SameTime(const A, B: TDateTime): Boolean;
  310. function DateTimeInRange(ADateTime: TDateTime; AStartDateTime, AEndDateTime: TDateTime; aInclusive: Boolean = True): Boolean;
  311. function TimeInRange(ATime: TTime; AStartTime, AEndTime: TTime; AInclusive: Boolean = True): Boolean;
  312. function DateInRange(ADate: TDate; AStartDate, AEndDate: TDate; AInclusive: Boolean = True): Boolean;
  313. { For a given date these Functions tell you the which day of the week of the
  314. month (or year). If its a Thursday, they will tell you if its the first,
  315. second, etc Thursday of the month (or year). Remember, even though its
  316. the first Thursday of the year it doesn't mean its the first week of the
  317. year. See ISO 8601 above for more information. }
  318. Function NthDayOfWeek(const AValue: TDateTime): Word;
  319. Procedure DecodeDayOfWeekInMonth(const AValue: TDateTime; out AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
  320. Function EncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word): TDateTime;
  321. Function TryEncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word; out AValue: TDateTime): Boolean;
  322. { ---------------------------------------------------------------------
  323. Exception throwing routines
  324. ---------------------------------------------------------------------}
  325. Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
  326. Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word); // const ABaseDate: TDateTime = 0
  327. Procedure InvalidDateWeekError(const AYear, AWeekOfYear, ADayOfWeek: Word);
  328. Procedure InvalidDateDayError(const AYear, ADayOfYear: Word);
  329. Procedure InvalidDateMonthWeekError(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
  330. Procedure InvalidDayOfWeekInMonthError(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
  331. { ---------------------------------------------------------------------
  332. Julian and Modified Julian Date conversion support
  333. ---------------------------------------------------------------------}
  334. Function DateTimeToJulianDate(const AValue: TDateTime): Double;
  335. Function JulianDateToDateTime(const AValue: Double): TDateTime;
  336. Function TryJulianDateToDateTime(const AValue: Double; out ADateTime: TDateTime): Boolean;
  337. Function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
  338. Function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
  339. Function TryModifiedJulianDateToDateTime(const AValue: Double; out ADateTime: TDateTime): Boolean;
  340. { ---------------------------------------------------------------------
  341. Unix timestamp support.
  342. ---------------------------------------------------------------------}
  343. Function DateTimeToUnix(const AValue: TDateTime; AInputIsUTC: Boolean = True): Int64;
  344. Function UnixToDateTime(const AValue: Int64; aReturnUTC : Boolean = true): TDateTime;
  345. Function UnixTimeStampToMac(const AValue: Int64): Int64;
  346. { ---------------------------------------------------------------------
  347. Mac timestamp support.
  348. ---------------------------------------------------------------------}
  349. Function DateTimeToMac(const AValue: TDateTime): Int64;
  350. Function MacToDateTime(const AValue: Int64): TDateTime;
  351. Function MacTimeStampToUnix(const AValue: Int64): Int64;
  352. { .....................................................................
  353. Dos <-> Delphi datetime support
  354. .....................................................................}
  355. Function DateTimeToDosDateTime(const AValue: TDateTime): longint;
  356. Function DosDateTimeToDateTime( AValue: longint): TDateTime;
  357. { UTC <-> Local time }
  358. Function UniversalTimeToLocal(UT: TDateTime): TDateTime;
  359. Function UniversalTimeToLocal(UT: TDateTime; TZOffset : Integer): TDateTime;
  360. Function LocalTimeToUniversal(LT: TDateTime): TDateTime;
  361. Function LocalTimeToUniversal(LT: TDateTime; TZOffset: Integer): TDateTime;
  362. { ScanDateTime is a limited inverse of formatdatetime }
  363. function ScanDateTime(const Pattern:String;const s:string;const fmt:TFormatSettings;startpos:integer=1) : tdatetime; overload;
  364. function ScanDateTime(const Pattern:string;const s:string;startpos:integer=1) : tdatetime; overload;
  365. // ISO date/time
  366. // YYYYMMDD or YYYY-MM-DD
  367. function TryISOStrToDate(const aString: string; out outDate: TDateTime): Boolean;
  368. // HH HH:NN HH:NN:SS HH:NN:SS.ZZZ or HHNN HHNNSS HHNNSS.ZZZ
  369. function TryISOStrToTime(const aString: string; Out outTime: TDateTime): Boolean;
  370. // Combination of previous
  371. function TryISOStrToDateTime(const aString: string; out outDateTime: TDateTime): Boolean;
  372. // Z +hh:nn -hh:nn
  373. Function TryISOTZStrToTZOffset(const TZ : String; Out TZOffset : Integer) : boolean;
  374. // ISO 8601 Date/Time formatting
  375. function DateToISO8601(const ADate: TDateTime; AInputIsUTC: Boolean = True): string;
  376. Function ISO8601ToDate(const DateString: string; ReturnUTC : Boolean = True): TDateTime;
  377. Function ISO8601ToDateDef(const DateString: string; ReturnUTC : Boolean; aDefault : TDateTime ): TDateTime; deprecated;
  378. Function ISO8601ToDateDef(const DateString: string; aDefault : TDateTime; ReturnUTC : Boolean = True ): TDateTime;
  379. Function TryISO8601ToDate(const DateString: string; out ADateTime: TDateTime; ReturnUTC : Boolean = True) : Boolean;
  380. type
  381. // Original code by Colin Johnsun, used with permission under FPC license.
  382. // See https://gitlab.com/freepascal.org/fpc/source/-/issues/40097
  383. TDateTimeHelper = type helper for TDateTime
  384. private
  385. function GetDay: Word; inline;
  386. function GetDate: TDateTime; inline;
  387. function GetDayOfWeek: Word; inline;
  388. function GetDayOfYear: Word; inline;
  389. function GetHour: Word; inline;
  390. function GetMillisecond: Word; inline;
  391. function GetMinute: Word; inline;
  392. function GetMonth: Word; inline;
  393. function GetSecond: Word; inline;
  394. function GetTime: TDateTime; inline;
  395. function GetYear: Word; inline;
  396. class function GetNow: TDateTime; static; inline;
  397. class function GetToday: TDateTime; static; inline;
  398. class function GetTomorrow: TDateTime; static; inline;
  399. class function GetYesterDay: TDateTime; static; inline;
  400. function GetUnixTime: Int64;
  401. function GetTotalSecounds: Int64;
  402. // Parse a string as TDateTime, using a string format ex.('MM/dd/yyyy hh:mm:ss')
  403. class function Parse(Date: string; aFormat: string = ''; aDateSeparator:
  404. Char = #0; aTimeSeparator: Char = #0): TDateTime; static; inline;
  405. // Parse a string as TDateTime, using local string ex. ('en-US')
  406. class function ParseLocal(Date: string; local: string = ''): TDateTime;
  407. static; inline;
  408. public
  409. class function Create(const aYear, aMonth, aDay: Word): TDateTime; overload;
  410. static; inline;
  411. class function Create(const aYear, aMonth, aDay, aHour, aMinute, aSecond,
  412. aMillisecond: Word): TDateTime; overload; static; inline;
  413. class function Create(Date: string; aFormat: string = ''; aDateSeparator:
  414. Char = #0; aTimeSeparator: Char = #0): TDateTime; overload; static; inline;
  415. class function CreateLocal(Date: string; local: string = ''): TDateTime;
  416. static; inline;
  417. class function CreateUnixTime(const Value: Int64): TDateTime; static; inline;
  418. class function CreateTotalSeconds(const Value: Int64): TDateTime; static; inline;
  419. class property Now: TDateTime read GetNow;
  420. class property Today: TDateTime read GetToday;
  421. class property Yesterday: TDateTime read GetYesterDay;
  422. class property Tomorrow: TDateTime read GetTomorrow;
  423. property Date: TDateTime read GetDate;
  424. property Time: TDateTime read GetTime;
  425. property DayOfWeek: Word read GetDayOfWeek;
  426. property DayOfYear: Word read GetDayOfYear;
  427. property Year: Word read GetYear;
  428. property Month: Word read GetMonth;
  429. property Day: Word read GetDay;
  430. property Hour: Word read GetHour;
  431. property Minute: Word read GetMinute;
  432. property Second: Word read GetSecond;
  433. property Millisecond: Word read GetMillisecond;
  434. property UnixTime: Int64 read GetUnixTime;
  435. property TotalSeconds: Int64 read GetTotalSecounds;
  436. function ToString(const aFormatStr: string = ''): string; inline;
  437. function StartOfYear: TDateTime; inline;
  438. function EndOfYear: TDateTime; inline;
  439. function StartOfMonth: TDateTime; inline;
  440. function EndOfMonth: TDateTime; inline;
  441. function StartOfWeek: TDateTime; inline;
  442. function EndOfWeek: TDateTime; inline;
  443. function StartOfDay: TDateTime; inline;
  444. function EndOfDay: TDateTime; inline;
  445. function AddYears(const aNumberOfYears: Integer = 1): TDateTime; inline;
  446. function AddMonths(const aNumberOfMonths: Integer = 1): TDateTime; inline;
  447. function AddDays(const aNumberOfDays: Integer = 1): TDateTime; inline;
  448. function AddHours(const aNumberOfHours: Int64 = 1): TDateTime; inline;
  449. function AddMinutes(const aNumberOfMinutes: Int64 = 1): TDateTime; inline;
  450. function AddSeconds(const aNumberOfSeconds: Int64 = 1): TDateTime; inline;
  451. function AddMilliseconds(const aNumberOfMilliseconds: Int64 = 1): TDateTime; inline;
  452. function CompareTo(const aDateTime: TDateTime): TValueRelationship; inline;
  453. function Equals(const aDateTime: TDateTime): Boolean; inline;
  454. function IsSameDay(const aDateTime: TDateTime): Boolean; inline;
  455. function InRange(const aStartDateTime, aEndDateTime: TDateTime; const
  456. aInclusive: Boolean = True): Boolean; inline;
  457. function IsInLeapYear: Boolean; inline;
  458. function IsToday: Boolean; inline;
  459. function IsAM: Boolean; inline;
  460. function IsPM: Boolean; inline;
  461. function YearsBetween(const aDateTime: TDateTime): Integer; inline;
  462. function MonthsBetween(const aDateTime: TDateTime): Integer; inline;
  463. function WeeksBetween(const aDateTime: TDateTime): Integer; inline;
  464. function DaysBetween(const aDateTime: TDateTime): Integer; inline;
  465. function HoursBetween(const aDateTime: TDateTime): Int64; inline;
  466. function MinutesBetween(const aDateTime: TDateTime): Int64; inline;
  467. function SecondsBetween(const aDateTime: TDateTime): Int64; inline;
  468. function MilliSecondsBetween(const aDateTime: TDateTime): Int64; inline;
  469. function WithinYears(const aDateTime: TDateTime; const aYears: Integer):
  470. Boolean; inline;
  471. function WithinMonths(const aDateTime: TDateTime; const aMonths: Integer):
  472. Boolean; inline;
  473. function WithinWeeks(const aDateTime: TDateTime; const aWeeks: Integer):
  474. Boolean; inline;
  475. function WithinDays(const aDateTime: TDateTime; const aDays: Integer):
  476. Boolean; inline;
  477. function WithinHours(const aDateTime: TDateTime; const aHours: Int64):
  478. Boolean; inline;
  479. function WithinMinutes(const aDateTime: TDateTime; const aMinutes: Int64):
  480. Boolean; inline;
  481. function WithinSeconds(const aDateTime: TDateTime; const aSeconds: Int64):
  482. Boolean; inline;
  483. function WithinMilliseconds(const aDateTime: TDateTime; const AMilliseconds:
  484. Int64): Boolean; inline;
  485. end;
  486. implementation
  487. {$IFDEF FPC_DOTTEDUNITS}
  488. uses System.SysConst;
  489. {$ELSE FPC_DOTTEDUNITS}
  490. uses sysconst;
  491. {$ENDIF FPC_DOTTEDUNITS}
  492. const
  493. TDateTimeEpsilon = 2.2204460493e-16;
  494. HalfMilliSecond = OneMillisecond /2 ;
  495. { ---------------------------------------------------------------------
  496. Auxiliary routines
  497. ---------------------------------------------------------------------}
  498. Procedure NotYetImplemented (FN : String);
  499. begin
  500. Raise Exception.CreateFmt('Function "%s" (dateutils) is not yet implemented',[FN]);
  501. end;
  502. { ---------------------------------------------------------------------
  503. Simple trimming functions.
  504. ---------------------------------------------------------------------}
  505. Function DateOf(const AValue: TDateTime): TDateTime; inline;
  506. begin
  507. Result:=Trunc(AValue);
  508. end;
  509. Function TimeOf(const AValue: TDateTime): TDateTime; inline;
  510. begin
  511. Result:=Frac(Avalue);
  512. end;
  513. { ---------------------------------------------------------------------
  514. Identification functions.
  515. ---------------------------------------------------------------------}
  516. Function IsInLeapYear(const AValue: TDateTime): Boolean;
  517. begin
  518. Result:=IsLeapYear(YearOf(AValue));
  519. end;
  520. Function IsPM(const AValue: TDateTime): Boolean; inline;
  521. begin
  522. Result:=(HourOf(AValue)>=12);
  523. end;
  524. Function IsAM(const AValue: TDateTime): Boolean; inline;
  525. begin
  526. Result:=(HourOf(AValue)<12);
  527. end;
  528. Function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;
  529. begin
  530. Result:=(AYear<>0) and (AYear<10000)
  531. and (AMonth in [1..12])
  532. and (ADay<>0) and (ADay<=MonthDays[IsleapYear(AYear),AMonth]);
  533. end;
  534. Function IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
  535. begin
  536. Result:=(AHour=HoursPerDay) and (AMinute=0) and (ASecond=0) and (AMillisecond=0);
  537. Result:=Result or
  538. ((AHour<HoursPerDay) and (AMinute<MinsPerHour) and (ASecond<SecsPerMin) and
  539. (AMillisecond<MSecsPerSec));
  540. end;
  541. Function IsValidDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
  542. begin
  543. Result:=IsValidDate(AYear,AMonth,ADay) and
  544. IsValidTime(AHour,AMinute,ASecond,AMillisecond)
  545. end;
  546. Function IsValidDateDay(const AYear, ADayOfYear: Word): Boolean;
  547. begin
  548. Result:=(AYear<>0) and (ADayOfYear<>0) and (AYear<10000) and
  549. (ADayOfYear<=DaysPerYear[IsLeapYear(AYear)]);
  550. end;
  551. Function IsValidDateWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): Boolean;
  552. begin
  553. Result:=(AYear<>0) and (AYear<10000)
  554. and (ADayOfWeek in [1..7])
  555. and (AWeekOfYear<>0)
  556. and (AWeekOfYear<=WeeksInaYear(AYear));
  557. { should we not also check whether the day of the week is not
  558. larger than the last day of the last week in the year 9999 ?? }
  559. end;
  560. Function IsValidDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): Boolean;
  561. begin
  562. Result:=(AYear<>0) and (AYear<10000)
  563. and (AMonth in [1..12])
  564. and (AWeekOfMonth in [1..5])
  565. and (ADayOfWeek in [1..7]);
  566. end;
  567. { ---------------------------------------------------------------------
  568. Enumeration functions.
  569. ---------------------------------------------------------------------}
  570. Function WeeksInYear(const AValue: TDateTime): Word;
  571. begin
  572. Result:=WeeksInAYear(YearOf(AValue));
  573. end;
  574. Function WeeksInAYear(const AYear: Word): Word;
  575. Var
  576. DOW : Word;
  577. begin
  578. Result:=52;
  579. DOW:=DayOfTheWeek(StartOfAYear(AYear));
  580. If (DOW=4) or ((DOW=3) and IsLeapYear(AYear)) then
  581. Inc(Result);
  582. end;
  583. Function DaysInYear(const AValue: TDateTime): Word;
  584. begin
  585. Result:=DaysPerYear[IsLeapYear(YearOf(AValue))];
  586. end;
  587. Function DaysInAYear(const AYear: Word): Word;
  588. begin
  589. Result:=DaysPerYear[Isleapyear(AYear)];
  590. end;
  591. Function DaysInMonth(const AValue: TDateTime): Word;
  592. Var
  593. Y,M,D : Word;
  594. begin
  595. Decodedate(AValue,Y,M,D);
  596. Result:=MonthDays[IsLeapYear(Y),M];
  597. end;
  598. Function DaysInAMonth(const AYear, AMonth: Word): Word;
  599. begin
  600. Result:=MonthDays[IsLeapYear(AYear),AMonth];
  601. end;
  602. { ---------------------------------------------------------------------
  603. Variations on current date/time.
  604. ---------------------------------------------------------------------}
  605. Function Today: TDateTime; inline;
  606. begin
  607. Result:=Date();
  608. end;
  609. Function Yesterday: TDateTime;
  610. begin
  611. Result:=Date()-1;
  612. end;
  613. Function Tomorrow: TDateTime;
  614. begin
  615. Result:=Date()+1;
  616. end;
  617. Function IsToday(const AValue: TDateTime): Boolean;
  618. begin
  619. Result:=IsSameDay(AValue,Date());
  620. end;
  621. Function IsSameDay(const AValue, ABasis: TDateTime): Boolean;
  622. Var
  623. D : TDateTime;
  624. begin
  625. D:=AValue-Trunc(ABasis);
  626. Result:=(D>=0) and (D<1);
  627. end;
  628. function IsSameMonth(const Avalue, ABasis: TDateTime): Boolean;
  629. begin
  630. result:=( YearOf(Avalue) = YearOf(Abasis) );
  631. result:=result and ( MonthOf(AValue) = MonthOf(ABasis) );
  632. end;
  633. const
  634. DOWMap: array [1..7] of Word = (7, 1, 2, 3, 4, 5, 6);
  635. Function PreviousDayOfWeek (DayOfWeek : Word) : Word;
  636. begin
  637. If Not (DayOfWeek in [1..7]) then
  638. Raise EConvertError.CreateFmt(SErrInvalidDayOfWeek,[DayOfWeek]);
  639. Result:=DOWMap[DayOfWeek];
  640. end;
  641. { ---------------------------------------------------------------------
  642. Extraction functions.
  643. ---------------------------------------------------------------------}
  644. Function YearOf(const AValue: TDateTime): Word;
  645. Var
  646. D,M : Word;
  647. begin
  648. DecodeDate(AValue,Result,D,M);
  649. end;
  650. Function MonthOf(const AValue: TDateTime): Word;
  651. Var
  652. Y,D : Word;
  653. begin
  654. DecodeDate(AValue,Y,Result,D);
  655. end;
  656. Function WeekOf(const AValue: TDateTime): Word; inline;
  657. begin
  658. Result:=WeekOfTheYear(AValue);
  659. end;
  660. Function DayOf(const AValue: TDateTime): Word;
  661. Var
  662. Y,M : Word;
  663. begin
  664. DecodeDate(AValue,Y,M,Result);
  665. end;
  666. Function HourOf(const AValue: TDateTime): Word;
  667. Var
  668. N,S,MS : Word;
  669. begin
  670. DecodeTime(AValue,Result,N,S,MS);
  671. end;
  672. Function MinuteOf(const AValue: TDateTime): Word;
  673. Var
  674. H,S,MS : Word;
  675. begin
  676. DecodeTime(AValue,H,Result,S,MS);
  677. end;
  678. Function SecondOf(const AValue: TDateTime): Word;
  679. Var
  680. H,N,MS : Word;
  681. begin
  682. DecodeTime(AValue,H,N,Result,MS);
  683. end;
  684. Function MilliSecondOf(const AValue: TDateTime): Word;
  685. Var
  686. H,N,S : Word;
  687. begin
  688. DecodeTime(AValue,H,N,S,Result);
  689. end;
  690. { ---------------------------------------------------------------------
  691. Start/End of year functions.
  692. ---------------------------------------------------------------------}
  693. Function StartOfTheYear(const AValue: TDateTime): TDateTime;
  694. begin
  695. Result:=EncodeDate(YearOf(AValue),1,1);
  696. end;
  697. Function EndOfTheYear(const AValue: TDateTime): TDateTime;
  698. begin
  699. Result:=EncodeDateTime(YearOf(AValue),12,31,23,59,59,999);
  700. end;
  701. Function StartOfAYear(const AYear: Word): TDateTime;
  702. begin
  703. Result:=EncodeDate(AYear,1,1);
  704. end;
  705. Function EndOfAYear(const AYear: Word): TDateTime;
  706. begin
  707. Result:=(EncodeDateTime(AYear,12,31,23,59,59,999));
  708. end;
  709. { ---------------------------------------------------------------------
  710. Start/End of month functions.
  711. ---------------------------------------------------------------------}
  712. Function StartOfTheMonth(const AValue: TDateTime): TDateTime;
  713. Var
  714. Y,M,D : Word;
  715. begin
  716. DecodeDate(AValue,Y,M,D);
  717. Result:=EncodeDate(Y,M,1);
  718. // MonthDays[IsLeapYear(Y),M])
  719. end;
  720. Function EndOfTheMonth(const AValue: TDateTime): TDateTime;
  721. Var
  722. Y,M,D : Word;
  723. begin
  724. DecodeDate(AValue,Y,M,D);
  725. Result:=EncodeDateTime(Y,M,MonthDays[IsLeapYear(Y),M],23,59,59,999);
  726. end;
  727. Function StartOfAMonth(const AYear, AMonth: Word): TDateTime; inline;
  728. begin
  729. Result:=EncodeDate(AYear,AMonth,1);
  730. end;
  731. Function EndOfAMonth(const AYear, AMonth: Word): TDateTime;
  732. begin
  733. Result:=EncodeDateTime(AYear,AMonth,MonthDays[IsLeapYear(AYear),AMonth],23,59,59,999);
  734. end;
  735. { ---------------------------------------------------------------------
  736. Start/End of week functions.
  737. ---------------------------------------------------------------------}
  738. Function StartOfTheWeek(const AValue: TDateTime): TDateTime;
  739. begin
  740. Result:=Trunc(AValue)-DayOfTheWeek(AValue)+1;
  741. end;
  742. Function EndOfTheWeek(const AValue: TDateTime): TDateTime;
  743. begin
  744. Result:=EndOfTheDay(AValue-DayOfTheWeek(AValue)+7);
  745. end;
  746. Function StartOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  747. begin
  748. Result:=EncodeDateWeek(AYear,AWeekOfYear,ADayOfWeek);
  749. end;
  750. Function StartOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; inline; // ADayOFWeek 1
  751. begin
  752. Result:=StartOfAWeek(AYear,AWeekOfYear,1)
  753. end;
  754. Function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime; inline;
  755. begin
  756. Result := EndOfTheDay(EncodeDateWeek(AYear, AWeekOfYear, ADayOfWeek));
  757. end;
  758. Function EndOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // const ADayOfWeek: Word = 7
  759. begin
  760. Result:=EndOfAWeek(AYear,AWeekOfYear,7);
  761. end;
  762. { ---------------------------------------------------------------------
  763. Start/End of day functions.
  764. ---------------------------------------------------------------------}
  765. Function StartOfTheDay(const AValue: TDateTime): TDateTime; inline;
  766. begin
  767. StartOfTheDay:=Trunc(Avalue);
  768. end;
  769. Function EndOfTheDay(const AValue: TDateTime): TDateTime;
  770. Var
  771. Y,M,D : Word;
  772. begin
  773. DecodeDate(AValue,Y,M,D);
  774. Result:=EncodeDateTime(Y,M,D,23,59,59,999);
  775. end;
  776. Function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime; inline;
  777. begin
  778. Result:=EncodeDate(AYear,AMonth,ADay);
  779. end;
  780. Function StartOfADay(const AYear, ADayOfYear: Word): TDateTime;
  781. begin
  782. Result:=StartOfAYear(AYear)+ADayOfYear-1;
  783. end;
  784. Function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime; inline;
  785. begin
  786. Result:=EndOfTheDay(EncodeDate(AYear,AMonth,ADay));
  787. end;
  788. Function EndOfADay(const AYear, ADayOfYear: Word): TDateTime;
  789. begin
  790. Result:=StartOfAYear(AYear)+ADayOfYear-1+EncodeTime(23,59,59,999);
  791. end;
  792. { ---------------------------------------------------------------------
  793. Part of year functions.
  794. ---------------------------------------------------------------------}
  795. Function MonthOfTheYear(const AValue: TDateTime): Word; inline;
  796. begin
  797. Result:=MonthOf(AValue);
  798. end;
  799. Function WeekOfTheYear(const AValue: TDateTime): Word;
  800. Var
  801. Y,DOW : Word;
  802. begin
  803. DecodeDateWeek(AValue,Y,Result,DOW)
  804. end;
  805. Function WeekOfTheYear(const AValue: TDateTime; out AYear: Word): Word;
  806. Var
  807. DOW : Word;
  808. begin
  809. DecodeDateWeek(AValue,AYear,Result,DOW);
  810. end;
  811. Function DayOfTheYear(const AValue: TDateTime): Word;
  812. begin
  813. Result:=Trunc(AValue-StartOfTheYear(AValue)+1);
  814. end;
  815. Function HourOfTheYear(const AValue: TDateTime): Word;
  816. Var
  817. H,M,S,MS : Word;
  818. begin
  819. DecodeTime(AValue,H,M,S,MS);
  820. Result:=H+((DayOfTheYear(AValue)-1)*24);
  821. end;
  822. Function MinuteOfTheYear(const AValue: TDateTime): LongWord;
  823. Var
  824. H,M,S,MS : Word;
  825. begin
  826. DecodeTime(AValue,H,M,S,MS);
  827. Result:=M+(H+((DayOfTheYear(AValue)-1)*24))*60;
  828. end;
  829. Function SecondOfTheYear(const AValue: TDateTime): LongWord;
  830. Var
  831. H,M,S,MS : Word;
  832. begin
  833. DecodeTime(AValue,H,M,S,MS);
  834. Result:=(M+(H+((DayOfTheYear(AValue)-1)*24))*60)*60+S;
  835. end;
  836. Function MilliSecondOfTheYear(const AValue: TDateTime): Int64;
  837. Var
  838. H,M,S,MS : Word;
  839. begin
  840. DecodeTime(AValue,H,M,S,MS);
  841. Result:=((M+(H+((int64(DayOfTheYear(AValue))-1)*24))*60)*60+S)*1000+MS;
  842. end;
  843. { ---------------------------------------------------------------------
  844. Part of month functions.
  845. ---------------------------------------------------------------------}
  846. Function WeekOfTheMonth(const AValue: TDateTime): Word;
  847. var
  848. Y,M,DOW : word;
  849. begin
  850. DecodeDateMonthWeek(AValue,Y,M,Result,DOW);
  851. end;
  852. Function WeekOfTheMonth(const AValue: TDateTime; out AYear, AMonth: Word): Word;
  853. Var
  854. DOW : Word;
  855. begin
  856. DecodeDateMonthWeek(AValue,AYear,AMonth,Result,DOW);
  857. end;
  858. Function DayOfTheMonth(const AValue: TDateTime): Word;
  859. Var
  860. Y,M : Word;
  861. begin
  862. DecodeDate(AValue,Y,M,Result);
  863. end;
  864. Function HourOfTheMonth(const AValue: TDateTime): Word;
  865. Var
  866. Y,M,D,H,N,S,MS : Word;
  867. begin
  868. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  869. Result:=(D-1)*24+H;
  870. end;
  871. Function MinuteOfTheMonth(const AValue: TDateTime): Word;
  872. Var
  873. Y,M,D,H,N,S,MS : Word;
  874. begin
  875. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  876. Result:=((D-1)*24+H)*60+N;
  877. end;
  878. Function SecondOfTheMonth(const AValue: TDateTime): LongWord;
  879. Var
  880. Y,M,D,H,N,S,MS : Word;
  881. begin
  882. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  883. Result:=(((D-1)*24+H)*60+N)*60+S;
  884. end;
  885. Function MilliSecondOfTheMonth(const AValue: TDateTime): LongWord;
  886. Var
  887. Y,M,D,H,N,S,MS : Word;
  888. begin
  889. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  890. Result:=((((D-1)*24+H)*60+N)*60+S)*1000+MS;
  891. end;
  892. { ---------------------------------------------------------------------
  893. Part of week functions.
  894. ---------------------------------------------------------------------}
  895. Function DayOfTheWeek(const AValue: TDateTime): Word;
  896. begin
  897. Result:=DowMAP[DayOfWeek(AValue)];
  898. end;
  899. Function HourOfTheWeek(const AValue: TDateTime): Word;
  900. Var
  901. H,M,S,MS : Word;
  902. begin
  903. DecodeTime(AValue,H,M,S,MS);
  904. Result:=(DayOfTheWeek(AValue)-1)*24+H;
  905. end;
  906. Function MinuteOfTheWeek(const AValue: TDateTime): Word;
  907. Var
  908. H,M,S,MS : Word;
  909. begin
  910. DecodeTime(AValue,H,M,S,MS);
  911. Result:=((DayOfTheWeek(AValue)-1)*24+H)*60+M;
  912. end;
  913. Function SecondOfTheWeek(const AValue: TDateTime): LongWord;
  914. Var
  915. H,M,S,MS : Word;
  916. begin
  917. DecodeTime(AValue,H,M,S,MS);
  918. Result:=(((DayOfTheWeek(AValue)-1)*24+H)*60+M)*60+S;
  919. end;
  920. Function MilliSecondOfTheWeek(const AValue: TDateTime): LongWord;
  921. Var
  922. H,M,S,MS : Word;
  923. begin
  924. DecodeTime(AValue,H,M,S,MS);
  925. Result:=((((DayOfTheWeek(AValue)-1)*24+H)*60+M)*60+S)*1000+MS;
  926. end;
  927. { ---------------------------------------------------------------------
  928. Part of day functions.
  929. ---------------------------------------------------------------------}
  930. Function HourOfTheDay(const AValue: TDateTime): Word; inline;
  931. begin
  932. Result:=HourOf(AValue);
  933. end;
  934. Function MinuteOfTheDay(const AValue: TDateTime): Word;
  935. Var
  936. H,M,S,MS : Word;
  937. begin
  938. DecodeTime(AValue,H,M,S,MS);
  939. Result:=(H*60)+M;
  940. end;
  941. Function SecondOfTheDay(const AValue: TDateTime): LongWord;
  942. Var
  943. H,M,S,MS : Word;
  944. begin
  945. DecodeTime(AValue,H,M,S,MS);
  946. Result:=((H*60)+M)*60+S;
  947. end;
  948. Function MilliSecondOfTheDay(const AValue: TDateTime): LongWord;
  949. Var
  950. H,M,S,MS : Word;
  951. begin
  952. DecodeTime(AValue,H,M,S,MS);
  953. Result:=(((H*60)+M)*60+S)*1000+MS;
  954. end;
  955. { ---------------------------------------------------------------------
  956. Part of hour functions.
  957. ---------------------------------------------------------------------}
  958. Function MinuteOfTheHour(const AValue: TDateTime): Word; inline;
  959. begin
  960. Result:=MinuteOf(AValue);
  961. end;
  962. Function SecondOfTheHour(const AValue: TDateTime): Word;
  963. Var
  964. H,S,M,MS : Word;
  965. begin
  966. DecodeTime(AValue,H,M,S,MS);
  967. Result:=M*60+S;
  968. end;
  969. Function MilliSecondOfTheHour(const AValue: TDateTime): LongWord;
  970. Var
  971. H,S,M,MS : Word;
  972. begin
  973. DecodeTime(AValue,H,M,S,MS);
  974. Result:=(M*60+S)*1000+MS;
  975. end;
  976. { ---------------------------------------------------------------------
  977. Part of minute functions.
  978. ---------------------------------------------------------------------}
  979. Function SecondOfTheMinute(const AValue: TDateTime): Word; inline;
  980. begin
  981. Result:=SecondOf(AValue);
  982. end;
  983. Function MilliSecondOfTheMinute(const AValue: TDateTime): LongWord;
  984. Var
  985. H,S,M,MS : Word;
  986. begin
  987. DecodeTime(AValue,H,M,S,MS);
  988. Result:=S*1000+MS;
  989. end;
  990. { ---------------------------------------------------------------------
  991. Part of second functions.
  992. ---------------------------------------------------------------------}
  993. Function MilliSecondOfTheSecond(const AValue: TDateTime): Word; inline;
  994. begin
  995. Result:=MilliSecondOf(AValue);
  996. end;
  997. { ---------------------------------------------------------------------
  998. Range checking functions.
  999. ---------------------------------------------------------------------}
  1000. Function WithinPastYears(const ANow, AThen: TDateTime; const AYears: Integer): Boolean; inline;
  1001. begin
  1002. Result:=YearsBetween(ANow,AThen)<=AYears;
  1003. end;
  1004. Function WithinPastMonths(const ANow, AThen: TDateTime; const AMonths: Integer): Boolean; inline;
  1005. begin
  1006. Result:=MonthsBetween(ANow,AThen)<=AMonths;
  1007. end;
  1008. Function WithinPastWeeks(const ANow, AThen: TDateTime; const AWeeks: Integer): Boolean; inline;
  1009. begin
  1010. Result:=WeeksBetween(ANow,AThen)<=AWeeks;
  1011. end;
  1012. Function WithinPastDays(const ANow, AThen: TDateTime; const ADays: Integer): Boolean; inline;
  1013. begin
  1014. Result:=DaysBetween(ANow,AThen)<=ADays;
  1015. end;
  1016. Function WithinPastHours(const ANow, AThen: TDateTime; const AHours: Int64): Boolean; inline;
  1017. begin
  1018. Result:=HoursBetween(ANow,AThen)<=AHours;
  1019. end;
  1020. Function WithinPastMinutes(const ANow, AThen: TDateTime; const AMinutes: Int64): Boolean; inline;
  1021. begin
  1022. Result:=MinutesBetween(ANow,AThen)<=AMinutes;
  1023. end;
  1024. Function WithinPastSeconds(const ANow, AThen: TDateTime; const ASeconds: Int64): Boolean; inline;
  1025. begin
  1026. Result:=SecondsBetween(ANow,Athen)<=ASeconds;
  1027. end;
  1028. Function WithinPastMilliSeconds(const ANow, AThen: TDateTime; const AMilliSeconds: Int64): Boolean; inline;
  1029. begin
  1030. Result:=MilliSecondsBetween(ANow,AThen)<=AMilliSeconds;
  1031. end;
  1032. function DateTimeInRange(ADateTime: TDateTime; AStartDateTime, AEndDateTime: TDateTime; aInclusive: Boolean = True): Boolean;
  1033. begin
  1034. if aInclusive then
  1035. Result:=(AStartDateTime<=ADateTime) and (ADateTime<=AEndDateTime)
  1036. else
  1037. Result:=(AStartDateTime<ADateTime) and (ADateTime<AEndDateTime);
  1038. end;
  1039. function TimeInRange(ATime: TTime; AStartTime, AEndTime: TTime; AInclusive: Boolean = True): Boolean;
  1040. var
  1041. LTime, LStartTime, LEndTime: TTime;
  1042. begin
  1043. LTime:=TimeOf(ATime);
  1044. LStartTime:=TimeOf(AStartTime);
  1045. LEndTime:=TimeOf(AEndTime);
  1046. if LEndTime<LStartTime then
  1047. if AInclusive then
  1048. Result:=(LStartTime<=LTime) or (LTime<=LEndTime)
  1049. else
  1050. Result:=(LStartTime<LTime) or (LTime<LEndTime)
  1051. else
  1052. if AInclusive then
  1053. Result:=(LStartTime<=LTime) and (LTime<=LEndTime)
  1054. else
  1055. Result:=(LStartTime<LTime) and (LTime<LEndTime);
  1056. end;
  1057. function DateInRange(ADate: TDate; AStartDate, AEndDate: TDate; AInclusive: Boolean = True): Boolean;
  1058. begin
  1059. if AInclusive then
  1060. Result:=(DateOf(AStartDate)<=DateOf(ADate)) and (DateOf(ADate)<=DateOf(AEndDate))
  1061. else
  1062. Result:=(DateOf(AStartDate)<DateOf(ADate)) and (DateOf(ADate)<DateOf(AEndDate));
  1063. end;
  1064. { ---------------------------------------------------------------------
  1065. Period functions.
  1066. ---------------------------------------------------------------------}
  1067. {
  1068. These functions are declared as approximate by Borland.
  1069. A bit strange, since it can be calculated exactly ?
  1070. -- No, because you need rounding or truncating (JM)
  1071. }
  1072. function DateTimeToNumber(ADateTime: TDateTime): Double;
  1073. begin
  1074. if ADateTime >= 0 then
  1075. Result := ADateTime
  1076. else
  1077. Result := int(ADateTime) - frac(ADateTime);
  1078. end;
  1079. function NumberToDateTime(AValue: Double): TDateTime;
  1080. begin
  1081. if AValue >= 0 then
  1082. Result := AValue
  1083. else
  1084. Result := int(AValue) + frac(AValue);
  1085. end;
  1086. Function DateTimeDiff(const ANow, AThen: TDateTime): TDateTime;
  1087. begin
  1088. Result := NumberToDateTime(DateTimeToNumber(ANow) - DateTimeToNumber(AThen));
  1089. end;
  1090. Function YearsBetween(const ANow, AThen: TDateTime; AExact : Boolean = False): Integer;
  1091. var
  1092. yy, mm, dd: Word;
  1093. begin
  1094. if AExact and (ANow >= -DateDelta) and (AThen >= -DateDelta) and
  1095. (ANow <= MaxDateTime) and (AThen <= MaxDateTime) then
  1096. begin
  1097. PeriodBetween(ANow, AThen, yy , mm, dd);
  1098. Result := yy;
  1099. end
  1100. else
  1101. Result:=Trunc((Abs(DateTimeDiff(ANow,AThen))+HalfMilliSecond)/ApproxDaysPerYear);
  1102. end;
  1103. Function MonthsBetween(const ANow, AThen: TDateTime; AExact : Boolean = False): Integer;
  1104. var
  1105. y, m, d: Word;
  1106. begin
  1107. if AExact and (ANow >= -DateDelta) and (AThen >= -DateDelta) and
  1108. (ANow <= MaxDateTime) and (AThen <= MaxDateTime) then
  1109. begin
  1110. PeriodBetween(ANow, AThen, y, m, d);
  1111. Result := y*12 + m;
  1112. end
  1113. else
  1114. Result:=Trunc((Abs(DateTimeDiff(ANow,AThen))+HalfMilliSecond)/ApproxDaysPerMonth);
  1115. end;
  1116. Function WeeksBetween(const ANow, AThen: TDateTime): Integer;
  1117. begin
  1118. Result:=Trunc(Abs(DateTimeDiff(ANow,AThen))+HalfMilliSecond) div 7;
  1119. end;
  1120. Function DaysBetween(const ANow, AThen: TDateTime): Integer;
  1121. begin
  1122. if anow>athen then
  1123. Result:=Trunc(Abs(DateTimeDiff(ANow,AThen))+HalfMilliSecond)
  1124. else
  1125. Result:=Trunc(Abs(DateTimeDiff(AThen,ANow))+HalfMilliSecond); // bug 37361
  1126. end;
  1127. Function HoursBetween(const ANow, AThen: TDateTime): Int64;
  1128. begin
  1129. Result:=Trunc((Abs(DateTimeDiff(ANow,AThen))+HalfMilliSecond)*HoursPerDay);
  1130. end;
  1131. Function MinutesBetween(const ANow, AThen: TDateTime): Int64;
  1132. begin
  1133. Result:=Trunc((Abs(DateTimeDiff(ANow,AThen))+HalfMilliSecond)*MinsPerDay);
  1134. end;
  1135. Function SecondsBetween(const ANow, AThen: TDateTime): Int64;
  1136. begin
  1137. Result:=Trunc((Abs(DateTimeDiff(ANow,AThen))+HalfMilliSecond)*SecsPerDay);
  1138. end;
  1139. Function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;
  1140. begin
  1141. Result:=Trunc((Abs(DateTimeDiff(ANow,AThen))+HalfMilliSecond)*MSecsPerDay);
  1142. end;
  1143. Procedure PeriodBetween(Const ANow, AThen: TDateTime; Out Years, months, days : Word);
  1144. var
  1145. Y1, Y2, M1, M2, D1, D2: word;
  1146. begin
  1147. if (AThen>ANow) then
  1148. begin
  1149. DecodeDate(ANow,Y1,M1,D1);
  1150. DecodeDate(AThen,Y2,M2,D2);
  1151. end
  1152. else
  1153. begin
  1154. DecodeDate(AThen,Y1,M1,D1);
  1155. DecodeDate(ANow,Y2,M2,D2);
  1156. end;
  1157. Years:=Y2-Y1;
  1158. if (M1>M2) or ((M1=M2) and (D1>D2)) then Dec(Years);
  1159. if (M1>M2) then Inc(M2,12); //already adjusted Years in that case
  1160. Months:=M2-M1;
  1161. if (D2>=D1) then
  1162. Days:=D2-D1
  1163. else
  1164. begin
  1165. if (Months=0) then
  1166. Months:=11
  1167. else
  1168. Dec(Months);
  1169. Days:=(DaysInAMonth(Y1,M1)-D1)+D2;
  1170. end;
  1171. end;
  1172. { ---------------------------------------------------------------------
  1173. Timespan in xxx functions.
  1174. ---------------------------------------------------------------------}
  1175. Function YearSpan(const ANow, AThen: TDateTime): Double;
  1176. begin
  1177. Result:=Abs(DateTimeDiff(ANow,AThen))/ApproxDaysPerYear;
  1178. end;
  1179. Function MonthSpan(const ANow, AThen: TDateTime): Double;
  1180. begin
  1181. Result:=Abs(DateTimeDiff(ANow,AThen))/ApproxDaysPerMonth;
  1182. end;
  1183. Function WeekSpan(const ANow, AThen: TDateTime): Double;
  1184. begin
  1185. Result:=Abs(DateTimeDiff(ANow,AThen)) / 7
  1186. end;
  1187. Function DaySpan(const ANow, AThen: TDateTime): Double;
  1188. begin
  1189. Result:=Abs(DateTimeDiff(ANow,AThen));
  1190. end;
  1191. Function HourSpan(const ANow, AThen: TDateTime): Double;
  1192. begin
  1193. Result:=Abs(DateTimeDiff(ANow,AThen))*HoursPerDay;
  1194. end;
  1195. Function MinuteSpan(const ANow, AThen: TDateTime): Double;
  1196. begin
  1197. Result:=Abs(DateTimeDiff(ANow,AThen))*MinsPerDay;
  1198. end;
  1199. Function SecondSpan(const ANow, AThen: TDateTime): Double;
  1200. begin
  1201. Result:=Abs(DateTimeDiff(ANow,AThen))*SecsPerDay;
  1202. end;
  1203. Function MilliSecondSpan(const ANow, AThen: TDateTime): Double;
  1204. begin
  1205. Result:=Abs(DateTimeDiff(ANow,AThen))*MSecsPerDay;
  1206. end;
  1207. { ---------------------------------------------------------------------
  1208. Increment/decrement functions.
  1209. ---------------------------------------------------------------------}
  1210. { TDateTime is not defined in the interval [-1.0..0.0[. Additionally, when
  1211. negative the time part must be treated using its absolute value (0.25 always
  1212. means "6 a.m.") -> skip the gap and convert the time part when crossing the
  1213. gap -- and take care of rounding errors }
  1214. Procedure MaybeSkipTimeWarp(OldDate: TDateTime; var NewDate: TDateTime);
  1215. begin
  1216. if (OldDate>=0) and (NewDate<-TDateTimeEpsilon) then
  1217. NewDate:=int(NewDate-1.0+TDateTimeEpsilon)-frac(1.0+frac(NewDate))
  1218. else if (OldDate<=-1.0) and (NewDate>-1.0+TDateTimeEpsilon) then
  1219. NewDate:=int(NewDate+1.0-TDateTimeEpsilon)+frac(1.0-abs(frac(1.0+NewDate)));
  1220. end;
  1221. function IncNegativeTime(AValue, Addend: TDateTime): TDateTime;
  1222. var
  1223. newtime: tdatetime;
  1224. begin
  1225. newtime:=-frac(Avalue)+frac(Addend);
  1226. { handle rounding errors }
  1227. if SameValue(newtime,int(newtime)+1,TDateTimeEpsilon) then
  1228. newtime:=int(newtime)+1
  1229. else if SameValue(newtime,int(newtime),TDateTimeEpsilon) then
  1230. newtime:=int(newtime);
  1231. { time underflow -> previous day }
  1232. if newtime<-TDateTimeEpsilon then
  1233. begin
  1234. newtime:=1.0+newtime;
  1235. avalue:=int(avalue)-1;
  1236. end
  1237. { time overflow -> next day }
  1238. else if newtime>=1.0-TDateTimeEpsilon then
  1239. begin
  1240. newtime:=newtime-1.0;
  1241. avalue:=int(avalue)+1;
  1242. end;
  1243. Result:=int(AValue)+int(Addend)-newtime;
  1244. end;
  1245. Function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer ): TDateTime;
  1246. Var
  1247. Y,M,D,H,N,S,MS : Word;
  1248. begin
  1249. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  1250. Y:=Y+ANumberOfYears;
  1251. If (M=2) and (D=29) And (Not IsLeapYear(Y)) then
  1252. D:=28;
  1253. Result:=EncodeDateTime(Y,M,D,H,N,S,MS);
  1254. end;
  1255. Function IncYear(const AValue: TDateTime): TDateTime; // ; const ANumberOfYears: Integer = 1)
  1256. begin
  1257. Result:=IncYear(Avalue,1);
  1258. end;
  1259. Function IncWeek(const AValue: TDateTime; const ANumberOfWeeks: Integer): TDateTime;
  1260. begin
  1261. Result:=AValue+ANumberOfWeeks*7;
  1262. MaybeSkipTimeWarp(AValue,Result);
  1263. end;
  1264. Function IncWeek(const AValue: TDateTime): TDateTime; // ; const ANumberOfWeeks: Integer = 1)
  1265. begin
  1266. Result:=IncWeek(Avalue,1);
  1267. end;
  1268. Function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer): TDateTime;
  1269. begin
  1270. Result:=AValue+ANumberOfDays;
  1271. MaybeSkipTimeWarp(AValue,Result);
  1272. end;
  1273. Function IncDay(const AValue: TDateTime): TDateTime; //; const ANumberOfDays: Integer = 1)
  1274. begin
  1275. Result:=IncDay(Avalue,1);
  1276. end;
  1277. Function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;
  1278. begin
  1279. if AValue>=0 then
  1280. Result:=AValue+ANumberOfHours/HoursPerDay
  1281. else
  1282. Result:=IncNegativeTime(Avalue,ANumberOfHours/HoursPerDay);
  1283. MaybeSkipTimeWarp(AValue,Result);
  1284. end;
  1285. Function IncHour(const AValue: TDateTime): TDateTime; //; const ANumberOfHours: Int64 = 1
  1286. begin
  1287. Result:=IncHour(AValue,1);
  1288. end;
  1289. Function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;
  1290. begin
  1291. if AValue>=0 then
  1292. Result:=AValue+ANumberOfMinutes/MinsPerDay
  1293. else
  1294. Result:=IncNegativeTime(Avalue,ANumberOfMinutes/MinsPerDay);
  1295. MaybeSkipTimeWarp(AValue,Result);
  1296. end;
  1297. Function IncMinute(const AValue: TDateTime): TDateTime; // ; const ANumberOfMinutes: Int64 = 1
  1298. begin
  1299. Result:=IncMinute(AValue,1);
  1300. end;
  1301. Function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64): TDateTime;
  1302. begin
  1303. if AValue>=0 then
  1304. Result:=AValue+ANumberOfSeconds/SecsPerDay
  1305. else
  1306. Result:=IncNegativeTime(Avalue,ANumberOfSeconds/SecsPerDay);
  1307. MaybeSkipTimeWarp(AValue,Result);
  1308. end;
  1309. Function IncSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfSeconds: Int64 = 1
  1310. begin
  1311. Result:=IncSecond(Avalue,1);
  1312. end;
  1313. Function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64): TDateTime;
  1314. begin
  1315. if Avalue>=0 then
  1316. Result:=AValue+ANumberOfMilliSeconds/MSecsPerDay
  1317. else
  1318. Result:=IncNegativeTime(Avalue,ANumberOfMilliSeconds/MSecsPerDay);
  1319. MaybeSkipTimeWarp(AValue,Result);
  1320. end;
  1321. Function IncMilliSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfMilliSeconds: Int64 = 1
  1322. begin
  1323. Result:=IncMilliSecond(AValue,1);
  1324. end;
  1325. { ---------------------------------------------------------------------
  1326. Encode/Decode of complete timestamp
  1327. ---------------------------------------------------------------------}
  1328. Function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  1329. begin
  1330. If Not TryEncodeDateTime(AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond,Result) then
  1331. InvalidDateTimeError(AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond)
  1332. end;
  1333. Procedure DecodeDateTime(const AValue: TDateTime; out AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);
  1334. begin
  1335. DecodeTime(AValue,AHour,AMinute,ASecond,AMilliSecond);
  1336. if AHour=24 then // can happen due rounding issues mantis 17123
  1337. begin
  1338. AHour:=0; // rest is already zero
  1339. DecodeDate(round(AValue),AYear,AMonth,ADay);
  1340. end
  1341. else
  1342. DecodeDate(AValue,AYear,AMonth,ADay);
  1343. end;
  1344. Function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; out AValue: TDateTime): Boolean;
  1345. Var
  1346. tmp : TDateTime;
  1347. begin
  1348. Result:=TryEncodeDate(AYear,AMonth,ADay,AValue);
  1349. Result:=Result and TryEncodeTime(AHour,AMinute,ASecond,Amillisecond,Tmp);
  1350. If Result then
  1351. Avalue:=ComposeDateTime(AValue,Tmp);
  1352. end;
  1353. { ---------------------------------------------------------------------
  1354. Encode/decode date, specifying week of year and day of week
  1355. ---------------------------------------------------------------------}
  1356. Function EncodeDateWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  1357. begin
  1358. If Not TryEncodeDateWeek(AYear,AWeekOfYear,Result,ADayOfWeek) then
  1359. InvalidDateWeekError(AYear,AWeekOfYear,ADayOfWeek);
  1360. end;
  1361. Function EncodeDateWeek(const AYear, AWeekOfYear: Word): TDateTime; //; const ADayOfWeek: Word = 1
  1362. begin
  1363. Result := EncodeDateWeek(AYear,AWeekOfYear,1);
  1364. end;
  1365. Procedure DecodeDateWeek(const AValue: TDateTime; out AYear, AWeekOfYear, ADayOfWeek: Word);
  1366. var
  1367. DOY : Integer;
  1368. D: Word;
  1369. YS : TDateTime;
  1370. YSDOW, YEDOW: Word;
  1371. begin
  1372. AYear:=YearOf(AValue);
  1373. // Correct to ISO DOW
  1374. ADayOfWeek:=DayOfWeek(AValue)-1;
  1375. If ADAyOfWeek=0 then
  1376. ADayofweek:=7;
  1377. YS:=StartOfAYear(AYear);
  1378. DOY:=Trunc(AValue-YS)+1;
  1379. YSDOW:=DayOfTheWeek(YS);
  1380. // Correct week if later than wednesday. First week never starts later than wednesday
  1381. if (YSDOW<5) then
  1382. Inc(DOY,YSDOW-1)
  1383. else
  1384. Dec(DOY,8-YSDOW);
  1385. if (DOY<=0) then // Day is in last week of previous year.
  1386. DecodeDateWeek(YS-1,AYear,AWeekOfYear,D)
  1387. else
  1388. begin
  1389. AWeekOfYear:=DOY div 7;
  1390. if ((DOY mod 7)<>0) then
  1391. Inc(AWeekOfYear);
  1392. if (AWeekOfYear>52) then // Maybe in first week of next year ?
  1393. begin
  1394. YEDOW:=YSDOW;
  1395. if IsLeapYear(AYear) then
  1396. begin
  1397. Inc(YEDOW);
  1398. if (YEDOW>7) then
  1399. YEDOW:=1;
  1400. end;
  1401. if (YEDOW<4) then // Really next year.
  1402. begin
  1403. Inc(AYear);
  1404. AWeekOfYear:=1;
  1405. end;
  1406. end;
  1407. end;
  1408. end;
  1409. Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; out AValue: TDateTime; const ADayOfWeek: Word): Boolean;
  1410. Var
  1411. DOW : Word;
  1412. Rest : Integer;
  1413. begin
  1414. Result:=IsValidDateWeek(Ayear,AWeekOfYear,ADayOfWeek);
  1415. If Result then
  1416. begin
  1417. AValue:=EncodeDate(AYear,1,1)+(7*(AWeekOfYear-1));
  1418. DOW:=DayOfTheWeek(AValue);
  1419. Rest:=ADayOfWeek-DOW;
  1420. If (DOW>4) then
  1421. Inc(Rest,7);
  1422. AValue:=AValue+Rest;
  1423. end;
  1424. end;
  1425. Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; out AValue: TDateTime): Boolean; //; const ADayOfWeek: Word = 1
  1426. begin
  1427. Result:=TryEncodeDateWeek(AYear,AWeekOfYear,AValue,1);
  1428. end;
  1429. { ---------------------------------------------------------------------
  1430. Encode/decode date, specifying day of year
  1431. ---------------------------------------------------------------------}
  1432. Function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;
  1433. begin
  1434. If Not TryEncodeDateDay(AYear,ADayOfYear,Result) then
  1435. InvalidDateDayError(AYear,ADayOfYear);
  1436. end;
  1437. Procedure DecodeDateDay(const AValue: TDateTime; out AYear, ADayOfYear: Word);
  1438. Var
  1439. M,D : Word;
  1440. begin
  1441. DecodeDate(AValue,AYear,M,D);
  1442. ADayOfyear:=Trunc(AValue-EncodeDate(AYear,1,1))+1;
  1443. end;
  1444. Function TryEncodeDateDay(const AYear, ADayOfYear: Word; out AValue: TDateTime): Boolean;
  1445. begin
  1446. Result:=(ADayOfYear<>0) and (ADayOfYear<=DaysPerYear [IsleapYear(AYear)]);
  1447. If Result then
  1448. AValue:=EncodeDate(AYear,1,1)+ADayOfYear-1;
  1449. end;
  1450. { ---------------------------------------------------------------------
  1451. Encode/decode date, specifying week of month
  1452. ---------------------------------------------------------------------}
  1453. Function EncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): TDateTime;
  1454. begin
  1455. If Not TryEncodeDateMonthWeek(Ayear,AMonth,AWeekOfMonth,ADayOfWeek,Result) then
  1456. InvalidDateMonthWeekError(AYear,AMonth,AWeekOfMonth,ADayOfWeek);
  1457. end;
  1458. Procedure DecodeDateMonthWeek(const AValue: TDateTime; out AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
  1459. Var
  1460. D,SDOM,EDOM : Word;
  1461. SOM : TdateTime;
  1462. DOM : Integer;
  1463. begin
  1464. DecodeDate(AValue,AYear,AMonth,D);
  1465. ADayOfWeek:=DayOfTheWeek(AValue);
  1466. SOM:=EncodeDate(Ayear,Amonth,1);
  1467. SDOM:=DayOfTheWeek(SOM);
  1468. DOM:=D-1+SDOM;
  1469. If SDOM>4 then
  1470. Dec(DOM,7);
  1471. // Too early in the month. First full week is next week, day is after thursday.
  1472. If DOM<=0 Then
  1473. DecodeDateMonthWeek(SOM-1,AYear,AMonth,AWeekOfMonth,D)
  1474. else
  1475. begin
  1476. AWeekOfMonth:=(DOM div 7)+Ord((DOM mod 7)<>0);
  1477. EDOM:=DayOfTheWeek(EndOfAMonth(Ayear,AMonth));
  1478. // In last days of last long week, so in next month...
  1479. If (EDOM<4) and ((DaysInAMonth(AYear,Amonth)-D)<EDOM) then
  1480. begin
  1481. AWeekOfMonth:=1;
  1482. Inc(AMonth);
  1483. If (AMonth=13) then
  1484. begin
  1485. AMonth:=1;
  1486. Inc(AYear);
  1487. end;
  1488. end;
  1489. end;
  1490. end;
  1491. Function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word; out AValue: TDateTime): Boolean;
  1492. var
  1493. S : Word;
  1494. DOM : Integer;
  1495. begin
  1496. Result:=IsValidDateMonthWeek(AYear,AMonth,AWeekOfMonth,ADayOfWeek);
  1497. if Result then
  1498. begin
  1499. AValue:=EncodeDate(AYear,AMonth,1);
  1500. DOM:=(AWeekOfMonth-1)*7+ADayOfWeek-1;
  1501. { Correct for first week in last month.}
  1502. S:=DayOfTheWeek(AValue);
  1503. Dec(DOM,S-1);
  1504. if S in [DayFriday..DaySunday] then
  1505. Inc(DOM,7);
  1506. AValue:=AValue+DOM;
  1507. end;
  1508. end;
  1509. { ---------------------------------------------------------------------
  1510. Encode time interval, allowing hours>24
  1511. ---------------------------------------------------------------------}
  1512. function TryEncodeTimeInterval(Hour, Min, Sec, MSec: word; out Time: TDateTime): boolean;
  1513. begin
  1514. Result:= (Min<60) and (Sec<60) and (MSec<=1000);
  1515. If Result then
  1516. Time:=TDateTime(cardinal(Hour)*3600000+cardinal(Min)*60000+cardinal(Sec)*1000+MSec)/MSecsPerDay;
  1517. end;
  1518. function EncodeTimeInterval(Hour, Minute, Second, MilliSecond: word): TDateTime;
  1519. begin
  1520. If not TryEncodeTimeInterval(Hour,Minute,Second,MilliSecond,Result) then
  1521. Raise EConvertError.CreateFmt(SerrInvalidHourMinuteSecMsec,
  1522. [Hour,Minute,Second,MilliSecond]);
  1523. end;
  1524. { ---------------------------------------------------------------------
  1525. Replace given element with supplied value.
  1526. ---------------------------------------------------------------------}
  1527. Const
  1528. LFAI = RecodeLeaveFieldAsIS; // Less typing, readable code
  1529. {
  1530. Note: We have little choice but to implement it like Borland did:
  1531. If AValue contains some 'wrong' value, it will throw an error.
  1532. To simulate this we'd have to check in each function whether
  1533. both arguments are correct. To avoid it, all is routed through
  1534. the 'central' RecodeDateTime function as in Borland's implementation.
  1535. }
  1536. Function RecodeYear(const AValue: TDateTime; const AYear: Word): TDateTime;
  1537. begin
  1538. Result := RecodeDateTime(AValue,AYear,LFAI,LFAI,LFAI,LFAI,LFAI,LFAI);
  1539. end;
  1540. Function RecodeMonth(const AValue: TDateTime; const AMonth: Word): TDateTime;
  1541. begin
  1542. Result := RecodeDateTime(AValue,LFAI,AMonth,LFAI,LFAI,LFAI,LFAI,LFAI);
  1543. end;
  1544. Function RecodeDay(const AValue: TDateTime; const ADay: Word): TDateTime;
  1545. begin
  1546. Result := RecodeDateTime(AValue,LFAI,LFAI,ADay,LFAI,LFAI,LFAI,LFAI);
  1547. end;
  1548. Function RecodeHour(const AValue: TDateTime; const AHour: Word): TDateTime;
  1549. begin
  1550. Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,AHour,LFAI,LFAI,LFAI);
  1551. end;
  1552. Function RecodeMinute(const AValue: TDateTime; const AMinute: Word): TDateTime;
  1553. begin
  1554. Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,AMinute,LFAI,LFAI);
  1555. end;
  1556. Function RecodeSecond(const AValue: TDateTime; const ASecond: Word): TDateTime;
  1557. begin
  1558. Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,LFAI,ASecond,LFAI);
  1559. end;
  1560. Function RecodeMilliSecond(const AValue: TDateTime; const AMilliSecond: Word): TDateTime;
  1561. begin
  1562. Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,LFAI,LFAI,AMilliSecond);
  1563. end;
  1564. Function RecodeDate(const AValue: TDateTime; const AYear, AMonth, ADay: Word): TDateTime;
  1565. begin
  1566. Result := RecodeDateTime(AValue,AYear,AMonth,ADay,LFAI,LFAI,LFAI,LFAI);
  1567. end;
  1568. Function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  1569. begin
  1570. Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,AHour,AMinute,ASecond,AMilliSecond);
  1571. end;
  1572. Function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  1573. begin
  1574. If Not TryRecodeDateTime(AValue,AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,Result) then
  1575. InvalidDateTimeError(AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,AValue);
  1576. end;
  1577. Function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; out AResult: TDateTime): Boolean;
  1578. Procedure FV (Var AV : Word; Arg : Word);
  1579. begin
  1580. If (Arg<>LFAI) then
  1581. AV:=Arg;
  1582. end;
  1583. Var
  1584. Y,M,D,H,N,S,MS : Word;
  1585. begin
  1586. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  1587. FV(Y,AYear);
  1588. FV(M,AMonth);
  1589. FV(D,ADay);
  1590. FV(H,AHour);
  1591. FV(N,AMinute);
  1592. FV(S,ASecond);
  1593. FV(MS,AMillisecond);
  1594. Result:=TryEncodeDateTime(Y,M,D,H,N,S,MS,AResult);
  1595. end;
  1596. { ---------------------------------------------------------------------
  1597. Comparision of date/time
  1598. ---------------------------------------------------------------------}
  1599. Function CompareDateTime(const A, B: TDateTime): TValueRelationship;
  1600. begin
  1601. If SameDateTime(A,B) then
  1602. Result:=EqualsValue
  1603. else if trunc(a)=trunc(b) then
  1604. begin
  1605. if abs(frac(a))>abs(frac(b)) then
  1606. result:=GreaterThanValue
  1607. else
  1608. result:=LessThanValue;
  1609. end
  1610. else
  1611. begin
  1612. if a>b then
  1613. result:=GreaterThanValue
  1614. else
  1615. result:=LessThanValue;
  1616. end;
  1617. end;
  1618. Function CompareDate(const A, B: TDateTime): TValueRelationship;
  1619. begin
  1620. If SameDate(A,B) then
  1621. Result:=EQualsValue
  1622. else if A<B then
  1623. Result:=LessThanValue
  1624. else
  1625. Result:=GreaterThanValue;
  1626. end;
  1627. Function CompareTime(const A, B: TDateTime): TValueRelationship;
  1628. begin
  1629. If SameTime(A,B) then
  1630. Result:=EQualsValue
  1631. else If Frac(A)<Frac(B) then
  1632. Result:=LessThanValue
  1633. else
  1634. Result:=GreaterThanValue;
  1635. end;
  1636. Function SameDateTime(const A, B: TDateTime): Boolean;
  1637. function MS(X: Double): Int64;
  1638. begin
  1639. if X >= 0 then
  1640. X := X * MSecsPerDay + 0.5
  1641. else if X > -1.0 then
  1642. X := -X * MSecsPerDay + 0.5
  1643. else
  1644. X := X * MSecsPerDay - 0.5;
  1645. Result := Trunc(X);
  1646. end;
  1647. begin
  1648. Result := MS(A) = MS(B);
  1649. end;
  1650. Function SameDate(const A, B: TDateTime): Boolean; inline;
  1651. begin
  1652. Result:=Trunc(A)=Trunc(B);
  1653. end;
  1654. Function SameTime(const A, B: TDateTime): Boolean;
  1655. begin
  1656. Result:=Frac(Abs(A-B))<OneMilliSecond;
  1657. end;
  1658. Function InternalNthDayOfWeek(DoM : Word) : Word;
  1659. begin
  1660. Result:=(Dom-1) div 7 +1;
  1661. end;
  1662. Function NthDayOfWeek(const AValue: TDateTime): Word;
  1663. begin
  1664. Result:=InternalNthDayOfWeek(DayOfTheMonth(AValue));
  1665. end;
  1666. Procedure DecodeDayOfWeekInMonth(const AValue: TDateTime; out AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
  1667. var
  1668. D: Word;
  1669. begin
  1670. DecodeDate(AValue,AYear,AMonth,D);
  1671. ADayOfWeek:=DayOfTheWeek(AValue);
  1672. ANthDayOfWeek:=InternalNthDayOfWeek(D);
  1673. end;
  1674. Function EncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word): TDateTime;
  1675. begin
  1676. If Not TryEncodeDayOfWeekInMonth(AYear,AMonth,ANthDayOfWeek,ADayOfWeek,Result) then
  1677. InvalidDayOfWeekInMonthError(AYear,AMonth,ANthDayOfWeek,ADayOfWeek);
  1678. end;
  1679. Function TryEncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word; out AValue: TDateTime): Boolean;
  1680. Var
  1681. SOM,D : Word;
  1682. begin
  1683. SOM:=DayOfTheWeek(EncodeDate(Ayear,AMonth,1));
  1684. D:=1+ADayOfWeek-SOM+7*(ANthDayOfWeek-1);
  1685. If SOM>ADayOfWeek then
  1686. D:=D+7; // Clearer would have been Inc(ANthDayOfweek) but it's a const
  1687. Result:=TryEncodeDate(Ayear,AMonth,D,AValue);
  1688. end;
  1689. { ---------------------------------------------------------------------
  1690. Exception throwing routines
  1691. ---------------------------------------------------------------------}
  1692. Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
  1693. Function DoField(Arg,Def : Word; Unknown: String) : String;
  1694. begin
  1695. If (Arg<>LFAI) then
  1696. Result:=Format('%.*d',[Length(Unknown),Arg])
  1697. else if (ABaseDate=0) then
  1698. Result:=Unknown
  1699. else
  1700. Result:=Format('%.*d',[Length(Unknown),Arg]);
  1701. end;
  1702. Var
  1703. Y,M,D,H,N,S,MS : Word;
  1704. Msg : String;
  1705. begin
  1706. DecodeDateTime(ABasedate,Y,M,D,H,N,S,MS);
  1707. Msg:=DoField(AYear,Y,'????');
  1708. Msg:=Msg+DefaultFormatSettings.DateSeparator+DoField(AMonth,M,'??');
  1709. Msg:=Msg+DefaultFormatSettings.DateSeparator+DoField(ADay,D,'??');
  1710. Msg:=Msg+' '+DoField(AHour,H,'??');
  1711. Msg:=Msg+DefaultFormatSettings.TimeSeparator+DoField(AMinute,N,'??');
  1712. Msg:=Msg+DefaultFormatSettings.TimeSeparator+Dofield(ASecond,S,'??');
  1713. Msg:=Msg+DefaultFormatSettings.DecimalSeparator+DoField(AMilliSecond,MS,'???');
  1714. Raise EConvertError.CreateFmt(SErrInvalidTimeStamp,[Msg]);
  1715. end;
  1716. Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word); // const ABaseDate: TDateTime = 0
  1717. begin
  1718. InvalidDateTimeError(AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,0);
  1719. end;
  1720. Procedure InvalidDateWeekError(const AYear, AWeekOfYear, ADayOfWeek: Word);
  1721. begin
  1722. Raise EConvertError.CreateFmt(SErrInvalidDateWeek,[AYear,AWeekOfYear,ADayOfWeek]);
  1723. end;
  1724. Procedure InvalidDateDayError(const AYear, ADayOfYear: Word);
  1725. begin
  1726. Raise EConvertError.CreateFmt(SErrInvalidDayOfYear,[AYear,ADayOfYear]);
  1727. end;
  1728. Procedure InvalidDateMonthWeekError(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
  1729. begin
  1730. Raise EConvertError.CreateFmt(SErrInvalidDateMonthWeek,[Ayear,AMonth,AWeekOfMonth,ADayOfWeek]);
  1731. end;
  1732. Procedure InvalidDayOfWeekInMonthError(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
  1733. begin
  1734. Raise EConvertError.CreateFmt(SErrInvalidDayOfWeekInMonth,[AYear,AMonth,ANthDayOfWeek,ADayOfWeek]);
  1735. end;
  1736. { ---------------------------------------------------------------------
  1737. Julian and Modified Julian Date conversion support
  1738. ---------------------------------------------------------------------}
  1739. {$push}
  1740. {$R-}
  1741. {$Q-}
  1742. Function DateTimeToJulianDate(const AValue: TDateTime): Double;
  1743. var
  1744. day,month,year: word;
  1745. a,y,m: longint;
  1746. begin
  1747. DecodeDate ( AValue, year, month, day );
  1748. a := (14-month) div 12;
  1749. y := year + 4800 - a;
  1750. m := month + (12*a) - 3;
  1751. result := day + ((153*m+2) div 5) + (365*y)
  1752. + (y div 4) - (y div 100) + (y div 400) - 32045.5 + frac(avalue);
  1753. end;
  1754. Function JulianDateToDateTime(const AValue: Double): TDateTime;
  1755. begin
  1756. if not TryJulianDateToDateTime(AValue, Result) then
  1757. raise EConvertError.CreateFmt(SInvalidJulianDate, [AValue]);
  1758. end;
  1759. Function TryJulianDateToDateTime(const AValue: Double; out ADateTime: TDateTime): Boolean;
  1760. var
  1761. a,b,c,d,e,m:longint;
  1762. day,month,year: word;
  1763. begin
  1764. a := trunc(AValue + 32044.5);
  1765. b := (4*a + 3) div 146097;
  1766. c := a - (146097*b div 4);
  1767. d := (4*c + 3) div 1461;
  1768. e := c - (1461*d div 4);
  1769. m := (5*e+2) div 153;
  1770. day := e - ((153*m + 2) div 5) + 1;
  1771. month := m + 3 - 12 * ( m div 10 );
  1772. year := (100*b) + d - 4800 + ( m div 10 );
  1773. result := TryEncodeDate ( Year, Month, Day, ADateTime );
  1774. if Result then
  1775. // ADateTime:=IncMilliSecond(IncHour(ADateTime,-12),MillisecondOfTheDay(Abs(Frac(aValue))));
  1776. ADateTime:=ADateTime+frac(AValue-0.5);
  1777. end;
  1778. Function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
  1779. begin
  1780. result := DateTimeToJulianDate(AValue) - 2400000.5;
  1781. end;
  1782. Function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
  1783. begin
  1784. result := JulianDateToDateTime(AValue + 2400000.5);
  1785. end;
  1786. Function TryModifiedJulianDateToDateTime(const AValue: Double; out ADateTime: TDateTime): Boolean;
  1787. begin
  1788. Result:=TryJulianDateToDateTime(AValue + 2400000.5, ADateTime);
  1789. end;
  1790. {$pop}//{$R-}{$Q-} for Julian conversion functions
  1791. { ---------------------------------------------------------------------
  1792. Unix timestamp support.
  1793. ---------------------------------------------------------------------}
  1794. Function DateTimeToUnix(const AValue: TDateTime; AInputIsUTC: Boolean = True): Int64;
  1795. Var
  1796. T : TDateTime;
  1797. begin
  1798. T:=aValue;
  1799. if Not aInputisUTC then
  1800. T:=IncMinute(T,GetLocalTimeOffset(AValue, AInputisUTC));
  1801. Result:=Round(DateTimeDiff(RecodeMillisecond(T,0),UnixEpoch)*SecsPerDay);
  1802. end;
  1803. Function UnixToDateTime(const AValue: Int64; aReturnUTC : Boolean = true): TDateTime;
  1804. begin
  1805. Result:=IncSecond(UnixEpoch, AValue);
  1806. if Not aReturnUTC then
  1807. Result:=IncMinute(Result,-GetLocalTimeOffset(Result, True));
  1808. end;
  1809. Function UnixTimeStampToMac(const AValue: Int64): Int64;
  1810. const
  1811. Epoch=24107 * 24 * 3600;
  1812. begin
  1813. Result:=AValue + Epoch;
  1814. end;
  1815. { ---------------------------------------------------------------------
  1816. Mac timestamp support.
  1817. ---------------------------------------------------------------------}
  1818. Function DateTimeToMac(const AValue: TDateTime): Int64;
  1819. var
  1820. Epoch:TDateTime;
  1821. begin
  1822. Epoch:=EncodeDateTime( 1904, 1, 1, 0, 0, 0, 0 );
  1823. Result:=SecondsBetween( Epoch, AValue );
  1824. end;
  1825. Function MacToDateTime(const AValue: Int64): TDateTime;
  1826. var
  1827. Epoch:TDateTime;
  1828. begin
  1829. Epoch:=EncodeDateTime( 1904, 1, 1, 0, 0, 0, 0 );
  1830. Result:=IncSecond( Epoch, AValue );
  1831. end;
  1832. Function MacTimeStampToUnix(const AValue: Int64): Int64;
  1833. const
  1834. Epoch=24107 * 24 * 3600;
  1835. begin
  1836. Result:=AValue - Epoch;
  1837. end;
  1838. Function DateTimeToDosDateTime(const AValue: TDateTime): longint;
  1839. var year,month,day,hour,min,sec,msec : word;
  1840. zs : longint;
  1841. begin
  1842. decodedatetime(avalue,year,month,day,hour,min,sec,msec);
  1843. result:=-1980;
  1844. result:=result+year and 127;
  1845. result:=result shl 4;
  1846. result:=result+month;
  1847. result:=result shl 5;
  1848. result:=result+day;
  1849. result:=result shl 16;
  1850. zs:=hour;
  1851. zs:=zs shl 6;
  1852. zs:=zs+min;
  1853. zs:=zs shl 5;
  1854. zs:=zs+sec div 2;
  1855. result:=result+(zs and $ffff);
  1856. end;
  1857. Function DosDateTimeToDateTime( AValue: longint): TDateTime;
  1858. var year,month,day,hour,min,sec : integer;
  1859. begin
  1860. sec:=(AValue and 31) * 2;
  1861. avalue:=AValue shr 5;
  1862. min:=AValue and 63;
  1863. avalue:=AValue shr 6;
  1864. hour:=AValue and 31;
  1865. avalue:=AValue shr 5;
  1866. day:=AValue and 31;
  1867. avalue:=AValue shr 5;
  1868. month:=AValue and 15;
  1869. avalue:=AValue shr 4;
  1870. year:=AValue+1980;
  1871. result:=EncodeDateTime(year,month,day,hour,min,sec,0);
  1872. end;
  1873. {
  1874. Inverse of formatdatetime, destined for the dateutils unit of FPC.
  1875. Limitations/implementation details:
  1876. - An inverse of FormatDateTime is not 100% an inverse, simply because one can put e.g. time tokens twice in the format string,
  1877. and scandatetime wouldn't know which time to pick.
  1878. - 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
  1879. misses chars for the "n" part.
  1880. - trailing characters are ignored.
  1881. - no support for Eastern Asian formatting characters since they are windows only.
  1882. - no MBCS support.
  1883. Extensions
  1884. - #9 eats whitespace.
  1885. - whitespace at the end of a pattern is optional.
  1886. - ? matches any AnsiChar.
  1887. - Quote the above chars to really match the AnsiChar.
  1888. }
  1889. const whitespace = [' ',#13,#10];
  1890. hrfactor = 1/(24);
  1891. minfactor = 1/(24*60);
  1892. secfactor = 1/(24*60*60);
  1893. mssecfactor = 1/(24*60*60*1000);
  1894. const AMPMformatting : array[0..2] of string =('am/pm','a/p','ampm');
  1895. procedure raiseexception(const s:string);
  1896. begin
  1897. raise EConvertError.Create(s);
  1898. end;
  1899. function scandatetime(const pattern: string;const s:string;const fmt:TFormatSettings;startpos:integer=1) : tdatetime;
  1900. const
  1901. EPS = 1E-15;
  1902. var len ,ind : integer;
  1903. yy,mm,dd : integer;
  1904. timeval : TDateTime;
  1905. activequote: Char;
  1906. procedure intscandate(ptrn:PChar;plen:integer;poffs:integer);
  1907. // poffs is the offset to
  1908. var
  1909. pind : integer;
  1910. function findimatch(const mnts:array of string;p:PChar):integer;
  1911. var i : integer;
  1912. plen, findlen: integer;
  1913. begin
  1914. result:=-1;
  1915. i:=0;
  1916. plen := strlen(p);
  1917. while (i<=high(mnts)) and (result=-1) do
  1918. begin
  1919. findlen := length(mnts[i]);
  1920. if (findlen > 0) and (findlen <= plen) then // protect against buffer over-read
  1921. {$if SizeOf(Char)=2}
  1922. if StrLIComp(p,@(mnts[i][1]),findlen)=0 then
  1923. result:=i;
  1924. {$else}
  1925. if AnsiStrLIComp(p,@(mnts[i][1]),findlen)=0 then
  1926. result:=i;
  1927. {$endif}
  1928. inc(i);
  1929. end;
  1930. end;
  1931. procedure arraymatcherror;
  1932. begin
  1933. raiseexception(format(SNoArrayMatch,[pind+1,ind]))
  1934. end;
  1935. function scanmatch(const mnts : array of string;p:PChar; patlen: integer):integer;
  1936. begin
  1937. result:=findimatch(mnts,p);
  1938. if result=-1 then
  1939. arraymatcherror
  1940. else
  1941. begin
  1942. inc(ind,length(mnts[result]));
  1943. inc(pind,patlen);
  1944. inc(result); // was 0 based.
  1945. end;
  1946. end;
  1947. var
  1948. pivot,
  1949. i : integer;
  1950. function scanfixedint(maxv:integer):integer;
  1951. var c : Char;
  1952. oi:integer;
  1953. begin
  1954. result:=0;
  1955. oi:=ind;
  1956. c:=ptrn[pind];
  1957. while (pind<plen) and (ptrn[pind]=c) do inc(pind);
  1958. while (maxv>0) and (ind<=len) and (s[ind] IN ['0'..'9']) do
  1959. begin
  1960. result:=result*10+ord(s[ind])-48;
  1961. inc(ind);
  1962. dec(maxv);
  1963. end;
  1964. if oi=ind then
  1965. raiseexception(format(SPatternCharMismatch,[c,oi]));
  1966. end;
  1967. procedure matchchar(c:Char);
  1968. begin
  1969. if (ind>len) or (s[ind]<>c) then
  1970. raiseexception(format(SNoCharMatch,[s[ind],c,pind+poffs+1,ind]));
  1971. inc(pind);
  1972. inc(ind);
  1973. end;
  1974. function scanpatlen:integer;
  1975. var c : Char;
  1976. lind : Integer;
  1977. begin
  1978. result:=pind;
  1979. lind:=pind;
  1980. c:=ptrn[lind];
  1981. while (lind<=plen) and (ptrn[lind]=c) do
  1982. inc(lind);
  1983. result:=lind-result;
  1984. end;
  1985. procedure matchpattern(const lptr:string);
  1986. var len:integer;
  1987. begin
  1988. len:=length(lptr);
  1989. if len>0 then
  1990. intscandate(@lptr[1],len,pind+poffs);
  1991. end;
  1992. var lasttoken,lch : Char;
  1993. begin
  1994. pind:=0; lasttoken:=' ';
  1995. while (ind<=len) and (pind<plen) do
  1996. begin
  1997. lch:=upcase(ptrn[pind]);
  1998. if activequote=#0 then
  1999. begin
  2000. if (lch='M') and (lasttoken='H') then
  2001. begin
  2002. i:=scanpatlen;
  2003. if i>2 then
  2004. raiseexception(format(Shhmmerror,[poffs+pind+1]));
  2005. timeval:=timeval+scanfixedint(2)* minfactor;
  2006. end
  2007. else
  2008. case lch of
  2009. 'H': timeval:=timeval+scanfixedint(2)* hrfactor;
  2010. 'D': begin
  2011. i:=scanpatlen;
  2012. case i of
  2013. 1,2 : dd:=scanfixedint(2);
  2014. 3 : dd:=scanmatch(fmt.shortDayNames,@s[ind],i);
  2015. 4 : dd:=scanmatch(fmt.longDayNames,@s[ind],i);
  2016. 5 :
  2017. begin
  2018. matchpattern(fmt.shortdateformat);
  2019. inc(pind, i);
  2020. end;
  2021. 6 :
  2022. begin
  2023. matchpattern(fmt.longdateformat);
  2024. inc(pind, i);
  2025. end;
  2026. end;
  2027. end;
  2028. 'N': timeval:=timeval+scanfixedint(2)* minfactor;
  2029. 'S': timeval:=timeval+scanfixedint(2)* secfactor;
  2030. 'Z': timeval:=timeval+scanfixedint(3)* mssecfactor;
  2031. 'Y': begin
  2032. i:=scanpatlen;
  2033. case i of
  2034. 1,2 : yy:=scanfixedint(2);
  2035. else yy:=scanfixedint(i);
  2036. end;
  2037. if i<=2 then
  2038. begin
  2039. pivot:=YearOf(now)-fmt.TwoDigitYearCenturyWindow;
  2040. inc(yy, pivot div 100 * 100);
  2041. if (fmt.TwoDigitYearCenturyWindow > 0) and (yy < pivot) then
  2042. inc(yy, 100);
  2043. end;
  2044. end;
  2045. 'M': begin
  2046. i:=scanpatlen;
  2047. case i of
  2048. 1,2: mm:=scanfixedint(2);
  2049. 3: mm:=scanmatch(fmt.ShortMonthNames,@s[ind],i);
  2050. 4: mm:=scanmatch(fmt.LongMonthNames,@s[ind],i);
  2051. end;
  2052. end;
  2053. 'T' : begin
  2054. i:=scanpatlen;
  2055. case i of
  2056. 1:
  2057. begin
  2058. matchpattern(fmt.shorttimeformat);
  2059. inc(pind, i);
  2060. end;
  2061. 2:
  2062. begin
  2063. matchpattern(fmt.longtimeformat);
  2064. inc(pind, i);
  2065. end;
  2066. end;
  2067. end;
  2068. 'A' : begin
  2069. i:=findimatch(AMPMformatting,@ptrn[pind]);
  2070. case i of
  2071. 0: begin
  2072. if timeval >= 13*hrfactor - EPS then
  2073. raiseexception(SAMPMError);
  2074. i:=findimatch(['AM','PM'],@s[ind]);
  2075. case i of
  2076. 0: if timeval >= 12*hrfactor then
  2077. timeval := timeval - 12*hrfactor;
  2078. 1: if (timeval + EPS >= hrfactor) and (timeval + EPS <= 12*hrfactor) then
  2079. timeval:=timeval+12*hrfactor;
  2080. else
  2081. arraymatcherror
  2082. end;
  2083. inc(pind,length(AMPMformatting[0]));
  2084. inc(ind,2);
  2085. end;
  2086. 1: begin
  2087. if timeval >= 13*hrfactor - EPS then
  2088. raiseexception(SAMPMError);
  2089. case upcase(s[ind]) of
  2090. 'A' : if timeval >= 12*hrfactor then
  2091. timeval := timeval - 12*hrfactor;
  2092. 'P' : if (timeval + EPS >= hrfactor) and (timeval + EPS <= 12*hrfactor) then
  2093. timeval := timeval + 12*hrfactor;
  2094. else
  2095. arraymatcherror
  2096. end;
  2097. inc(pind,length(AMPMformatting[1]));
  2098. inc(ind);
  2099. end;
  2100. 2: begin
  2101. if timeval >= 13*hrfactor - EPS then
  2102. raiseexception(SAMPMError);
  2103. i:=findimatch([fmt.timeamstring,fmt.timepmstring],@s[ind]);
  2104. case i of
  2105. 0: begin
  2106. if timeval >= 12*hrfactor then
  2107. timeval := timeval - 12*hrfactor;
  2108. inc(ind,length(fmt.timeamstring));
  2109. end;
  2110. 1: begin
  2111. if (timeval + EPS >= hrfactor) and (timeval + EPS <= 12*hrfactor) then
  2112. timeval:=timeval + 12*hrfactor;
  2113. inc(ind,length(fmt.timepmstring));
  2114. end;
  2115. else
  2116. arraymatcherror
  2117. end;
  2118. inc(pind,length(AMPMformatting[2]));
  2119. end;
  2120. else // no AM/PM match. Assume 'a' is simply a AnsiChar
  2121. matchchar(ptrn[pind]);
  2122. end;
  2123. end;
  2124. '/' : matchchar(fmt.dateSeparator);
  2125. ':' : begin
  2126. matchchar(fmt.TimeSeparator);
  2127. lch:=lasttoken;
  2128. end;
  2129. #39,'"' : begin
  2130. activequote:=lch;
  2131. inc(pind);
  2132. end;
  2133. 'C' : begin
  2134. intscandate(@fmt.shortdateformat[1],length(fmt.ShortDateFormat),pind+poffs);
  2135. intscandate(@fmt.longtimeformat[1],length(fmt.longtimeformat),pind+poffs);
  2136. inc(pind);
  2137. end;
  2138. '?' : begin
  2139. inc(pind);
  2140. inc(ind);
  2141. end;
  2142. #9 : begin
  2143. while (ind<=len) and (s[ind] in whitespace) do
  2144. inc(ind);
  2145. inc(pind);
  2146. end;
  2147. else
  2148. matchchar(ptrn[pind]);
  2149. end; {case}
  2150. lasttoken:=lch;
  2151. end
  2152. else
  2153. begin
  2154. if activequote=lch then
  2155. begin
  2156. activequote:=#0;
  2157. inc(pind);
  2158. end
  2159. else
  2160. matchchar(ptrn[pind]);
  2161. end;
  2162. end;
  2163. if (pind<plen) and (plen>0) and not (ptrn[plen-1] in [#9, '"']) then // allow omission of trailing whitespace
  2164. RaiseException(format(SFullpattern,[poffs+pind+1]));
  2165. end;
  2166. var plen:integer;
  2167. begin
  2168. activequote:=#0;
  2169. yy:=0; mm:=0; dd:=0;
  2170. timeval:=0.0;
  2171. len:=length(s); ind:=startpos;
  2172. plen:=length(pattern);
  2173. intscandate(@pattern[1],plen,0);
  2174. result:=timeval;
  2175. if (yy>0) and (mm>0) and (dd>0) then
  2176. result:=result+encodedate(yy,mm,dd);
  2177. end;
  2178. function scandatetime(const pattern:string;const s:string;startpos:integer=1) : tdatetime; overload;
  2179. begin
  2180. result:=scandatetime(pattern,s,defaultformatsettings,startpos);
  2181. end;
  2182. { Conversion of UTC to local time and vice versa }
  2183. function UniversalTimeToLocal(UT: TDateTime): TDateTime;
  2184. begin
  2185. Result:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}SysUtils.UniversalTimeToLocal(UT,-GetLocalTimeOffset(UT, True));
  2186. end;
  2187. function UniversalTimeToLocal(UT: TDateTime; TZOffset : Integer): TDateTime;
  2188. begin
  2189. Result:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}SysUtils.UniversalTimeToLocal(UT,TZOffset);
  2190. end;
  2191. Function LocalTimeToUniversal(LT: TDateTime): TDateTime;
  2192. begin
  2193. Result:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}SysUtils.LocalTimeToUniversal(LT,-GetLocalTimeOffset(LT, False));
  2194. end;
  2195. Function LocalTimeToUniversal(LT: TDateTime;TZOffset: Integer): TDateTime;
  2196. begin
  2197. Result:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}SysUtils.LocalTimeToUniversal(LT,TZOffset);
  2198. end;
  2199. Const
  2200. FmtUTC = 'yyyy"-"mm"-"dd"T"hh":"nn":"ss"."zzz';
  2201. FmtUTCTZ = 'hh":"mm';
  2202. function DateToISO8601(const ADate: TDateTime; AInputIsUTC: Boolean = True): string;
  2203. const
  2204. FmtOffset: string = '%.02d:%.02d';
  2205. Sign: array[Boolean] of AnsiChar = ('+', '-');
  2206. var
  2207. Offset: Integer;
  2208. begin
  2209. Result := FormatDateTime(FmtUTC, ADate);
  2210. Offset := GetLocalTimeOffset(ADate, AInputIsUTC);
  2211. if AInputIsUTC or (Offset=0) then
  2212. Result:=Result+'Z'
  2213. else
  2214. begin
  2215. Result:=Result+Sign[Offset>0];
  2216. Offset := Abs(Offset);
  2217. Result:= Result+Format(FmtOffset, [Offset div MinsPerHour, Offset mod MinsPerHour]);
  2218. end;
  2219. end;
  2220. function TryISOStrToDate(const aString: string; out outDate: TDateTime): Boolean;
  2221. var
  2222. xYear, xMonth, xDay: LongInt;
  2223. begin
  2224. case Length(aString) of
  2225. 4: Result := // YYYY
  2226. TryStrToInt(aString, xYear) and
  2227. TryEncodeDate(xYear, 1, 1, outDate);
  2228. 6: Result := // YYYYMM
  2229. TryStrToInt(Copy(aString, 1, 4), xYear) and
  2230. TryStrToInt(Copy(aString, 5, 2), xMonth) and
  2231. TryEncodeDate(xYear, xMonth, 1, outDate);
  2232. 7: Result := // YYYY-MM
  2233. TryStrToInt(Copy(aString, 1, 4), xYear) and
  2234. TryStrToInt(Copy(aString, 6, 2), xMonth) and
  2235. TryEncodeDate(xYear, xMonth, 1, outDate);
  2236. 8: Result := // YYYYMMDD
  2237. TryStrToInt(Copy(aString, 1, 4), xYear) and
  2238. TryStrToInt(Copy(aString, 5, 2), xMonth) and
  2239. TryStrToInt(Copy(aString, 7, 2), xDay) and
  2240. TryEncodeDate(xYear, xMonth, xDay, outDate);
  2241. 10: Result := //YYYY-MM-DD
  2242. TryStrToInt(Copy(aString, 1, 4), xYear) and
  2243. TryStrToInt(Copy(aString, 6, 2), xMonth) and
  2244. TryStrToInt(Copy(aString, 9, 2), xDay) and
  2245. TryEncodeDate(xYear, xMonth, xDay, outDate);
  2246. else
  2247. Result := False;
  2248. end;
  2249. if not Result then
  2250. outDate := 0;
  2251. end;
  2252. function TryISOStrToTime(const aString: string; Out outTime: TDateTime): Boolean;
  2253. var
  2254. xHour, xMinute, xSecond, xLength, res: LongInt;
  2255. xFractionalSecond: Extended;
  2256. tmp: String;
  2257. begin
  2258. Result := True;
  2259. xLength := Length(aString);
  2260. if (xLength>0) and (aString[xLength] = 'Z') then
  2261. begin
  2262. Dec(xLength);
  2263. end else
  2264. if (xLength>6) and CharInSet(aString[xLength-5], ['+', '-']) then
  2265. begin
  2266. Result :=
  2267. TryStrToInt(Copy(aString, xLength-4, 2), xHour) and
  2268. (aString[xLength-2] = ':') and
  2269. TryStrToInt(Copy(aString, xLength-1, 2), xMinute);
  2270. Dec(xLength, 6);
  2271. end else
  2272. if (xLength>5) and CharInSet(aString[xLength-4], ['+', '-']) then
  2273. begin
  2274. Result :=
  2275. TryStrToInt(Copy(aString, xLength-3, 2), xHour) and
  2276. TryStrToInt(Copy(aString, xLength-1, 2), xMinute);
  2277. Dec(xLength, 5);
  2278. end else
  2279. if (xLength>3) and CharInSet(aString[xLength-2], ['+', '-']) then
  2280. begin
  2281. Result :=
  2282. TryStrToInt(Copy(aString, xLength-1, 2), xHour);
  2283. Dec(xLength, 3);
  2284. end;
  2285. if not Result then
  2286. begin
  2287. outTime := 0;
  2288. Exit;
  2289. end;
  2290. case xLength of
  2291. 2: Result := // HH
  2292. TryStrToInt(aString, xHour) and
  2293. TryEncodeTime(xHour, 0, 0, 0, outTime);
  2294. 4: Result := // HHNN
  2295. TryStrToInt(Copy(aString, 1, 2), xHour) and
  2296. TryStrToInt(Copy(aString, 3, 2), xMinute) and
  2297. TryEncodeTime(xHour, xMinute, 0, 0, outTime);
  2298. 5: Result := // HH:NN
  2299. TryStrToInt(Copy(aString, 1, 2), xHour) and
  2300. (aString[3] = ':') and
  2301. TryStrToInt(Copy(aString, 4, 2), xMinute) and
  2302. TryEncodeTime(xHour, xMinute, 0, 0, outTime);
  2303. 6: Result := // HHNNSS
  2304. TryStrToInt(Copy(aString, 1, 2), xHour) and
  2305. TryStrToInt(Copy(aString, 3, 2), xMinute) and
  2306. TryStrToInt(Copy(aString, 5, 2), xSecond) and
  2307. TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
  2308. else
  2309. if (xLength >= 8) and (aString[3] = ':') and (aString[6] = ':') then
  2310. begin
  2311. Result := // HH:NN:SS
  2312. TryStrToInt(Copy(aString, 1, 2), xHour) and
  2313. TryStrToInt(Copy(aString, 4, 2), xMinute) and
  2314. TryStrToInt(Copy(aString, 7, 2), xSecond) and
  2315. TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
  2316. if Result and (xLength >= 9) then // HH:NN:SS.[z] (0 or several z)
  2317. begin
  2318. tmp := copy(aString, 10, xLength-9);
  2319. val('.' + tmp, xFractionalSecond, res);
  2320. Result := (res = 0);
  2321. if Result then
  2322. outTime := outTime + xFractionalSecond * OneSecond;
  2323. end;
  2324. end else
  2325. if (xLength >= 7) and (aString[7] in ['.', ',']) then
  2326. begin
  2327. Result := // HHNNSS
  2328. TryStrToInt(Copy(aString, 1, 2), xHour) and
  2329. TryStrToInt(Copy(aString, 3, 2), xMinute) and
  2330. TryStrToInt(Copy(aString, 5, 2), xSecond) and
  2331. TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
  2332. tmp := copy(aString, 8, xLength-7);
  2333. if Result and (tmp <> '') then
  2334. begin // HHNNSS.[z] (0 or several z)
  2335. val('.'+tmp, xFractionalSecond, res);
  2336. Result := res = 0;
  2337. if Result then
  2338. outTime := outTime + xFractionalSecond * OneSecond;
  2339. end;
  2340. end else
  2341. Result := false;
  2342. end;
  2343. if not Result then
  2344. outTime := 0;
  2345. end;
  2346. function TryISOStrToDateTime(const aString: string; out outDateTime: TDateTime): Boolean;
  2347. var
  2348. xLength: Integer;
  2349. sDate,sTime : String;
  2350. xDate, xTime: TDateTime;
  2351. begin
  2352. xLength := Length(aString);
  2353. if (xLength = 0) then
  2354. exit(false);
  2355. if (aString[1]='T') then
  2356. begin
  2357. Result := TryISOStrToTime(copy(aString, 2, Length(aString)-1), outDateTime);
  2358. exit;
  2359. end;
  2360. if (xLength in [4 {YYYY}, 7 {YYYY-MM}, 8 {YYYYMMDD}, 10 {YYYY-MM-DD}]) then
  2361. begin
  2362. Result := TryISOStrToDate(aString, outDateTime);
  2363. exit;
  2364. end;
  2365. if (xLength>11) and CharInSet(aString[11], [' ', 'T']) then // YYYY-MM-DDT...
  2366. begin
  2367. sDate:=Copy(aString, 1, 10);
  2368. sTime:=Copy(aString, 12, Length(aString))
  2369. end
  2370. else if (xLength>9) and CharInSet(aString[9], [' ', 'T']) then // YYYYMMDDT...
  2371. begin
  2372. sDate:=Copy(aString, 1, 8);
  2373. sTime:=Copy(aString, 10, Length(aString));
  2374. end
  2375. else
  2376. exit(False);
  2377. Result:=TryISOStrToDate(sDate, xDate) and TryISOStrToTime(sTime, xTime);
  2378. if Result then
  2379. outDateTime := xDate+xTime
  2380. else
  2381. outDateTime := 0;
  2382. end;
  2383. Function TryISOTZStrToTZOffset(const TZ : String; Out TZOffset : Integer) : boolean;
  2384. Var
  2385. H,M : LongInt;
  2386. begin
  2387. Result:=(TZ='Z') or (TZ='');
  2388. if Result then
  2389. TZOffset:=0
  2390. else
  2391. begin
  2392. Result:=TZ[1] in ['+','-'];
  2393. if Not Result then
  2394. Exit;
  2395. case Length(TZ) of
  2396. 3: begin
  2397. Result:=TryStrToInt(Copy(TZ,2,2),H);
  2398. M := 0;
  2399. end;
  2400. 5: Result:=TryStrToInt(Copy(TZ,2,2),H) and TryStrToInt(Copy(TZ,4,2),M);
  2401. 6: Result:=TryStrToInt(Copy(TZ,2,2),H) and TryStrToInt(Copy(TZ,5,2),M);
  2402. else
  2403. Result := False;
  2404. end;
  2405. if not Result then
  2406. exit;
  2407. TZOffset:=H*60+M;
  2408. if (TZ[1]='+') then
  2409. TZOffset:=-TZOffset;
  2410. end;
  2411. end;
  2412. Function ISOTZStrToTZOffset(TZ : String) : Integer;
  2413. begin
  2414. if not TryISOTZStrToTZOffSet(TZ,Result) then
  2415. Raise EConvertError.CreateFmt('Invalid ISO timezone string',[TZ]);
  2416. end;
  2417. Function TryISO8601ToDate(const DateString: string; out ADateTime: TDateTime;ReturnUTC : Boolean = True) : Boolean;
  2418. Var
  2419. S,TZ : String;
  2420. L,Offset,TZOffset : Integer;
  2421. begin
  2422. S:=DateString;
  2423. L:=Length(S);
  2424. if L=0 then
  2425. exit(False);
  2426. if S[L]='Z' then
  2427. begin
  2428. TZ:='Z';
  2429. S:=Copy(S,1,L-1);
  2430. end
  2431. else if ((L>11) and ((S[11] in ['T',' ']) or (S[9] in ['T',' ']))) or // make sure that we dont't have date-only
  2432. (S[1]='T') then
  2433. begin
  2434. If (S[L-2] in ['+','-']) then
  2435. begin
  2436. TZ:=Copy(S,L-2,3);
  2437. S:=Copy(S,1,L-3);
  2438. end
  2439. else If (S[L-4] in ['+','-']) then
  2440. begin
  2441. TZ:=Copy(S,L-4,5);
  2442. S:=Copy(S,1,L-5);
  2443. end
  2444. else If (S[L-5] in ['+','-']) and ((L > 13) or (S[1]='T')) then // do not confuse with '2021-05-21T13'
  2445. begin
  2446. TZ:=Copy(S,L-5,6);
  2447. S:=Copy(S,1,L-6);
  2448. end;
  2449. end;
  2450. Result:=TryIsoStrToDateTime(S,aDateTime) and TryISOTZStrToTZOffset(TZ,TZOffset);
  2451. if not Result then
  2452. exit;
  2453. aDateTime:=IncMinute(aDateTime,TZOffSet);
  2454. // offset for UTC or not
  2455. if ReturnUTC then
  2456. Offset:=0
  2457. else
  2458. OffSet:=-GetLocalTimeOffset(ADateTime, True);
  2459. aDateTime:=IncMinute(aDateTime,Offset);
  2460. Result:=True;
  2461. end;
  2462. Function ISO8601ToDate(const DateString: string; ReturnUTC : Boolean = True): TDateTime;
  2463. begin
  2464. if not TryISO8601ToDate(DateString,Result,ReturnUTC) then
  2465. Raise EConvertError.CreateFmt(SErrInvalidTimeStamp,[DateString]);
  2466. end;
  2467. Function ISO8601ToDateDef(const DateString: string; ReturnUTC : Boolean; aDefault : TDateTime): TDateTime;
  2468. begin
  2469. if not TryISO8601ToDate(DateString,Result,ReturnUTC) then
  2470. Result:=aDefault;
  2471. end;
  2472. Function ISO8601ToDateDef(const DateString: string; aDefault : TDateTime; ReturnUTC : Boolean = True): TDateTime;
  2473. begin
  2474. if not TryISO8601ToDate(DateString,Result,ReturnUTC) then
  2475. Result:=aDefault;
  2476. end;
  2477. { TDateTimeHelper }
  2478. function TDateTimeHelper.AddDays(const aNumberOfDays: Integer): TDateTime;
  2479. begin
  2480. Result := IncDay(Self, aNumberOfDays);
  2481. end;
  2482. function TDateTimeHelper.AddHours(const aNumberOfHours: Int64): TDateTime;
  2483. begin
  2484. Result := IncHour(Self, aNumberOfHours);
  2485. end;
  2486. function TDateTimeHelper.AddMilliseconds(const aNumberOfMilliseconds: Int64): TDateTime;
  2487. begin
  2488. Result := IncMilliSecond(Self, aNumberOfMilliseconds);
  2489. end;
  2490. function TDateTimeHelper.AddMinutes(const aNumberOfMinutes: Int64): TDateTime;
  2491. begin
  2492. Result := IncMinute(Self, aNumberOfMinutes);
  2493. end;
  2494. function TDateTimeHelper.AddMonths(const aNumberOfMonths: Integer): TDateTime;
  2495. begin
  2496. Result := IncMonth(Self, aNumberOfMonths);
  2497. end;
  2498. function TDateTimeHelper.AddSeconds(const aNumberOfSeconds: Int64): TDateTime;
  2499. begin
  2500. Result := IncSecond(Self, aNumberOfSeconds);
  2501. end;
  2502. function TDateTimeHelper.AddYears(const aNumberOfYears: Integer): TDateTime;
  2503. begin
  2504. Result := IncYear(Self, aNumberOfYears);
  2505. end;
  2506. function TDateTimeHelper.CompareTo(const aDateTime: TDateTime): TValueRelationship;
  2507. begin
  2508. Result := CompareDateTime(Self, aDateTime);
  2509. end;
  2510. class function TDateTimeHelper.Create(const aYear, aMonth, aDay: Word): TDateTime;
  2511. begin
  2512. Result := EncodeDate(aYear, aMonth, aDay);
  2513. end;
  2514. class function TDateTimeHelper.Create(const aYear, aMonth, aDay, aHour, aMinute,
  2515. aSecond, aMillisecond: Word): TDateTime;
  2516. begin
  2517. Result := EncodeDateTime(aYear, aMonth, aDay, aHour, aMinute, aSecond, aMillisecond);
  2518. end;
  2519. class function TDateTimeHelper.CreateTotalSeconds(const Value: Int64): TDateTime;
  2520. begin
  2521. Result := (Value / 86400);
  2522. end;
  2523. class function TDateTimeHelper.CreateUnixTime(const Value: Int64): TDateTime;
  2524. begin
  2525. Result := (Value / 86400) + 25569;
  2526. end;
  2527. function TDateTimeHelper.DaysBetween(const aDateTime: TDateTime): Integer;
  2528. begin
  2529. Result :={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.DaysBetween(Self, aDateTime);
  2530. end;
  2531. function TDateTimeHelper.EndOfDay: TDateTime;
  2532. begin
  2533. Result := EndOfTheDay(Self);
  2534. end;
  2535. function TDateTimeHelper.EndOfMonth: TDateTime;
  2536. begin
  2537. Result := EndOfTheMonth(Self);
  2538. end;
  2539. function TDateTimeHelper.EndOfWeek: TDateTime;
  2540. begin
  2541. Result := EndOfTheWeek(Self);
  2542. end;
  2543. function TDateTimeHelper.EndOfYear: TDateTime;
  2544. begin
  2545. Result := EndOfTheYear(Self);
  2546. end;
  2547. function TDateTimeHelper.Equals(const aDateTime: TDateTime): Boolean;
  2548. begin
  2549. Result := SameDateTime(Self, aDateTime);
  2550. end;
  2551. function TDateTimeHelper.GetDate: TDateTime;
  2552. begin
  2553. Result := DateOf(Self);
  2554. end;
  2555. function TDateTimeHelper.GetDay: Word;
  2556. begin
  2557. Result := DayOf(Self);
  2558. end;
  2559. function TDateTimeHelper.GetDayOfWeek: Word;
  2560. begin
  2561. Result := DayOfTheWeek(Self);
  2562. end;
  2563. function TDateTimeHelper.GetDayOfYear: Word;
  2564. begin
  2565. Result := DayOfTheYear(Self);
  2566. end;
  2567. function TDateTimeHelper.GetHour: Word;
  2568. begin
  2569. Result := HourOf(Self);
  2570. end;
  2571. function TDateTimeHelper.GetMillisecond: Word;
  2572. begin
  2573. Result := MilliSecondOf(Self);
  2574. end;
  2575. function TDateTimeHelper.GetMinute: Word;
  2576. begin
  2577. Result := MinuteOf(Self);
  2578. end;
  2579. function TDateTimeHelper.GetMonth: Word;
  2580. begin
  2581. Result := MonthOf(Self);
  2582. end;
  2583. class function TDateTimeHelper.GetNow: TDateTime;
  2584. begin
  2585. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}SysUtils.Now;
  2586. end;
  2587. function TDateTimeHelper.GetSecond: Word;
  2588. begin
  2589. Result := SecondOf(Self);
  2590. end;
  2591. function TDateTimeHelper.GetTime: TDateTime;
  2592. begin
  2593. Result := TimeOf(Self);
  2594. end;
  2595. class function TDateTimeHelper.GetToday: TDateTime;
  2596. begin
  2597. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}SysUtils.Date;
  2598. end;
  2599. class function TDateTimeHelper.GetTomorrow: TDateTime;
  2600. begin
  2601. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}SysUtils.Date + 1;
  2602. end;
  2603. function TDateTimeHelper.GetTotalSecounds: Int64;
  2604. begin
  2605. Result := Trunc(86400 * self);
  2606. end;
  2607. function TDateTimeHelper.GetUnixTime: Int64;
  2608. begin
  2609. Result := Trunc((self - 25569) * 86400);
  2610. end;
  2611. function TDateTimeHelper.GetYear: Word;
  2612. begin
  2613. Result := YearOf(Self);
  2614. end;
  2615. class function TDateTimeHelper.GetYesterDay: TDateTime;
  2616. begin
  2617. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}SysUtils.Date - 1;
  2618. end;
  2619. function TDateTimeHelper.HoursBetween(const aDateTime: TDateTime): Int64;
  2620. begin
  2621. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.HoursBetween(Self, aDateTime);
  2622. end;
  2623. function TDateTimeHelper.InRange(const aStartDateTime, aEndDateTime: TDateTime;
  2624. const aInclusive: Boolean): Boolean;
  2625. begin
  2626. Result := DateTimeInRange(Self, aStartDateTime, aEndDateTime, aInclusive);
  2627. end;
  2628. function TDateTimeHelper.IsAM: Boolean;
  2629. begin
  2630. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.IsAM(Self);
  2631. end;
  2632. function TDateTimeHelper.IsInLeapYear: Boolean;
  2633. begin
  2634. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.IsInLeapYear(Self);
  2635. end;
  2636. function TDateTimeHelper.IsPM: Boolean;
  2637. begin
  2638. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.IsPM(Self);
  2639. end;
  2640. function TDateTimeHelper.IsSameDay(const aDateTime: TDateTime): Boolean;
  2641. begin
  2642. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.IsSameDay(Self, aDateTime);
  2643. end;
  2644. function TDateTimeHelper.IsToday: Boolean;
  2645. begin
  2646. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.IsToday(Self);
  2647. end;
  2648. function TDateTimeHelper.MilliSecondsBetween(const aDateTime: TDateTime): Int64;
  2649. begin
  2650. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.MilliSecondsBetween(Self, aDateTime);
  2651. end;
  2652. function TDateTimeHelper.MinutesBetween(const aDateTime: TDateTime): Int64;
  2653. begin
  2654. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.MinutesBetween(Self, aDateTime);
  2655. end;
  2656. function TDateTimeHelper.MonthsBetween(const aDateTime: TDateTime): Integer;
  2657. begin
  2658. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.MonthsBetween(Self, aDateTime);
  2659. end;
  2660. function TDateTimeHelper.SecondsBetween(const aDateTime: TDateTime): Int64;
  2661. begin
  2662. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.SecondsBetween(Self, aDateTime);
  2663. end;
  2664. function TDateTimeHelper.StartOfDay: TDateTime;
  2665. begin
  2666. Result := StartOfTheDay(Self);
  2667. end;
  2668. function TDateTimeHelper.StartOfMonth: TDateTime;
  2669. begin
  2670. Result := StartOfTheMonth(Self);
  2671. end;
  2672. function TDateTimeHelper.StartOfWeek: TDateTime;
  2673. begin
  2674. Result := StartOfTheWeek(Self);
  2675. end;
  2676. function TDateTimeHelper.StartOfYear: TDateTime;
  2677. begin
  2678. Result := StartOfTheYear(Self);
  2679. end;
  2680. function TDateTimeHelper.ToString(const aFormatStr: string): string;
  2681. begin
  2682. if aFormatStr = '' then
  2683. Result := DateToStr(Self)
  2684. else
  2685. Result := FormatDateTime(aFormatStr, Self);
  2686. end;
  2687. function TDateTimeHelper.WeeksBetween(const aDateTime: TDateTime): Integer;
  2688. begin
  2689. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.WeeksBetween(Self, aDateTime);
  2690. end;
  2691. function TDateTimeHelper.WithinDays(const aDateTime: TDateTime; const aDays:
  2692. Integer): Boolean;
  2693. begin
  2694. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.WithinPastDays(Self, aDateTime, aDays);
  2695. end;
  2696. function TDateTimeHelper.WithinHours(const aDateTime: TDateTime; const aHours:
  2697. Int64): Boolean;
  2698. begin
  2699. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.WithinPastHours(Self, aDateTime, aHours);
  2700. end;
  2701. function TDateTimeHelper.WithinMilliseconds(const aDateTime: TDateTime; const
  2702. AMilliseconds: Int64): Boolean;
  2703. begin
  2704. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.WithinPastMilliSeconds(Self, aDateTime, AMilliseconds);
  2705. end;
  2706. function TDateTimeHelper.WithinMinutes(const aDateTime: TDateTime; const
  2707. aMinutes: Int64): Boolean;
  2708. begin
  2709. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.WithinPastMinutes(Self, aDateTime, aMinutes);
  2710. end;
  2711. function TDateTimeHelper.WithinMonths(const aDateTime: TDateTime; const aMonths:
  2712. Integer): Boolean;
  2713. begin
  2714. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.WithinPastMonths(Self, aDateTime, aMonths);
  2715. end;
  2716. function TDateTimeHelper.WithinSeconds(const aDateTime: TDateTime; const
  2717. aSeconds: Int64): Boolean;
  2718. begin
  2719. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.WithinPastSeconds(Self, aDateTime, aSeconds);
  2720. end;
  2721. function TDateTimeHelper.WithinWeeks(const aDateTime: TDateTime; const aWeeks:
  2722. Integer): Boolean;
  2723. begin
  2724. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.WithinPastWeeks(Self, aDateTime, aWeeks);
  2725. end;
  2726. function TDateTimeHelper.WithinYears(const aDateTime: TDateTime; const aYears:
  2727. Integer): Boolean;
  2728. begin
  2729. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.WithinPastYears(Self, aDateTime, aYears);
  2730. end;
  2731. function TDateTimeHelper.YearsBetween(const aDateTime: TDateTime): Integer;
  2732. begin
  2733. Result := {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}DateUtils.YearsBetween(Self, aDateTime);
  2734. end;
  2735. class function TDateTimeHelper.Parse(Date: string; aFormat: string = '';
  2736. aDateSeparator: Char = #0; aTimeSeparator: Char = #0): TDateTime;
  2737. var
  2738. fs: TFormatSettings;
  2739. aFormats: TStringArray;
  2740. aLength: Integer;
  2741. begin
  2742. aFormats := aFormat.split([' ']);
  2743. aLength := Length(aFormats);
  2744. if aLength = 0 then
  2745. exit(StrToDateTime(Date));
  2746. fs:=FormatSettings;
  2747. with fs do
  2748. begin
  2749. if aDateSeparator <> #0 then
  2750. DateSeparator := aDateSeparator;
  2751. if not aFormats[0].Trim.IsEmpty then
  2752. ShortDateFormat := aFormats[0];
  2753. if aLength > 1 then
  2754. begin
  2755. if aTimeSeparator <> #0 then
  2756. TimeSeparator := aTimeSeparator;
  2757. if not aFormats[1].Trim.IsEmpty then
  2758. ShortTimeFormat := aFormats[1];
  2759. end;
  2760. end;
  2761. Result := StrToDateTime(Date, fs);
  2762. end;
  2763. class function TDateTimeHelper.ParseLocal(Date: string; local: string = ''): TDateTime;
  2764. var
  2765. fs: TFormatSettings;
  2766. begin
  2767. if local.Trim.IsEmpty then
  2768. fs := FormatSettings
  2769. else
  2770. fs := FormatSettings;
  2771. // Not yet supported...
  2772. // fs := TFormatSettings.Create(local);
  2773. Result := StrToDateTime(Date, fs);
  2774. end;
  2775. class function TDateTimeHelper.Create(Date, aFormat: string; aDateSeparator,
  2776. aTimeSeparator: Char): TDateTime;
  2777. begin
  2778. Result := Parse(Date, aFormat, aDateSeparator, aTimeSeparator);
  2779. end;
  2780. class function TDateTimeHelper.CreateLocal(Date, local: string): TDateTime;
  2781. begin
  2782. Result:= ParseLocal(Date,local);
  2783. end;
  2784. {$else}
  2785. implementation
  2786. {$endif FPUNONE}
  2787. end.