dateutil.inc 85 KB

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