dateutil.inc 66 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392
  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, Types;
  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 = 1/HoursPerDay;
  38. OneMinute = 1/MinsPerDay;
  39. OneSecond = 1/SecsPerDay;
  40. OneMillisecond = 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 PreviousDayOfWeek (DayOfWeek : Word) : Word;
  87. { ---------------------------------------------------------------------
  88. Extraction functions.
  89. ---------------------------------------------------------------------}
  90. Function YearOf(const AValue: TDateTime): Word;
  91. Function MonthOf(const AValue: TDateTime): Word;
  92. Function WeekOf(const AValue: TDateTime): Word;
  93. Function DayOf(const AValue: TDateTime): Word;
  94. Function HourOf(const AValue: TDateTime): Word;
  95. Function MinuteOf(const AValue: TDateTime): Word;
  96. Function SecondOf(const AValue: TDateTime): Word;
  97. Function MilliSecondOf(const AValue: TDateTime): Word;
  98. { ---------------------------------------------------------------------
  99. Start/End of year functions.
  100. ---------------------------------------------------------------------}
  101. Function StartOfTheYear(const AValue: TDateTime): TDateTime;
  102. Function EndOfTheYear(const AValue: TDateTime): TDateTime;
  103. Function StartOfAYear(const AYear: Word): TDateTime;
  104. Function EndOfAYear(const AYear: Word): TDateTime;
  105. { ---------------------------------------------------------------------
  106. Start/End of month functions.
  107. ---------------------------------------------------------------------}
  108. Function StartOfTheMonth(const AValue: TDateTime): TDateTime;
  109. Function EndOfTheMonth(const AValue: TDateTime): TDateTime;
  110. Function StartOfAMonth(const AYear, AMonth: Word): TDateTime;
  111. Function EndOfAMonth(const AYear, AMonth: Word): TDateTime;
  112. { ---------------------------------------------------------------------
  113. Start/End of week functions.
  114. ---------------------------------------------------------------------}
  115. Function StartOfTheWeek(const AValue: TDateTime): TDateTime;
  116. Function EndOfTheWeek(const AValue: TDateTime): TDateTime;
  117. Function StartOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  118. Function StartOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // ADayOFWeek 1
  119. Function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  120. Function EndOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // const ADayOfWeek: Word = 7
  121. { ---------------------------------------------------------------------
  122. Start/End of day functions.
  123. ---------------------------------------------------------------------}
  124. Function StartOfTheDay(const AValue: TDateTime): TDateTime;
  125. Function EndOfTheDay(const AValue: TDateTime): TDateTime;
  126. Function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime; overload;
  127. Function StartOfADay(const AYear, ADayOfYear: Word): TDateTime; overload;
  128. Function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime; overload;
  129. Function EndOfADay(const AYear, ADayOfYear: Word): TDateTime; overload;
  130. { ---------------------------------------------------------------------
  131. Part of year functions.
  132. ---------------------------------------------------------------------}
  133. Function MonthOfTheYear(const AValue: TDateTime): Word;
  134. Function WeekOfTheYear(const AValue: TDateTime): Word; overload;
  135. Function WeekOfTheYear(const AValue: TDateTime; var AYear: Word): Word; overload;
  136. Function DayOfTheYear(const AValue: TDateTime): Word;
  137. Function HourOfTheYear(const AValue: TDateTime): Word;
  138. Function MinuteOfTheYear(const AValue: TDateTime): LongWord;
  139. Function SecondOfTheYear(const AValue: TDateTime): LongWord;
  140. Function MilliSecondOfTheYear(const AValue: TDateTime): Int64;
  141. { ---------------------------------------------------------------------
  142. Part of month functions.
  143. ---------------------------------------------------------------------}
  144. Function WeekOfTheMonth(const AValue: TDateTime): Word; overload;
  145. Function WeekOfTheMonth(const AValue: TDateTime; var AYear, AMonth: Word): Word; overload;
  146. Function DayOfTheMonth(const AValue: TDateTime): Word;
  147. Function HourOfTheMonth(const AValue: TDateTime): Word;
  148. Function MinuteOfTheMonth(const AValue: TDateTime): Word;
  149. Function SecondOfTheMonth(const AValue: TDateTime): LongWord;
  150. Function MilliSecondOfTheMonth(const AValue: TDateTime): LongWord;
  151. { ---------------------------------------------------------------------
  152. Part of week functions.
  153. ---------------------------------------------------------------------}
  154. Function DayOfTheWeek(const AValue: TDateTime): Word;
  155. Function HourOfTheWeek(const AValue: TDateTime): Word;
  156. Function MinuteOfTheWeek(const AValue: TDateTime): Word;
  157. Function SecondOfTheWeek(const AValue: TDateTime): LongWord;
  158. Function MilliSecondOfTheWeek(const AValue: TDateTime): LongWord;
  159. { ---------------------------------------------------------------------
  160. Part of day functions.
  161. ---------------------------------------------------------------------}
  162. Function HourOfTheDay(const AValue: TDateTime): Word;
  163. Function MinuteOfTheDay(const AValue: TDateTime): Word;
  164. Function SecondOfTheDay(const AValue: TDateTime): LongWord;
  165. Function MilliSecondOfTheDay(const AValue: TDateTime): LongWord;
  166. { ---------------------------------------------------------------------
  167. Part of hour functions.
  168. ---------------------------------------------------------------------}
  169. Function MinuteOfTheHour(const AValue: TDateTime): Word;
  170. Function SecondOfTheHour(const AValue: TDateTime): Word;
  171. Function MilliSecondOfTheHour(const AValue: TDateTime): LongWord;
  172. { ---------------------------------------------------------------------
  173. Part of minute functions.
  174. ---------------------------------------------------------------------}
  175. Function SecondOfTheMinute(const AValue: TDateTime): Word;
  176. Function MilliSecondOfTheMinute(const AValue: TDateTime): LongWord;
  177. { ---------------------------------------------------------------------
  178. Part of second functions.
  179. ---------------------------------------------------------------------}
  180. Function MilliSecondOfTheSecond(const AValue: TDateTime): Word;
  181. { ---------------------------------------------------------------------
  182. Range checking functions.
  183. ---------------------------------------------------------------------}
  184. Function WithinPastYears(const ANow, AThen: TDateTime; const AYears: Integer): Boolean;
  185. Function WithinPastMonths(const ANow, AThen: TDateTime; const AMonths: Integer): Boolean;
  186. Function WithinPastWeeks(const ANow, AThen: TDateTime; const AWeeks: Integer): Boolean;
  187. Function WithinPastDays(const ANow, AThen: TDateTime; const ADays: Integer): Boolean;
  188. Function WithinPastHours(const ANow, AThen: TDateTime; const AHours: Int64): Boolean;
  189. Function WithinPastMinutes(const ANow, AThen: TDateTime; const AMinutes: Int64): Boolean;
  190. Function WithinPastSeconds(const ANow, AThen: TDateTime; const ASeconds: Int64): Boolean;
  191. Function WithinPastMilliSeconds(const ANow, AThen: TDateTime; const AMilliSeconds: Int64): Boolean;
  192. { ---------------------------------------------------------------------
  193. Period functions.
  194. ---------------------------------------------------------------------}
  195. Function YearsBetween(const ANow, AThen: TDateTime): Integer;
  196. Function MonthsBetween(const ANow, AThen: TDateTime): Integer;
  197. Function WeeksBetween(const ANow, AThen: TDateTime): Integer;
  198. Function DaysBetween(const ANow, AThen: TDateTime): Integer;
  199. Function HoursBetween(const ANow, AThen: TDateTime): Int64;
  200. Function MinutesBetween(const ANow, AThen: TDateTime): Int64;
  201. Function SecondsBetween(const ANow, AThen: TDateTime): Int64;
  202. Function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;
  203. { ---------------------------------------------------------------------
  204. Timespan in xxx functions.
  205. ---------------------------------------------------------------------}
  206. { YearSpan and MonthSpan are approximate values }
  207. Function YearSpan(const ANow, AThen: TDateTime): Double;
  208. Function MonthSpan(const ANow, AThen: TDateTime): Double;
  209. Function WeekSpan(const ANow, AThen: TDateTime): Double;
  210. Function DaySpan(const ANow, AThen: TDateTime): Double;
  211. Function HourSpan(const ANow, AThen: TDateTime): Double;
  212. Function MinuteSpan(const ANow, AThen: TDateTime): Double;
  213. Function SecondSpan(const ANow, AThen: TDateTime): Double;
  214. Function MilliSecondSpan(const ANow, AThen: TDateTime): Double;
  215. { ---------------------------------------------------------------------
  216. Increment/decrement functions.
  217. ---------------------------------------------------------------------}
  218. Function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer ): TDateTime;
  219. Function IncYear(const AValue: TDateTime): TDateTime; // ; const ANumberOfYears: Integer = 1)
  220. // Function IncMonth is in SysUtils
  221. Function IncWeek(const AValue: TDateTime; const ANumberOfWeeks: Integer): TDateTime;
  222. Function IncWeek(const AValue: TDateTime): TDateTime; // ; const ANumberOfWeeks: Integer = 1)
  223. Function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer): TDateTime;
  224. Function IncDay(const AValue: TDateTime): TDateTime; //; const ANumberOfDays: Integer = 1)
  225. Function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;
  226. Function IncHour(const AValue: TDateTime): TDateTime; //; const ANumberOfHours: Int64 = 1
  227. Function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;
  228. Function IncMinute(const AValue: TDateTime): TDateTime; // ; const ANumberOfMinutes: Int64 = 1
  229. Function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64): TDateTime;
  230. Function IncSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfSeconds: Int64 = 1
  231. Function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64): TDateTime;
  232. Function IncMilliSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfMilliSeconds: Int64 = 1
  233. { ---------------------------------------------------------------------
  234. Encode/Decode of complete timestamp
  235. ---------------------------------------------------------------------}
  236. Function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  237. Procedure DecodeDateTime(const AValue: TDateTime; var AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);
  238. Function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AValue: TDateTime): Boolean;
  239. { ---------------------------------------------------------------------
  240. Encode/decode date, specifying week of year and day of week
  241. ---------------------------------------------------------------------}
  242. Function EncodeDateWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  243. Function EncodeDateWeek(const AYear, AWeekOfYear: Word): TDateTime; //; const ADayOfWeek: Word = 1
  244. Procedure DecodeDateWeek(const AValue: TDateTime; var AYear, AWeekOfYear, ADayOfWeek: Word);
  245. Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime; const ADayOfWeek: Word): Boolean;
  246. Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime): Boolean; //; const ADayOfWeek: Word = 1
  247. { ---------------------------------------------------------------------
  248. Encode/decode date, specifying day of year
  249. ---------------------------------------------------------------------}
  250. Function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;
  251. Procedure DecodeDateDay(const AValue: TDateTime; var AYear, ADayOfYear: Word);
  252. Function TryEncodeDateDay(const AYear, ADayOfYear: Word; var AValue: TDateTime): Boolean;
  253. { ---------------------------------------------------------------------
  254. Encode/decode date, specifying week of month
  255. ---------------------------------------------------------------------}
  256. Function EncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): TDateTime;
  257. Procedure DecodeDateMonthWeek(const AValue: TDateTime; var AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
  258. Function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
  259. { ---------------------------------------------------------------------
  260. Replace given element with supplied value.
  261. ---------------------------------------------------------------------}
  262. Function RecodeYear(const AValue: TDateTime; const AYear: Word): TDateTime;
  263. Function RecodeMonth(const AValue: TDateTime; const AMonth: Word): TDateTime;
  264. Function RecodeDay(const AValue: TDateTime; const ADay: Word): TDateTime;
  265. Function RecodeHour(const AValue: TDateTime; const AHour: Word): TDateTime;
  266. Function RecodeMinute(const AValue: TDateTime; const AMinute: Word): TDateTime;
  267. Function RecodeSecond(const AValue: TDateTime; const ASecond: Word): TDateTime;
  268. Function RecodeMilliSecond(const AValue: TDateTime; const AMilliSecond: Word): TDateTime;
  269. Function RecodeDate(const AValue: TDateTime; const AYear, AMonth, ADay: Word): TDateTime;
  270. Function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  271. Function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  272. Function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AResult: TDateTime): Boolean;
  273. { ---------------------------------------------------------------------
  274. Comparision of date/time
  275. ---------------------------------------------------------------------}
  276. Function CompareDateTime(const A, B: TDateTime): TValueRelationship;
  277. Function CompareDate(const A, B: TDateTime): TValueRelationship;
  278. Function CompareTime(const A, B: TDateTime): TValueRelationship;
  279. Function SameDateTime(const A, B: TDateTime): Boolean;
  280. Function SameDate(const A, B: TDateTime): Boolean;
  281. Function SameTime(const A, B: TDateTime): Boolean;
  282. { For a given date these Functions tell you the which day of the week of the
  283. month (or year). If its a Thursday, they will tell you if its the first,
  284. second, etc Thursday of the month (or year). Remember, even though its
  285. the first Thursday of the year it doesn't mean its the first week of the
  286. year. See ISO 8601 above for more information. }
  287. Function NthDayOfWeek(const AValue: TDateTime): Word;
  288. Procedure DecodeDayOfWeekInMonth(const AValue: TDateTime; var AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
  289. Function EncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word): TDateTime;
  290. Function TryEncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
  291. { ---------------------------------------------------------------------
  292. Exception throwing routines
  293. ---------------------------------------------------------------------}
  294. Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
  295. Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word); // const ABaseDate: TDateTime = 0
  296. Procedure InvalidDateWeekError(const AYear, AWeekOfYear, ADayOfWeek: Word);
  297. Procedure InvalidDateDayError(const AYear, ADayOfYear: Word);
  298. Procedure InvalidDateMonthWeekError(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
  299. Procedure InvalidDayOfWeekInMonthError(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
  300. { ---------------------------------------------------------------------
  301. Julian and Modified Julian Date conversion support
  302. ---------------------------------------------------------------------}
  303. Function DateTimeToJulianDate(const AValue: TDateTime): Double;
  304. Function JulianDateToDateTime(const AValue: Double): TDateTime;
  305. Function TryJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
  306. Function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
  307. Function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
  308. Function TryModifiedJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
  309. { ---------------------------------------------------------------------
  310. Unix timestamp support.
  311. ---------------------------------------------------------------------}
  312. Function DateTimeToUnix(const AValue: TDateTime): Int64;
  313. Function UnixToDateTime(const AValue: Int64): TDateTime;
  314. Function UnixTimeStampToMac(const AValue: Int64): Int64;
  315. { ---------------------------------------------------------------------
  316. Mac timestamp support.
  317. ---------------------------------------------------------------------}
  318. Function DateTimeToMac(const AValue: TDateTime): Int64;
  319. Function MacToDateTime(const AValue: Int64): TDateTime;
  320. Function MacTimeStampToUnix(const AValue: Int64): Int64;
  321. { ScanDateTime is a limited inverse of formatdatetime }
  322. function ScanDateTime(const Pattern:string;const s:string;const fmt:TFormatSettings;startpos:integer=1) : tdatetime; overload;
  323. function ScanDateTime(const Pattern:string;const s:string;startpos:integer=1) : tdatetime; overload;
  324. implementation
  325. uses sysconst;
  326. { ---------------------------------------------------------------------
  327. Auxiliary routines
  328. ---------------------------------------------------------------------}
  329. Procedure NotYetImplemented (FN : String);
  330. begin
  331. Raise Exception.CreateFmt('Function "%s" (dateutils) is not yet implemented',[FN]);
  332. end;
  333. { ---------------------------------------------------------------------
  334. Simple trimming functions.
  335. ---------------------------------------------------------------------}
  336. Function DateOf(const AValue: TDateTime): TDateTime;
  337. begin
  338. Result:=Trunc(AValue);
  339. end;
  340. Function TimeOf(const AValue: TDateTime): TDateTime;
  341. begin
  342. Result:=Frac(Avalue);
  343. end;
  344. { ---------------------------------------------------------------------
  345. Identification functions.
  346. ---------------------------------------------------------------------}
  347. Function IsInLeapYear(const AValue: TDateTime): Boolean;
  348. Var
  349. D,Y,M : Word;
  350. begin
  351. DecodeDate(AValue,Y,M,D);
  352. Result:=IsLeapYear(Y);
  353. end;
  354. Function IsPM(const AValue: TDateTime): Boolean;
  355. Var
  356. H,M,S,MS : Word;
  357. begin
  358. DecodeTime(AValue,H,M,S,MS);
  359. Result:=(H>=12);
  360. end;
  361. Function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;
  362. begin
  363. Result:=(AYear<>0) and (AYear<10000)
  364. and (AMonth in [1..12])
  365. and (ADay<>0) and (ADay<=MonthDays[IsleapYear(AYear),AMonth]);
  366. end;
  367. Function IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
  368. begin
  369. Result:=(AHour=HoursPerDay) and (AMinute=0) and (ASecond=0) and (AMillisecond=0);
  370. Result:=Result or
  371. ((AHour<HoursPerDay) and (AMinute<MinsPerHour) and (ASecond<SecsPerMin) and
  372. (AMillisecond<MSecsPerSec));
  373. end;
  374. Function IsValidDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
  375. begin
  376. Result:=IsValidDate(AYear,AMonth,ADay) and
  377. IsValidTime(AHour,AMinute,ASecond,AMillisecond)
  378. end;
  379. Function IsValidDateDay(const AYear, ADayOfYear: Word): Boolean;
  380. begin
  381. Result:=(AYear<>0) and (ADayOfYear<>0) and (AYear<10000) and
  382. (ADayOfYear<=DaysPerYear[IsLeapYear(AYear)]);
  383. end;
  384. Function IsValidDateWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): Boolean;
  385. begin
  386. Result:=(AYear<>0) and (AYear<10000)
  387. and (ADayOfWeek in [1..7])
  388. and (AWeekOfYear<>0)
  389. and (AWeekOfYear<=WeeksInaYear(AYear));
  390. { should we not also check whether the day of the week is not
  391. larger than the last day of the last week in the year 9999 ?? }
  392. end;
  393. Function IsValidDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): Boolean;
  394. begin
  395. Result:=(AYear<>0) and (AYear<10000)
  396. and (AMonth in [1..12])
  397. and (AWeekOfMonth in [1..5])
  398. and (ADayOfWeek in [1..7]);
  399. end;
  400. { ---------------------------------------------------------------------
  401. Enumeration functions.
  402. ---------------------------------------------------------------------}
  403. Function WeeksInYear(const AValue: TDateTime): Word;
  404. Var
  405. Y,M,D : Word;
  406. begin
  407. DecodeDate(AValue,Y,M,D);
  408. Result:=WeeksInAYear(Y);
  409. end;
  410. Function WeeksInAYear(const AYear: Word): Word;
  411. Var
  412. DOW : Word;
  413. begin
  414. Result:=52;
  415. DOW:=DayOfTheWeek(StartOfAYear(AYear));
  416. If (DOW=4) or ((DOW=3) and IsLeapYear(AYear)) then
  417. Inc(Result);
  418. end;
  419. Function DaysInYear(const AValue: TDateTime): Word;
  420. Var
  421. Y,M,D : Word;
  422. begin
  423. DecodeDate(AValue,Y,M,D);
  424. Result:=DaysPerYear[IsLeapYear(Y)];
  425. end;
  426. Function DaysInAYear(const AYear: Word): Word;
  427. begin
  428. Result:=DaysPerYear[Isleapyear(AYear)];
  429. end;
  430. Function DaysInMonth(const AValue: TDateTime): Word;
  431. Var
  432. Y,M,D : Word;
  433. begin
  434. Decodedate(AValue,Y,M,D);
  435. Result:=MonthDays[IsLeapYear(Y),M];
  436. end;
  437. Function DaysInAMonth(const AYear, AMonth: Word): Word;
  438. begin
  439. Result:=MonthDays[IsLeapYear(AYear),AMonth];
  440. end;
  441. { ---------------------------------------------------------------------
  442. Variations on current date/time.
  443. ---------------------------------------------------------------------}
  444. Function Today: TDateTime;
  445. begin
  446. Result:=Date;
  447. end;
  448. Function Yesterday: TDateTime;
  449. begin
  450. Result:=Date-1;
  451. end;
  452. Function Tomorrow: TDateTime;
  453. begin
  454. Result:=Date+1;
  455. end;
  456. Function IsToday(const AValue: TDateTime): Boolean;
  457. begin
  458. Result:=IsSameDay(AValue,Date);
  459. end;
  460. Function IsSameDay(const AValue, ABasis: TDateTime): Boolean;
  461. Var
  462. D : TDateTime;
  463. begin
  464. D:=AValue-Trunc(ABasis);
  465. Result:=(D>=0) and (D<1);
  466. end;
  467. const
  468. DOWMap: array [1..7] of Word = (7, 1, 2, 3, 4, 5, 6);
  469. Function PreviousDayOfWeek (DayOfWeek : Word) : Word;
  470. begin
  471. If Not (DayOfWeek in [1..7]) then
  472. Raise EConvertError.CreateFmt(SErrInvalidDayOfWeek,[DayOfWeek]);
  473. Result:=DOWMap[DayOfWeek];
  474. end;
  475. { ---------------------------------------------------------------------
  476. Extraction functions.
  477. ---------------------------------------------------------------------}
  478. Function YearOf(const AValue: TDateTime): Word;
  479. Var
  480. D,M : Word;
  481. begin
  482. DecodeDate(AValue,Result,D,M);
  483. end;
  484. Function MonthOf(const AValue: TDateTime): Word;
  485. Var
  486. Y,D : Word;
  487. begin
  488. DecodeDate(AValue,Y,Result,D);
  489. end;
  490. Function WeekOf(const AValue: TDateTime): Word;
  491. begin
  492. Result:=WeekOfTheYear(AValue);
  493. end;
  494. Function DayOf(const AValue: TDateTime): Word;
  495. Var
  496. Y,M : Word;
  497. begin
  498. DecodeDate(AValue,Y,M,Result);
  499. end;
  500. Function HourOf(const AValue: TDateTime): Word;
  501. Var
  502. N,S,MS : Word;
  503. begin
  504. DecodeTime(AValue,Result,N,S,MS);
  505. end;
  506. Function MinuteOf(const AValue: TDateTime): Word;
  507. Var
  508. H,S,MS : Word;
  509. begin
  510. DecodeTime(AValue,H,Result,S,MS);
  511. end;
  512. Function SecondOf(const AValue: TDateTime): Word;
  513. Var
  514. H,N,MS : Word;
  515. begin
  516. DecodeTime(AVAlue,H,N,Result,MS);
  517. end;
  518. Function MilliSecondOf(const AValue: TDateTime): Word;
  519. Var
  520. H,N,S : Word;
  521. begin
  522. DecodeTime(AValue,H,N,S,Result);
  523. end;
  524. { ---------------------------------------------------------------------
  525. Start/End of year functions.
  526. ---------------------------------------------------------------------}
  527. Function StartOfTheYear(const AValue: TDateTime): TDateTime;
  528. Var
  529. Y,M,D : Word;
  530. begin
  531. DecodeDate(AValue,Y,M,D);
  532. Result:=EncodeDate(Y,1,1);
  533. end;
  534. Function EndOfTheYear(const AValue: TDateTime): TDateTime;
  535. Var
  536. Y,M,D : Word;
  537. begin
  538. DecodeDate(AValue,Y,M,D);
  539. Result:=EncodeDateTime(Y,12,31,23,59,59,999);
  540. end;
  541. Function StartOfAYear(const AYear: Word): TDateTime;
  542. begin
  543. Result:=EncodeDate(AYear,1,1);
  544. end;
  545. Function EndOfAYear(const AYear: Word): TDateTime;
  546. begin
  547. Result:=(EncodeDateTime(AYear,12,31,23,59,59,999));
  548. end;
  549. { ---------------------------------------------------------------------
  550. Start/End of month functions.
  551. ---------------------------------------------------------------------}
  552. Function StartOfTheMonth(const AValue: TDateTime): TDateTime;
  553. Var
  554. Y,M,D : Word;
  555. begin
  556. DecodeDate(AValue,Y,M,D);
  557. Result:=EncodeDate(Y,M,1);
  558. // MonthDays[IsLeapYear(Y),M])
  559. end;
  560. Function EndOfTheMonth(const AValue: TDateTime): TDateTime;
  561. Var
  562. Y,M,D : Word;
  563. begin
  564. DecodeDate(AValue,Y,M,D);
  565. Result:=EncodeDateTime(Y,M,MonthDays[IsLeapYear(Y),M],23,59,59,999);
  566. end;
  567. Function StartOfAMonth(const AYear, AMonth: Word): TDateTime;
  568. begin
  569. Result:=EncodeDate(AYear,AMonth,1);
  570. end;
  571. Function EndOfAMonth(const AYear, AMonth: Word): TDateTime;
  572. begin
  573. Result:=EncodeDateTime(AYear,AMonth,MonthDays[IsLeapYear(AYear),AMonth],23,59,59,999);
  574. end;
  575. { ---------------------------------------------------------------------
  576. Start/End of week functions.
  577. ---------------------------------------------------------------------}
  578. Function StartOfTheWeek(const AValue: TDateTime): TDateTime;
  579. begin
  580. Result:=Trunc(AValue)-DayOfTheWeek(AValue)+1;
  581. end;
  582. Function EndOfTheWeek(const AValue: TDateTime): TDateTime;
  583. begin
  584. Result:=EndOfTheDay(AValue-DayOfTheWeek(AValue)+7);
  585. end;
  586. Function StartOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  587. begin
  588. Result:=EncodeDateWeek(AYear,AWeekOfYear,ADayOfWeek);
  589. end;
  590. Function StartOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // ADayOFWeek 1
  591. begin
  592. Result:=StartOfAWeek(AYear,AWeekOfYear,1)
  593. end;
  594. Function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  595. begin
  596. Result := EndOfTheDay(EncodeDateWeek(AYear, AWeekOfYear, ADayOfWeek));
  597. end;
  598. Function EndOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // const ADayOfWeek: Word = 7
  599. begin
  600. Result:=EndOfAWeek(AYear,AWeekOfYear,7);
  601. end;
  602. { ---------------------------------------------------------------------
  603. Start/End of day functions.
  604. ---------------------------------------------------------------------}
  605. Function StartOfTheDay(const AValue: TDateTime): TDateTime;
  606. begin
  607. StartOfTheDay:=Trunc(Avalue);
  608. end;
  609. Function EndOfTheDay(const AValue: TDateTime): TDateTime;
  610. Var
  611. Y,M,D : Word;
  612. begin
  613. DecodeDate(AValue,Y,M,D);
  614. Result:=EncodeDateTime(Y,M,D,23,59,59,999);
  615. end;
  616. Function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime;
  617. begin
  618. Result:=EncodeDate(AYear,AMonth,ADay);
  619. end;
  620. Function StartOfADay(const AYear, ADayOfYear: Word): TDateTime;
  621. begin
  622. Result:=StartOfAYear(AYear)+ADayOfYear-1;
  623. end;
  624. Function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime;
  625. begin
  626. Result:=EndOfTheDay(EncodeDate(AYear,AMonth,ADay));
  627. end;
  628. Function EndOfADay(const AYear, ADayOfYear: Word): TDateTime;
  629. begin
  630. Result:=StartOfAYear(AYear)+ADayOfYear-1+EncodeTime(23,59,59,999);
  631. end;
  632. { ---------------------------------------------------------------------
  633. Part of year functions.
  634. ---------------------------------------------------------------------}
  635. Function MonthOfTheYear(const AValue: TDateTime): Word;
  636. Var
  637. Y,D : Word;
  638. begin
  639. DecodeDate(AValue,Y,Result,D);
  640. end;
  641. Function WeekOfTheYear(const AValue: TDateTime): Word;
  642. Var
  643. Y,DOW : Word;
  644. begin
  645. DecodeDateWeek(AValue,Y,Result,DOW)
  646. end;
  647. Function WeekOfTheYear(const AValue: TDateTime; var AYear: Word): Word;
  648. Var
  649. DOW : Word;
  650. begin
  651. DecodeDateWeek(AValue,AYear,Result,DOW);
  652. end;
  653. Function DayOfTheYear(const AValue: TDateTime): Word;
  654. begin
  655. Result:=Trunc(AValue-StartOfTheYear(AValue)+1);
  656. end;
  657. Function HourOfTheYear(const AValue: TDateTime): Word;
  658. Var
  659. H,M,S,MS : Word;
  660. begin
  661. DecodeTime(AValue,H,M,S,MS);
  662. Result:=H+((DayOfTheYear(AValue)-1)*24);
  663. end;
  664. Function MinuteOfTheYear(const AValue: TDateTime): LongWord;
  665. Var
  666. H,M,S,MS : Word;
  667. begin
  668. DecodeTime(AValue,H,M,S,MS);
  669. Result:=M+(H+((DayOfTheYear(AValue)-1)*24))*60;
  670. end;
  671. Function SecondOfTheYear(const AValue: TDateTime): LongWord;
  672. Var
  673. H,M,S,MS : Word;
  674. begin
  675. DecodeTime(AValue,H,M,S,MS);
  676. Result:=(M+(H+((DayOfTheYear(AValue)-1)*24))*60)*60+S;
  677. end;
  678. Function MilliSecondOfTheYear(const AValue: TDateTime): Int64;
  679. Var
  680. H,M,S,MS : Word;
  681. begin
  682. DecodeTime(AValue,H,M,S,MS);
  683. Result:=((M+(H+((int64(DayOfTheYear(AValue))-1)*24))*60)*60+S)*1000+MS;
  684. end;
  685. { ---------------------------------------------------------------------
  686. Part of month functions.
  687. ---------------------------------------------------------------------}
  688. Function WeekOfTheMonth(const AValue: TDateTime): Word;
  689. var
  690. Y,M,DOW : word;
  691. begin
  692. DecodeDateMonthWeek(AValue,Y,M,Result,DOW);
  693. end;
  694. Function WeekOfTheMonth(const AValue: TDateTime; var AYear, AMonth: Word): Word;
  695. Var
  696. DOW : Word;
  697. begin
  698. DecodeDateMonthWeek(AValue,AYear,AMonth,Result,DOW);
  699. end;
  700. Function DayOfTheMonth(const AValue: TDateTime): Word;
  701. Var
  702. Y,M : Word;
  703. begin
  704. DecodeDate(AValue,Y,M,Result);
  705. end;
  706. Function HourOfTheMonth(const AValue: TDateTime): Word;
  707. Var
  708. Y,M,D,H,N,S,MS : Word;
  709. begin
  710. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  711. Result:=(D-1)*24+H;
  712. end;
  713. Function MinuteOfTheMonth(const AValue: TDateTime): Word;
  714. Var
  715. Y,M,D,H,N,S,MS : Word;
  716. begin
  717. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  718. Result:=((D-1)*24+H)*60+N;
  719. end;
  720. Function SecondOfTheMonth(const AValue: TDateTime): LongWord;
  721. Var
  722. Y,M,D,H,N,S,MS : Word;
  723. begin
  724. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  725. Result:=(((D-1)*24+H)*60+N)*60+S;
  726. end;
  727. Function MilliSecondOfTheMonth(const AValue: TDateTime): LongWord;
  728. Var
  729. Y,M,D,H,N,S,MS : Word;
  730. begin
  731. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  732. Result:=((((D-1)*24+H)*60+N)*60+S)*1000+MS;
  733. end;
  734. { ---------------------------------------------------------------------
  735. Part of week functions.
  736. ---------------------------------------------------------------------}
  737. Function DayOfTheWeek(const AValue: TDateTime): Word;
  738. begin
  739. Result:=DowMAP[DayOfWeek(AValue)];
  740. end;
  741. Function HourOfTheWeek(const AValue: TDateTime): Word;
  742. Var
  743. H,M,S,MS : Word;
  744. begin
  745. DecodeTime(AValue,H,M,S,MS);
  746. Result:=(DayOfTheWeek(AValue)-1)*24+H;
  747. end;
  748. Function MinuteOfTheWeek(const AValue: TDateTime): Word;
  749. Var
  750. H,M,S,MS : Word;
  751. begin
  752. DecodeTime(AValue,H,M,S,MS);
  753. Result:=((DayOfTheWeek(AValue)-1)*24+H)*60+M;
  754. end;
  755. Function SecondOfTheWeek(const AValue: TDateTime): LongWord;
  756. Var
  757. H,M,S,MS : Word;
  758. begin
  759. DecodeTime(AValue,H,M,S,MS);
  760. Result:=(((DayOfTheWeek(AValue)-1)*24+H)*60+M)*60+S;
  761. end;
  762. Function MilliSecondOfTheWeek(const AValue: TDateTime): LongWord;
  763. Var
  764. H,M,S,MS : Word;
  765. begin
  766. DecodeTime(AValue,H,M,S,MS);
  767. Result:=((((DayOfTheWeek(AValue)-1)*24+H)*60+M)*60+S)*1000+MS;
  768. end;
  769. { ---------------------------------------------------------------------
  770. Part of day functions.
  771. ---------------------------------------------------------------------}
  772. Function HourOfTheDay(const AValue: TDateTime): Word;
  773. Var
  774. M,S,MS : Word;
  775. begin
  776. DecodeTime(AValue,Result,M,S,MS);
  777. end;
  778. Function MinuteOfTheDay(const AValue: TDateTime): Word;
  779. Var
  780. H,M,S,MS : Word;
  781. begin
  782. DecodeTime(AValue,H,M,S,MS);
  783. Result:=(H*60)+M;
  784. end;
  785. Function SecondOfTheDay(const AValue: TDateTime): LongWord;
  786. Var
  787. H,M,S,MS : Word;
  788. begin
  789. DecodeTime(AValue,H,M,S,MS);
  790. Result:=((H*60)+M)*60+S;
  791. end;
  792. Function MilliSecondOfTheDay(const AValue: TDateTime): LongWord;
  793. Var
  794. H,M,S,MS : Word;
  795. begin
  796. DecodeTime(AValue,H,M,S,MS);
  797. Result:=(((H*60)+M)*60+S)*1000+MS;
  798. end;
  799. { ---------------------------------------------------------------------
  800. Part of hour functions.
  801. ---------------------------------------------------------------------}
  802. Function MinuteOfTheHour(const AValue: TDateTime): Word;
  803. Var
  804. H,S,MS : Word;
  805. begin
  806. DecodeTime(AValue,H,Result,S,MS);
  807. end;
  808. Function SecondOfTheHour(const AValue: TDateTime): Word;
  809. Var
  810. H,S,M,MS : Word;
  811. begin
  812. DecodeTime(AValue,H,M,S,MS);
  813. Result:=M*60+S;
  814. end;
  815. Function MilliSecondOfTheHour(const AValue: TDateTime): LongWord;
  816. Var
  817. H,S,M,MS : Word;
  818. begin
  819. DecodeTime(AValue,H,M,S,MS);
  820. Result:=(M*60+S)*1000+MS;
  821. end;
  822. { ---------------------------------------------------------------------
  823. Part of minute functions.
  824. ---------------------------------------------------------------------}
  825. Function SecondOfTheMinute(const AValue: TDateTime): Word;
  826. Var
  827. H,M,MS : Word;
  828. begin
  829. DecodeTime(AValue,H,M,Result,MS);
  830. end;
  831. Function MilliSecondOfTheMinute(const AValue: TDateTime): LongWord;
  832. Var
  833. H,S,M,MS : Word;
  834. begin
  835. DecodeTime(AValue,H,M,S,MS);
  836. Result:=S*1000+MS;
  837. end;
  838. { ---------------------------------------------------------------------
  839. Part of second functions.
  840. ---------------------------------------------------------------------}
  841. Function MilliSecondOfTheSecond(const AValue: TDateTime): Word;
  842. Var
  843. H,M,S : Word;
  844. begin
  845. DecodeTime(AValue,H,M,S,Result);
  846. end;
  847. { ---------------------------------------------------------------------
  848. Range checking functions.
  849. ---------------------------------------------------------------------}
  850. Function WithinPastYears(const ANow, AThen: TDateTime; const AYears: Integer): Boolean;
  851. begin
  852. Result:=YearsBetween(ANow,AThen)<=AYears;
  853. end;
  854. Function WithinPastMonths(const ANow, AThen: TDateTime; const AMonths: Integer): Boolean;
  855. begin
  856. Result:=MonthsBetween(ANow,AThen)<=AMonths;
  857. end;
  858. Function WithinPastWeeks(const ANow, AThen: TDateTime; const AWeeks: Integer): Boolean;
  859. begin
  860. Result:=WeeksBetween(ANow,AThen)<=AWeeks;
  861. end;
  862. Function WithinPastDays(const ANow, AThen: TDateTime; const ADays: Integer): Boolean;
  863. begin
  864. Result:=DaysBetween(ANow,AThen)<=ADays;
  865. end;
  866. Function WithinPastHours(const ANow, AThen: TDateTime; const AHours: Int64): Boolean;
  867. begin
  868. Result:=HoursBetween(ANow,AThen)<=AHours;
  869. end;
  870. Function WithinPastMinutes(const ANow, AThen: TDateTime; const AMinutes: Int64): Boolean;
  871. begin
  872. Result:=MinutesBetween(ANow,AThen)<=AMinutes;
  873. end;
  874. Function WithinPastSeconds(const ANow, AThen: TDateTime; const ASeconds: Int64): Boolean;
  875. begin
  876. Result:=SecondsBetween(ANow,Athen)<=ASeconds;
  877. end;
  878. Function WithinPastMilliSeconds(const ANow, AThen: TDateTime; const AMilliSeconds: Int64): Boolean;
  879. begin
  880. Result:=MilliSecondsBetween(ANow,AThen)<=AMilliSeconds;
  881. end;
  882. { ---------------------------------------------------------------------
  883. Period functions.
  884. ---------------------------------------------------------------------}
  885. {
  886. These functions are declared as approximate by Borland.
  887. A bit strange, since it can be calculated exactly ?
  888. }
  889. Function YearsBetween(const ANow, AThen: TDateTime): Integer;
  890. begin
  891. Result:=Trunc(Abs(ANow-AThen)/ApproxDaysPerYear);
  892. end;
  893. Function MonthsBetween(const ANow, AThen: TDateTime): Integer;
  894. begin
  895. Result:=Trunc(Abs(ANow-Athen)/ApproxDaysPerMonth);
  896. end;
  897. Function WeeksBetween(const ANow, AThen: TDateTime): Integer;
  898. begin
  899. Result:=Trunc(Abs(ANow-AThen)) div 7;
  900. end;
  901. Function DaysBetween(const ANow, AThen: TDateTime): Integer;
  902. begin
  903. Result:=Trunc(Abs(ANow-AThen));
  904. end;
  905. Function HoursBetween(const ANow, AThen: TDateTime): Int64;
  906. begin
  907. Result:=Trunc(Abs(ANow-AThen)*HoursPerDay);
  908. end;
  909. Function MinutesBetween(const ANow, AThen: TDateTime): Int64;
  910. begin
  911. Result:=Trunc(Abs(ANow-AThen)*MinsPerDay);
  912. end;
  913. Function SecondsBetween(const ANow, AThen: TDateTime): Int64;
  914. begin
  915. Result:=Trunc(Abs(ANow-AThen)*SecsPerDay);
  916. end;
  917. Function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;
  918. begin
  919. Result:=Trunc(Abs(ANow-AThen)*MSecsPerDay);
  920. end;
  921. { ---------------------------------------------------------------------
  922. Timespan in xxx functions.
  923. ---------------------------------------------------------------------}
  924. Function YearSpan(const ANow, AThen: TDateTime): Double;
  925. begin
  926. Result:=Abs(Anow-Athen)/ApproxDaysPerYear;
  927. end;
  928. Function MonthSpan(const ANow, AThen: TDateTime): Double;
  929. begin
  930. Result:=Abs(ANow-AThen)/ApproxDaysPerMonth;
  931. end;
  932. Function WeekSpan(const ANow, AThen: TDateTime): Double;
  933. begin
  934. Result:=Abs(ANow-AThen) / 7
  935. end;
  936. Function DaySpan(const ANow, AThen: TDateTime): Double;
  937. begin
  938. Result:=Abs(ANow-AThen);
  939. end;
  940. Function HourSpan(const ANow, AThen: TDateTime): Double;
  941. begin
  942. Result:=Abs(ANow-AThen)*HoursPerDay;
  943. end;
  944. Function MinuteSpan(const ANow, AThen: TDateTime): Double;
  945. begin
  946. Result:=Abs(ANow-AThen)*MinsPerDay;
  947. end;
  948. Function SecondSpan(const ANow, AThen: TDateTime): Double;
  949. begin
  950. Result:=Abs(ANow-AThen)*SecsPerDay;
  951. end;
  952. Function MilliSecondSpan(const ANow, AThen: TDateTime): Double;
  953. begin
  954. Result:=Abs(ANow-AThen)*MSecsPerDay;
  955. end;
  956. { ---------------------------------------------------------------------
  957. Increment/decrement functions.
  958. ---------------------------------------------------------------------}
  959. Function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer ): TDateTime;
  960. Var
  961. Y,M,D,H,N,S,MS : Word;
  962. begin
  963. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  964. Y:=Y+ANumberOfYears;
  965. If (M=2) and (D=29) And (Not IsLeapYear(Y)) then
  966. D:=28;
  967. Result:=EncodeDateTime(Y,M,D,H,N,S,MS);
  968. end;
  969. Function IncYear(const AValue: TDateTime): TDateTime; // ; const ANumberOfYears: Integer = 1)
  970. begin
  971. Result:=IncYear(Avalue,1);
  972. end;
  973. Function IncWeek(const AValue: TDateTime; const ANumberOfWeeks: Integer): TDateTime;
  974. begin
  975. Result:=AValue+ANumberOfWeeks*7;
  976. end;
  977. Function IncWeek(const AValue: TDateTime): TDateTime; // ; const ANumberOfWeeks: Integer = 1)
  978. begin
  979. Result:=IncWeek(Avalue,1);
  980. end;
  981. Function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer): TDateTime;
  982. begin
  983. Result:=AValue+ANumberOfDays;
  984. end;
  985. Function IncDay(const AValue: TDateTime): TDateTime; //; const ANumberOfDays: Integer = 1)
  986. begin
  987. Result:=IncDay(Avalue,1);
  988. end;
  989. Function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;
  990. begin
  991. Result:=AValue+ANumberOfHours/HoursPerDay;
  992. end;
  993. Function IncHour(const AValue: TDateTime): TDateTime; //; const ANumberOfHours: Int64 = 1
  994. begin
  995. Result:=IncHour(AValue,1);
  996. end;
  997. Function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;
  998. begin
  999. Result:=AValue+ANumberOfMinutes / MinsPerDay;
  1000. end;
  1001. Function IncMinute(const AValue: TDateTime): TDateTime; // ; const ANumberOfMinutes: Int64 = 1
  1002. begin
  1003. Result:=IncMinute(AValue,1);
  1004. end;
  1005. Function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64): TDateTime;
  1006. begin
  1007. Result:=AValue+ANumberOfSeconds / SecsPerDay;
  1008. end;
  1009. Function IncSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfSeconds: Int64 = 1
  1010. begin
  1011. Result:=IncSecond(Avalue,1);
  1012. end;
  1013. Function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64): TDateTime;
  1014. begin
  1015. Result:=AValue+ANumberOfMilliSeconds/MSecsPerDay;
  1016. end;
  1017. Function IncMilliSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfMilliSeconds: Int64 = 1
  1018. begin
  1019. Result:=IncMilliSecond(AValue,1);
  1020. end;
  1021. { ---------------------------------------------------------------------
  1022. Encode/Decode of complete timestamp
  1023. ---------------------------------------------------------------------}
  1024. Function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  1025. begin
  1026. If Not TryEncodeDateTime(AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond,Result) then
  1027. InvalidDateTimeError(AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond)
  1028. end;
  1029. Procedure DecodeDateTime(const AValue: TDateTime; var AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);
  1030. begin
  1031. DecodeDate(AValue,AYear,AMonth,ADay);
  1032. DecodeTime(AValue,AHour,AMinute,ASecond,AMilliSecond);
  1033. end;
  1034. Function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AValue: TDateTime): Boolean;
  1035. Var
  1036. tmp : TDateTime;
  1037. begin
  1038. Result:=TryEncodeDate(AYear,AMonth,ADay,AValue);
  1039. Result:=Result and TryEncodeTime(AHour,AMinute,ASecond,Amillisecond,Tmp);
  1040. If Result then
  1041. Avalue:=AValue+Tmp;
  1042. end;
  1043. { ---------------------------------------------------------------------
  1044. Encode/decode date, specifying week of year and day of week
  1045. ---------------------------------------------------------------------}
  1046. Function EncodeDateWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  1047. begin
  1048. If Not TryEncodeDateWeek(AYear,AWeekOfYear,Result,ADayOfWeek) then
  1049. InvalidDateWeekError(AYear,AWeekOfYear,ADayOfWeek);
  1050. end;
  1051. Function EncodeDateWeek(const AYear, AWeekOfYear: Word): TDateTime; //; const ADayOfWeek: Word = 1
  1052. begin
  1053. Result := EncodeDateWeek(AYear,AWeekOfYear,1);
  1054. end;
  1055. Procedure DecodeDateWeek(const AValue: TDateTime; var AYear, AWeekOfYear, ADayOfWeek: Word);
  1056. var
  1057. DOY : Integer;
  1058. D: Word;
  1059. YS : TDateTime;
  1060. YSDOW, YEDOW: Word;
  1061. begin
  1062. AYear:=YearOf(AValue);
  1063. // Correct to ISO DOW
  1064. ADayOfWeek:=DayOfWeek(AValue)-1;
  1065. If ADAyOfWeek=0 then
  1066. ADayofweek:=7;
  1067. YS:=StartOfAYear(AYear);
  1068. DOY:=Trunc(AValue-YS)+1;
  1069. YSDOW:=DayOfTheWeek(YS);
  1070. // Correct week if later than wednesday. First week never starts later than wednesday
  1071. if (YSDOW<5) then
  1072. Inc(DOY,YSDOW-1)
  1073. else
  1074. Dec(DOY,8-YSDOW);
  1075. if (DOY<=0) then // Day is in last week of previous year.
  1076. DecodeDateWeek(YS-1,AYear,AWeekOfYear,D)
  1077. else
  1078. begin
  1079. AWeekOfYear:=DOY div 7;
  1080. if ((DOY mod 7)<>0) then
  1081. Inc(AWeekOfYear);
  1082. if (AWeekOfYear>52) then // Maybe in first week of next year ?
  1083. begin
  1084. YEDOW:=YSDOW;
  1085. if IsLeapYear(AYear) then
  1086. begin
  1087. Inc(YEDOW);
  1088. if (YEDOW>7) then
  1089. YEDOW:=1
  1090. else
  1091. end;
  1092. if (YEDOW<4) then // Really next year.
  1093. begin
  1094. Inc(AYear);
  1095. AWeekOfYear:=1;
  1096. end;
  1097. end;
  1098. end;
  1099. end;
  1100. Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime; const ADayOfWeek: Word): Boolean;
  1101. Var
  1102. DOW : Word;
  1103. Rest : Integer;
  1104. begin
  1105. Result:=IsValidDateWeek(Ayear,AWeekOfYear,ADayOfWeek);
  1106. If Result then
  1107. begin
  1108. AValue:=EncodeDate(AYear,1,1)+(7*(AWeekOfYear-1));
  1109. DOW:=DayOfTheWeek(AValue);
  1110. Rest:=ADayOfWeek-DOW;
  1111. If (DOW>4) then
  1112. Inc(Rest,7);
  1113. AValue:=AValue+Rest;
  1114. end;
  1115. end;
  1116. Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime): Boolean; //; const ADayOfWeek: Word = 1
  1117. begin
  1118. Result:=TryEncodeDateWeek(AYear,AWeekOfYear,AValue,1);
  1119. end;
  1120. { ---------------------------------------------------------------------
  1121. Encode/decode date, specifying day of year
  1122. ---------------------------------------------------------------------}
  1123. Function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;
  1124. begin
  1125. If Not TryEncodeDateDay(AYear,ADayOfYear,Result) then
  1126. InvalidDateDayError(AYear,ADayOfYear);
  1127. end;
  1128. Procedure DecodeDateDay(const AValue: TDateTime; var AYear, ADayOfYear: Word);
  1129. Var
  1130. M,D : Word;
  1131. begin
  1132. DecodeDate(AValue,AYear,M,D);
  1133. ADayOfyear:=Trunc(AValue-EncodeDate(AYear,1,1))+1;
  1134. end;
  1135. Function TryEncodeDateDay(const AYear, ADayOfYear: Word; var AValue: TDateTime): Boolean;
  1136. begin
  1137. Result:=(ADayOfYear<>0) and (ADayOfYear<=DaysPerYear [IsleapYear(AYear)]);
  1138. If Result then
  1139. AValue:=EncodeDate(AYear,1,1)+ADayOfYear-1;
  1140. end;
  1141. { ---------------------------------------------------------------------
  1142. Encode/decode date, specifying week of month
  1143. ---------------------------------------------------------------------}
  1144. Function EncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): TDateTime;
  1145. begin
  1146. If Not TryEncodeDateMonthWeek(Ayear,AMonth,AWeekOfMonth,ADayOfWeek,Result) then
  1147. InvalidDateMonthWeekError(AYear,AMonth,AWeekOfMonth,ADayOfWeek);
  1148. end;
  1149. Procedure DecodeDateMonthWeek(const AValue: TDateTime; var AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
  1150. Var
  1151. D,SDOM,EDOM : Word;
  1152. SOM : TdateTime;
  1153. DOM : Integer;
  1154. begin
  1155. DecodeDate(AValue,AYear,AMonth,D);
  1156. ADayOfWeek:=DayOfTheWeek(AValue);
  1157. SOM:=EncodeDate(Ayear,Amonth,1);
  1158. SDOM:=DayOfTheWeek(SOM);
  1159. DOM:=D-1+SDOM;
  1160. If SDOM>4 then
  1161. Dec(DOM,7);
  1162. // Too early in the month. First full week is next week, day is after thursday.
  1163. If DOM<=0 Then
  1164. DecodeDateMonthWeek(SOM-1,AYear,AMonth,AWeekOfMonth,D)
  1165. else
  1166. begin
  1167. AWeekOfMonth:=(DOM div 7)+Ord((DOM mod 7)<>0);
  1168. EDOM:=DayOfTheWeek(EndOfAMonth(Ayear,AMonth));
  1169. // In last days of last long week, so in next month...
  1170. If (EDOM<4) and ((DaysInAMonth(AYear,Amonth)-D)<EDOM) then
  1171. begin
  1172. AWeekOfMonth:=1;
  1173. Inc(AMonth);
  1174. If (AMonth=13) then
  1175. begin
  1176. AMonth:=1;
  1177. Inc(AYear);
  1178. end;
  1179. end;
  1180. end;
  1181. end;
  1182. Function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
  1183. var
  1184. S : Word;
  1185. DOM : Integer;
  1186. begin
  1187. Result:=IsValidDateMonthWeek(AYear,AMonth,AWeekOfMonth,ADayOfWeek);
  1188. if Result then
  1189. begin
  1190. AValue:=EncodeDate(AYear,AMonth,1);
  1191. DOM:=(AWeekOfMonth-1)*7+ADayOfWeek-1;
  1192. { Correct for first week in last month.}
  1193. S:=DayOfTheWeek(AValue);
  1194. Dec(DOM,S-1);
  1195. if S in [DayFriday..DaySunday] then
  1196. Inc(DOM,7);
  1197. AValue:=AValue+DOM;
  1198. end;
  1199. end;
  1200. { ---------------------------------------------------------------------
  1201. Replace given element with supplied value.
  1202. ---------------------------------------------------------------------}
  1203. Const
  1204. LFAI = RecodeLeaveFieldAsIS; // Less typing, readable code
  1205. {
  1206. Note: We have little choice but to implement it like Borland did:
  1207. If AValue contains some 'wrong' value, it will throw an error.
  1208. To simulate this we'd have to check in each function whether
  1209. both arguments are correct. To avoid it, all is routed through
  1210. the 'central' RecodeDateTime function as in Borland's implementation.
  1211. }
  1212. Function RecodeYear(const AValue: TDateTime; const AYear: Word): TDateTime;
  1213. begin
  1214. Result := RecodeDateTime(AValue,AYear,LFAI,LFAI,LFAI,LFAI,LFAI,LFAI);
  1215. end;
  1216. Function RecodeMonth(const AValue: TDateTime; const AMonth: Word): TDateTime;
  1217. begin
  1218. Result := RecodeDateTime(AValue,LFAI,AMonth,LFAI,LFAI,LFAI,LFAI,LFAI);
  1219. end;
  1220. Function RecodeDay(const AValue: TDateTime; const ADay: Word): TDateTime;
  1221. begin
  1222. Result := RecodeDateTime(AValue,LFAI,LFAI,ADay,LFAI,LFAI,LFAI,LFAI);
  1223. end;
  1224. Function RecodeHour(const AValue: TDateTime; const AHour: Word): TDateTime;
  1225. begin
  1226. Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,AHour,LFAI,LFAI,LFAI);
  1227. end;
  1228. Function RecodeMinute(const AValue: TDateTime; const AMinute: Word): TDateTime;
  1229. begin
  1230. Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,AMinute,LFAI,LFAI);
  1231. end;
  1232. Function RecodeSecond(const AValue: TDateTime; const ASecond: Word): TDateTime;
  1233. begin
  1234. Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,LFAI,ASecond,LFAI);
  1235. end;
  1236. Function RecodeMilliSecond(const AValue: TDateTime; const AMilliSecond: Word): TDateTime;
  1237. begin
  1238. Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,LFAI,LFAI,AMilliSecond);
  1239. end;
  1240. Function RecodeDate(const AValue: TDateTime; const AYear, AMonth, ADay: Word): TDateTime;
  1241. begin
  1242. Result := RecodeDateTime(AValue,AYear,AMonth,ADay,LFAI,LFAI,LFAI,LFAI);
  1243. end;
  1244. Function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  1245. begin
  1246. Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,AHour,AMinute,ASecond,AMilliSecond);
  1247. end;
  1248. Function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  1249. begin
  1250. If Not TryRecodeDateTime(AValue,AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,Result) then
  1251. InvalidDateTimeError(AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,AValue);
  1252. end;
  1253. Function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AResult: TDateTime): Boolean;
  1254. Procedure FV (Var AV : Word; Arg : Word);
  1255. begin
  1256. If (Arg<>LFAI) then
  1257. AV:=Arg;
  1258. end;
  1259. Var
  1260. Y,M,D,H,N,S,MS : Word;
  1261. begin
  1262. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  1263. FV(Y,AYear);
  1264. FV(M,AMonth);
  1265. FV(D,ADay);
  1266. FV(H,AHour);
  1267. FV(N,AMinute);
  1268. FV(S,ASecond);
  1269. FV(MS,AMillisecond);
  1270. Result:=TryEncodeDateTime(Y,M,D,H,N,S,MS,AResult);
  1271. end;
  1272. { ---------------------------------------------------------------------
  1273. Comparision of date/time
  1274. ---------------------------------------------------------------------}
  1275. Function CompareDateTime(const A, B: TDateTime): TValueRelationship;
  1276. begin
  1277. If SameDateTime(A,B) then
  1278. Result:=EqualsValue
  1279. else If A>B then
  1280. Result:=GreaterThanValue
  1281. else
  1282. Result:=LessThanValue
  1283. end;
  1284. Function CompareDate(const A, B: TDateTime): TValueRelationship;
  1285. begin
  1286. If SameDate(A,B) then
  1287. Result:=EQualsValue
  1288. else if A<B then
  1289. Result:=LessThanValue
  1290. else
  1291. Result:=GreaterThanValue;
  1292. end;
  1293. Function CompareTime(const A, B: TDateTime): TValueRelationship;
  1294. begin
  1295. If SameTime(A,B) then
  1296. Result:=EQualsValue
  1297. else If Frac(A)<Frac(B) then
  1298. Result:=LessThanValue
  1299. else
  1300. Result:=GreaterThanValue;
  1301. end;
  1302. Function SameDateTime(const A, B: TDateTime): Boolean;
  1303. begin
  1304. Result:=Abs(A-B)<OneMilliSecond;
  1305. end;
  1306. Function SameDate(const A, B: TDateTime): Boolean;
  1307. begin
  1308. Result:=Trunc(A)=Trunc(B);
  1309. end;
  1310. Function SameTime(const A, B: TDateTime): Boolean;
  1311. begin
  1312. Result:=Frac(Abs(A-B))<OneMilliSecond;
  1313. end;
  1314. Function InternalNthDayOfWeek(DoM : Word) : Word;
  1315. begin
  1316. Result:=(Dom-1) div 7 +1;
  1317. end;
  1318. Function NthDayOfWeek(const AValue: TDateTime): Word;
  1319. begin
  1320. Result:=InternalNthDayOfWeek(DayOfTheMonth(AValue));
  1321. end;
  1322. Procedure DecodeDayOfWeekInMonth(const AValue: TDateTime; var AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
  1323. var
  1324. D: Word;
  1325. begin
  1326. DecodeDate(AValue,AYear,AMonth,D);
  1327. ADayOfWeek:=DayOfTheWeek(AValue);
  1328. ANthDayOfWeek:=InternalNthDayOfWeek(D);
  1329. end;
  1330. Function EncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word): TDateTime;
  1331. begin
  1332. If Not TryEncodeDayOfWeekInMonth(AYear,AMonth,ANthDayOfWeek,ADayOfWeek,Result) then
  1333. InvalidDayOfWeekInMonthError(AYear,AMonth,ANthDayOfWeek,ADayOfWeek);
  1334. end;
  1335. Function TryEncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
  1336. Var
  1337. SOM,D : Word;
  1338. begin
  1339. SOM:=DayOfTheWeek(EncodeDate(Ayear,AMonth,1));
  1340. D:=1+ADayOfWeek-SOM+7*(ANthDayOfWeek-1);
  1341. If SOM>ADayOfWeek then
  1342. D:=D+7; // Clearer would have been Inc(ANthDayOfweek) but it's a const
  1343. Result:=TryEncodeDate(Ayear,AMonth,D,AValue);
  1344. end;
  1345. { ---------------------------------------------------------------------
  1346. Exception throwing routines
  1347. ---------------------------------------------------------------------}
  1348. Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
  1349. Function DoField(Arg,Def : Word; Unknown: String) : String;
  1350. begin
  1351. If (Arg<>LFAI) then
  1352. Result:=Format('%.*d',[Length(Unknown),Arg])
  1353. else if (ABaseDate=0) then
  1354. Result:=Unknown
  1355. else
  1356. Result:=Format('%.*d',[Length(Unknown),Arg]);
  1357. end;
  1358. Var
  1359. Y,M,D,H,N,S,MS : Word;
  1360. Msg : String;
  1361. begin
  1362. DecodeDateTime(ABasedate,Y,M,D,H,N,S,MS);
  1363. Msg:=DoField(AYear,Y,'????');
  1364. Msg:=Msg+DateSeparator+DoField(AMonth,M,'??');
  1365. Msg:=Msg+DateSeparator+DoField(ADay,D,'??');
  1366. Msg:=Msg+' '+DoField(AHour,H,'??');
  1367. Msg:=Msg+TimeSeparator+DoField(AMinute,N,'??');
  1368. Msg:=Msg+TimeSeparator+Dofield(ASecond,S,'??');
  1369. Msg:=Msg+DecimalSeparator+DoField(AMilliSecond,MS,'???');
  1370. Raise EConvertError.CreateFmt(SErrInvalidTimeStamp,[Msg]);
  1371. end;
  1372. Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word); // const ABaseDate: TDateTime = 0
  1373. begin
  1374. InvalidDateTimeError(AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,0);
  1375. end;
  1376. Procedure InvalidDateWeekError(const AYear, AWeekOfYear, ADayOfWeek: Word);
  1377. begin
  1378. Raise EConvertError.CreateFmt(SErrInvalidDateWeek,[AYear,AWeekOfYear,ADayOfWeek]);
  1379. end;
  1380. Procedure InvalidDateDayError(const AYear, ADayOfYear: Word);
  1381. begin
  1382. Raise EConvertError.CreateFmt(SErrInvalidDayOfYear,[AYear,ADayOfYear]);
  1383. end;
  1384. Procedure InvalidDateMonthWeekError(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
  1385. begin
  1386. Raise EConvertError.CreateFmt(SErrInvalidDateMonthWeek,[Ayear,AMonth,AWeekOfMonth,ADayOfWeek]);
  1387. end;
  1388. Procedure InvalidDayOfWeekInMonthError(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
  1389. begin
  1390. Raise EConvertError.CreateFmt(SErrInvalidDayOfWeekInMonth,[AYear,AMonth,ANthDayOfWeek,ADayOfWeek]);
  1391. end;
  1392. { ---------------------------------------------------------------------
  1393. Julian and Modified Julian Date conversion support
  1394. ---------------------------------------------------------------------}
  1395. {$ifopt R+}
  1396. {$define RangeCheckWasOn}
  1397. {$R-}
  1398. {$endif opt R+}
  1399. {$ifopt Q+}
  1400. {$define OverflowCheckWasOn}
  1401. {$Q-}
  1402. {$endif opt Q+}
  1403. Function DateTimeToJulianDate(const AValue: TDateTime): Double;
  1404. begin
  1405. DateTimeToJulianDate := AValue - JulianEpoch;
  1406. end;
  1407. Function JulianDateToDateTime(const AValue: Double): TDateTime;
  1408. begin
  1409. JulianDateToDateTime := AValue + JulianEpoch;
  1410. if(AValue <= 0) or (AValue >= 10000)then
  1411. JulianDateToDateTime := NaN;
  1412. end;
  1413. Function TryJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
  1414. begin
  1415. ADateTime := JulianDateToDateTime(AValue);
  1416. TryJulianDateToDateTime := ADateTime <> NaN;
  1417. end;
  1418. Function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
  1419. begin
  1420. Result:=0;
  1421. NotYetImplemented('DateTimeToModifiedJulianDate');
  1422. end;
  1423. Function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
  1424. begin
  1425. Result:=0;
  1426. NotYetImplemented('ModifiedJulianDateToDateTime');
  1427. end;
  1428. Function TryModifiedJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
  1429. begin
  1430. Result:=False;
  1431. NotYetImplemented('TryModifiedJulianDateToDateTime');
  1432. end;
  1433. {$ifdef RangeCheckWasOn}
  1434. {$R+}
  1435. {$undef RangeCheckWasOn}
  1436. {$endif}
  1437. {$ifdef OverflowCheckWasOn}
  1438. {$Q+}
  1439. {$undef OverflowCheckWasOn}
  1440. {$endif}
  1441. { ---------------------------------------------------------------------
  1442. Unix timestamp support.
  1443. ---------------------------------------------------------------------}
  1444. Function DateTimeToUnix(const AValue: TDateTime): Int64;
  1445. begin
  1446. Result:=SecondsBetween(UnixEpoch, AValue);
  1447. end;
  1448. Function UnixToDateTime(const AValue: Int64): TDateTime;
  1449. begin
  1450. Result:=IncSecond(UnixEpoch, AValue);
  1451. end;
  1452. Function UnixTimeStampToMac(const AValue: Int64): Int64;
  1453. const
  1454. Epoch=24107 * 24 * 3600;
  1455. begin
  1456. Result:=AValue + Epoch;
  1457. end;
  1458. { ---------------------------------------------------------------------
  1459. Mac timestamp support.
  1460. ---------------------------------------------------------------------}
  1461. Function DateTimeToMac(const AValue: TDateTime): Int64;
  1462. var
  1463. Epoch:TDateTime;
  1464. begin
  1465. Epoch:=EncodeDateTime( 1904, 1, 1, 0, 0, 0, 0 );
  1466. Result:=SecondsBetween( Epoch, AValue );
  1467. end;
  1468. Function MacToDateTime(const AValue: Int64): TDateTime;
  1469. var
  1470. Epoch:TDateTime;
  1471. begin
  1472. Epoch:=EncodeDateTime( 1904, 1, 1, 0, 0, 0, 0 );
  1473. Result:=IncSecond( Epoch, AValue );
  1474. end;
  1475. Function MacTimeStampToUnix(const AValue: Int64): Int64;
  1476. const
  1477. Epoch=24107 * 24 * 3600;
  1478. begin
  1479. Result:=AValue - Epoch;
  1480. end;
  1481. {
  1482. Inverse of formatdatetime, destined for the dateutils unit of FPC.
  1483. Limitations/implementation details:
  1484. - An inverse of FormatDateTime is not 100% an inverse, simply because one can put e.g. time tokens twice in the format string,
  1485. and scandatetime wouldn't know which time to pick.
  1486. - 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
  1487. misses chars for the "n" part.
  1488. - trailing characters are ignored.
  1489. - no support for Eastern Asian formatting characters since they are windows only.
  1490. - no MBCS support.
  1491. Extensions
  1492. - #9 eats whitespace.
  1493. - whitespace at the end of a pattern is optional.
  1494. - ? matches any char.
  1495. - Quote the above chars to really match the char.
  1496. }
  1497. const whitespace = [' ',#13,#10];
  1498. hrfactor = 1/(24);
  1499. minfactor = 1/(24*60);
  1500. secfactor = 1/(24*60*60);
  1501. mssecfactor = 1/(24*60*60*1000);
  1502. const AMPMformatting : array[0..2] of string =('am/pm','a/p','ampm');
  1503. procedure raiseexception(const s:string);
  1504. begin
  1505. raise EConvertError.Create(s);
  1506. end;
  1507. function scandatetime(const pattern:string;const s:string;const fmt:TFormatSettings;startpos:integer=1) : tdatetime;
  1508. var len ,ind : integer;
  1509. yy,mm,dd : integer;
  1510. timeval : TDateTime;
  1511. activequote: char;
  1512. procedure intscandate(ptrn:pchar;plen:integer;poffs:integer);
  1513. // poffs is the offset to
  1514. var
  1515. pind : integer;
  1516. function findimatch(const mnts:array of string;p:pchar):integer;
  1517. var i : integer;
  1518. begin
  1519. result:=-1;
  1520. i:=0;
  1521. while (i<=high(mnts)) and (result=-1) do
  1522. begin
  1523. if AnsiStrLIComp(p,@mnts[i][1],length(mnts[i]))=0 then
  1524. result:=i;
  1525. inc(i);
  1526. end;
  1527. end;
  1528. procedure arraymatcherror;
  1529. begin
  1530. raiseexception(format(SNoArrayMatch,[pind+1,ind]))
  1531. end;
  1532. function findmatch(const mnts : array of string;const s:string):integer;
  1533. begin
  1534. result:=findimatch(mnts,@s[ind]);
  1535. if result=-1 then
  1536. arraymatcherror
  1537. else
  1538. begin
  1539. inc(ind,length(mnts[result])+1);
  1540. inc(pind,length(mnts[result])+1);
  1541. inc(result); // was 0 based.
  1542. end;
  1543. end;
  1544. var
  1545. pivot,
  1546. i : integer;
  1547. function scanfixedint(maxv:integer):integer;
  1548. var c : char;
  1549. oi:integer;
  1550. begin
  1551. result:=0;
  1552. oi:=ind;
  1553. c:=ptrn[pind];
  1554. while (pind<plen) and (ptrn[pind]=c) do inc(pind);
  1555. while (maxv>0) and (ind<=len) and (s[ind] IN ['0'..'9']) do
  1556. begin
  1557. result:=result*10+ord(s[ind])-48;
  1558. inc(ind);
  1559. dec(maxv);
  1560. end;
  1561. if oi=ind then
  1562. raiseexception(format(SPatternCharMismatch,[c,oi]));
  1563. end;
  1564. procedure matchchar(c:char);
  1565. begin
  1566. if (ind>len) or (s[ind]<>c) then
  1567. raiseexception(format(SNoCharMatch,[s[ind],c,pind+poffs+1,ind]));
  1568. inc(pind);
  1569. inc(ind);
  1570. end;
  1571. function scanpatlen:integer;
  1572. var c : char;
  1573. lind : Integer;
  1574. begin
  1575. result:=pind;
  1576. lind:=pind;
  1577. c:=ptrn[lind];
  1578. while (lind<=plen) and (ptrn[lind]=c) do
  1579. inc(lind);
  1580. result:=lind-result;
  1581. end;
  1582. procedure matchpattern(const lptr:string);
  1583. var len:integer;
  1584. begin
  1585. len:=length(lptr);
  1586. if len>0 then
  1587. intscandate(@lptr[1],len,pind+poffs);
  1588. end;
  1589. var lasttoken,lch : char;
  1590. begin
  1591. pind:=0; lasttoken:=' ';
  1592. while (ind<=len) and (pind<plen) do
  1593. begin
  1594. lch:=upcase(ptrn[pind]);
  1595. if activequote=#0 then
  1596. begin
  1597. if (lch='M') and (lasttoken='H') then
  1598. begin
  1599. i:=scanpatlen;
  1600. if i>2 then
  1601. raiseexception(format(Shhmmerror,[poffs+pind+1]));
  1602. timeval:=timeval+scanfixedint(2)* minfactor;
  1603. end
  1604. else
  1605. case lch of
  1606. 'H': timeval:=timeval+scanfixedint(2)* hrfactor;
  1607. 'D': begin
  1608. i:=scanpatlen;
  1609. case i of
  1610. 1,2 : dd:=scanfixedint(2);
  1611. 3 : dd:=findmatch(fmt.shortDayNames,s);
  1612. 4 : dd:=findmatch(fmt.longDayNames,s);
  1613. 5 : matchpattern(fmt.shortdateformat);
  1614. 6 : matchpattern(fmt.longdateformat);
  1615. end;
  1616. end;
  1617. 'N': timeval:=timeval+scanfixedint(2)* minfactor;
  1618. 'S': timeval:=timeval+scanfixedint(2)* secfactor;
  1619. 'Z': timeval:=timeval+scanfixedint(3)* mssecfactor;
  1620. 'Y': begin
  1621. i:=scanpatlen;
  1622. yy:=scanfixedint(i);
  1623. if i<=2 then
  1624. begin
  1625. pivot:=YearOf(now)-fmt.TwoDigitYearCenturyWindow;
  1626. inc(yy, pivot div 100 * 100);
  1627. if (fmt.TwoDigitYearCenturyWindow > 0) and (yy < pivot) then
  1628. inc(yy, 100);
  1629. end;
  1630. end;
  1631. 'M': begin
  1632. i:=scanpatlen;
  1633. case i of
  1634. 1,2: mm:=scanfixedint(2);
  1635. 3: mm:=findmatch(fmt.ShortMonthNames,s);
  1636. 4: mm:=findmatch(fmt.LongMonthNames,s);
  1637. end;
  1638. end;
  1639. 'T' : begin
  1640. i:=scanpatlen;
  1641. case i of
  1642. 1: matchpattern(fmt.shortdateformat);
  1643. 2: matchpattern(fmt.longtimeformat);
  1644. end;
  1645. end;
  1646. 'A' : begin
  1647. i:=findimatch(AMPMformatting,@ptrn[pind]);
  1648. case i of
  1649. 0: begin
  1650. i:=findimatch(['AM','PM'],@s[ind]);
  1651. case i of
  1652. 0: ;
  1653. 1: timeval:=timeval+12*hrfactor;
  1654. else
  1655. arraymatcherror
  1656. end;
  1657. inc(pind,length(AMPMformatting[0]));
  1658. inc(ind,2);
  1659. end;
  1660. 1: begin
  1661. case upcase(s[ind]) of
  1662. 'A' : ;
  1663. 'P' : timeval:=timeval+12*hrfactor;
  1664. else
  1665. arraymatcherror
  1666. end;
  1667. inc(pind,length(AMPMformatting[1]));
  1668. inc(ind);
  1669. end;
  1670. 2: begin
  1671. i:=findimatch([fmt.timeamstring,fmt.timepmstring],@s[ind]);
  1672. case i of
  1673. 0: inc(ind,length(fmt.timeamstring));
  1674. 1: begin
  1675. timeval:=timeval+12*hrfactor;
  1676. inc(ind,length(fmt.timepmstring));
  1677. end;
  1678. else
  1679. arraymatcherror
  1680. end;
  1681. inc(pind,length(AMPMformatting[2]));
  1682. inc(pind,2);
  1683. inc(ind,2);
  1684. end;
  1685. else // no AM/PM match. Assume 'a' is simply a char
  1686. matchchar(ptrn[pind]);
  1687. end;
  1688. end;
  1689. '/' : matchchar(fmt.dateSeparator);
  1690. ':' : begin
  1691. matchchar(fmt.TimeSeparator);
  1692. lch:=lasttoken;
  1693. end;
  1694. #39,'"' : begin
  1695. activequote:=lch;
  1696. inc(pind);
  1697. end;
  1698. 'C' : begin
  1699. intscandate(@fmt.shortdateformat[1],length(fmt.ShortDateFormat),pind+poffs);
  1700. intscandate(@fmt.longtimeformat[1],length(fmt.longtimeformat),pind+poffs);
  1701. inc(pind);
  1702. end;
  1703. '?' : begin
  1704. inc(pind);
  1705. inc(ind);
  1706. end;
  1707. #9 : begin
  1708. while (ind<=len) and (s[ind] in whitespace) do
  1709. inc(ind);
  1710. inc(pind);
  1711. end;
  1712. else
  1713. matchchar(ptrn[pind]);
  1714. end; {case}
  1715. lasttoken:=lch;
  1716. end
  1717. else
  1718. begin
  1719. if activequote=lch then
  1720. begin
  1721. activequote:=#0;
  1722. inc(pind);
  1723. end
  1724. else
  1725. matchchar(ptrn[pind]);
  1726. end;
  1727. end;
  1728. if (pind<plen) and (plen>0) and (ptrn[plen-1]<>#9) then // allow omission of trailing whitespace
  1729. RaiseException(format(SFullpattern,[poffs+pind+1]));
  1730. end;
  1731. var plen:integer;
  1732. begin
  1733. activequote:=#0;
  1734. yy:=0; mm:=0; dd:=0;
  1735. timeval:=0.0;
  1736. len:=length(s); ind:=startpos;
  1737. plen:=length(pattern);
  1738. intscandate(@pattern[1],plen,0);
  1739. result:=timeval;
  1740. if (yy>0) and (mm>0) and (dd>0) then
  1741. result:=result+encodedate(yy,mm,dd);
  1742. end;
  1743. function scandatetime(const pattern:string;const s:string;startpos:integer=1) : tdatetime; overload;
  1744. begin
  1745. result:=scandatetime(pattern,s,defaultformatsettings);
  1746. end;
  1747. {$else}
  1748. implementation
  1749. {$endif FPUNONE}
  1750. end.