dateutil.inc 56 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073
  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. uses
  16. SysUtils, Math, Types;
  17. { ---------------------------------------------------------------------
  18. Various constants
  19. ---------------------------------------------------------------------}
  20. const
  21. DaysPerWeek = 7;
  22. WeeksPerFortnight = 2;
  23. MonthsPerYear = 12;
  24. YearsPerDecade = 10;
  25. YearsPerCentury = 100;
  26. YearsPerMillennium = 1000;
  27. // ISO day numbers.
  28. DayMonday = 1;
  29. DayTuesday = 2;
  30. DayWednesday = 3;
  31. DayThursday = 4;
  32. DayFriday = 5;
  33. DaySaturday = 6;
  34. DaySunday = 7;
  35. // Fraction of a day
  36. OneHour = 1/HoursPerDay;
  37. OneMinute = 1/MinsPerDay;
  38. OneSecond = 1/SecsPerDay;
  39. OneMillisecond = 1/MSecsPerDay;
  40. { This is actual days per year but you need to know if it's a leap year}
  41. DaysPerYear: array [Boolean] of Word = (365, 366);
  42. { Used in RecodeDate, RecodeTime and RecodeDateTime for those datetime }
  43. { fields you want to leave alone }
  44. RecodeLeaveFieldAsIs = High(Word);
  45. { ---------------------------------------------------------------------
  46. Global variables used in this unit
  47. ---------------------------------------------------------------------}
  48. Const
  49. { Average over a 4 year span. Valid for next 100 years }
  50. ApproxDaysPerMonth: Double = 30.4375;
  51. ApproxDaysPerYear: Double = 365.25;
  52. { ---------------------------------------------------------------------
  53. Simple trimming functions.
  54. ---------------------------------------------------------------------}
  55. Function DateOf(const AValue: TDateTime): TDateTime;
  56. Function TimeOf(const AValue: TDateTime): TDateTime;
  57. { ---------------------------------------------------------------------
  58. Identification functions.
  59. ---------------------------------------------------------------------}
  60. Function IsInLeapYear(const AValue: TDateTime): Boolean;
  61. Function IsPM(const AValue: TDateTime): Boolean;
  62. Function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;
  63. Function IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
  64. Function IsValidDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
  65. Function IsValidDateDay(const AYear, ADayOfYear: Word): Boolean;
  66. Function IsValidDateWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): Boolean;
  67. Function IsValidDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): Boolean;
  68. { ---------------------------------------------------------------------
  69. Enumeration functions.
  70. ---------------------------------------------------------------------}
  71. Function WeeksInYear(const AValue: TDateTime): Word;
  72. Function WeeksInAYear(const AYear: Word): Word;
  73. Function DaysInYear(const AValue: TDateTime): Word;
  74. Function DaysInAYear(const AYear: Word): Word;
  75. Function DaysInMonth(const AValue: TDateTime): Word;
  76. Function DaysInAMonth(const AYear, AMonth: Word): Word;
  77. { ---------------------------------------------------------------------
  78. Variations on current date/time.
  79. ---------------------------------------------------------------------}
  80. Function Today: TDateTime;
  81. Function Yesterday: TDateTime;
  82. Function Tomorrow: TDateTime;
  83. Function IsToday(const AValue: TDateTime): Boolean;
  84. Function IsSameDay(const AValue, ABasis: TDateTime): Boolean;
  85. Function PreviousDayOfWeek (DayOfWeek : Word) : Word;
  86. { ---------------------------------------------------------------------
  87. Extraction functions.
  88. ---------------------------------------------------------------------}
  89. Function YearOf(const AValue: TDateTime): Word;
  90. Function MonthOf(const AValue: TDateTime): Word;
  91. Function WeekOf(const AValue: TDateTime): Word;
  92. Function DayOf(const AValue: TDateTime): Word;
  93. Function HourOf(const AValue: TDateTime): Word;
  94. Function MinuteOf(const AValue: TDateTime): Word;
  95. Function SecondOf(const AValue: TDateTime): Word;
  96. Function MilliSecondOf(const AValue: TDateTime): Word;
  97. { ---------------------------------------------------------------------
  98. Start/End of year functions.
  99. ---------------------------------------------------------------------}
  100. Function StartOfTheYear(const AValue: TDateTime): TDateTime;
  101. Function EndOfTheYear(const AValue: TDateTime): TDateTime;
  102. Function StartOfAYear(const AYear: Word): TDateTime;
  103. Function EndOfAYear(const AYear: Word): TDateTime;
  104. { ---------------------------------------------------------------------
  105. Start/End of month functions.
  106. ---------------------------------------------------------------------}
  107. Function StartOfTheMonth(const AValue: TDateTime): TDateTime;
  108. Function EndOfTheMonth(const AValue: TDateTime): TDateTime;
  109. Function StartOfAMonth(const AYear, AMonth: Word): TDateTime;
  110. Function EndOfAMonth(const AYear, AMonth: Word): TDateTime;
  111. { ---------------------------------------------------------------------
  112. Start/End of week functions.
  113. ---------------------------------------------------------------------}
  114. Function StartOfTheWeek(const AValue: TDateTime): TDateTime;
  115. Function EndOfTheWeek(const AValue: TDateTime): TDateTime;
  116. Function StartOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  117. Function StartOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // ADayOFWeek 1
  118. Function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  119. Function EndOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // const ADayOfWeek: Word = 7
  120. { ---------------------------------------------------------------------
  121. Start/End of day functions.
  122. ---------------------------------------------------------------------}
  123. Function StartOfTheDay(const AValue: TDateTime): TDateTime;
  124. Function EndOfTheDay(const AValue: TDateTime): TDateTime;
  125. Function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime; overload;
  126. Function StartOfADay(const AYear, ADayOfYear: Word): TDateTime; overload;
  127. Function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime; overload;
  128. Function EndOfADay(const AYear, ADayOfYear: Word): TDateTime; overload;
  129. { ---------------------------------------------------------------------
  130. Part of year functions.
  131. ---------------------------------------------------------------------}
  132. Function MonthOfTheYear(const AValue: TDateTime): Word;
  133. Function WeekOfTheYear(const AValue: TDateTime): Word; overload;
  134. Function WeekOfTheYear(const AValue: TDateTime; var AYear: Word): Word; overload;
  135. Function DayOfTheYear(const AValue: TDateTime): Word;
  136. Function HourOfTheYear(const AValue: TDateTime): Word;
  137. Function MinuteOfTheYear(const AValue: TDateTime): LongWord;
  138. Function SecondOfTheYear(const AValue: TDateTime): LongWord;
  139. Function MilliSecondOfTheYear(const AValue: TDateTime): Int64;
  140. { ---------------------------------------------------------------------
  141. Part of month functions.
  142. ---------------------------------------------------------------------}
  143. Function WeekOfTheMonth(const AValue: TDateTime): Word; overload;
  144. Function WeekOfTheMonth(const AValue: TDateTime; var AYear, AMonth: Word): Word; overload;
  145. Function DayOfTheMonth(const AValue: TDateTime): Word;
  146. Function HourOfTheMonth(const AValue: TDateTime): Word;
  147. Function MinuteOfTheMonth(const AValue: TDateTime): Word;
  148. Function SecondOfTheMonth(const AValue: TDateTime): LongWord;
  149. Function MilliSecondOfTheMonth(const AValue: TDateTime): LongWord;
  150. { ---------------------------------------------------------------------
  151. Part of week functions.
  152. ---------------------------------------------------------------------}
  153. Function DayOfTheWeek(const AValue: TDateTime): Word;
  154. Function HourOfTheWeek(const AValue: TDateTime): Word;
  155. Function MinuteOfTheWeek(const AValue: TDateTime): Word;
  156. Function SecondOfTheWeek(const AValue: TDateTime): LongWord;
  157. Function MilliSecondOfTheWeek(const AValue: TDateTime): LongWord;
  158. { ---------------------------------------------------------------------
  159. Part of day functions.
  160. ---------------------------------------------------------------------}
  161. Function HourOfTheDay(const AValue: TDateTime): Word;
  162. Function MinuteOfTheDay(const AValue: TDateTime): Word;
  163. Function SecondOfTheDay(const AValue: TDateTime): LongWord;
  164. Function MilliSecondOfTheDay(const AValue: TDateTime): LongWord;
  165. { ---------------------------------------------------------------------
  166. Part of hour functions.
  167. ---------------------------------------------------------------------}
  168. Function MinuteOfTheHour(const AValue: TDateTime): Word;
  169. Function SecondOfTheHour(const AValue: TDateTime): Word;
  170. Function MilliSecondOfTheHour(const AValue: TDateTime): LongWord;
  171. { ---------------------------------------------------------------------
  172. Part of minute functions.
  173. ---------------------------------------------------------------------}
  174. Function SecondOfTheMinute(const AValue: TDateTime): Word;
  175. Function MilliSecondOfTheMinute(const AValue: TDateTime): LongWord;
  176. { ---------------------------------------------------------------------
  177. Part of second functions.
  178. ---------------------------------------------------------------------}
  179. Function MilliSecondOfTheSecond(const AValue: TDateTime): Word;
  180. { ---------------------------------------------------------------------
  181. Range checking functions.
  182. ---------------------------------------------------------------------}
  183. Function WithinPastYears(const ANow, AThen: TDateTime; const AYears: Integer): Boolean;
  184. Function WithinPastMonths(const ANow, AThen: TDateTime; const AMonths: Integer): Boolean;
  185. Function WithinPastWeeks(const ANow, AThen: TDateTime; const AWeeks: Integer): Boolean;
  186. Function WithinPastDays(const ANow, AThen: TDateTime; const ADays: Integer): Boolean;
  187. Function WithinPastHours(const ANow, AThen: TDateTime; const AHours: Int64): Boolean;
  188. Function WithinPastMinutes(const ANow, AThen: TDateTime; const AMinutes: Int64): Boolean;
  189. Function WithinPastSeconds(const ANow, AThen: TDateTime; const ASeconds: Int64): Boolean;
  190. Function WithinPastMilliSeconds(const ANow, AThen: TDateTime; const AMilliSeconds: Int64): Boolean;
  191. { ---------------------------------------------------------------------
  192. Period functions.
  193. ---------------------------------------------------------------------}
  194. Function YearsBetween(const ANow, AThen: TDateTime): Integer;
  195. Function MonthsBetween(const ANow, AThen: TDateTime): Integer;
  196. Function WeeksBetween(const ANow, AThen: TDateTime): Integer;
  197. Function DaysBetween(const ANow, AThen: TDateTime): Integer;
  198. Function HoursBetween(const ANow, AThen: TDateTime): Int64;
  199. Function MinutesBetween(const ANow, AThen: TDateTime): Int64;
  200. Function SecondsBetween(const ANow, AThen: TDateTime): Int64;
  201. Function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;
  202. { ---------------------------------------------------------------------
  203. Timespan in xxx functions.
  204. ---------------------------------------------------------------------}
  205. { YearSpan and MonthSpan are approximate values }
  206. Function YearSpan(const ANow, AThen: TDateTime): Double;
  207. Function MonthSpan(const ANow, AThen: TDateTime): Double;
  208. Function WeekSpan(const ANow, AThen: TDateTime): Double;
  209. Function DaySpan(const ANow, AThen: TDateTime): Double;
  210. Function HourSpan(const ANow, AThen: TDateTime): Double;
  211. Function MinuteSpan(const ANow, AThen: TDateTime): Double;
  212. Function SecondSpan(const ANow, AThen: TDateTime): Double;
  213. Function MilliSecondSpan(const ANow, AThen: TDateTime): Double;
  214. { ---------------------------------------------------------------------
  215. Increment/decrement functions.
  216. ---------------------------------------------------------------------}
  217. Function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer ): TDateTime;
  218. Function IncYear(const AValue: TDateTime): TDateTime; // ; const ANumberOfYears: Integer = 1)
  219. // Function IncMonth is in SysUtils
  220. Function IncWeek(const AValue: TDateTime; const ANumberOfWeeks: Integer): TDateTime;
  221. Function IncWeek(const AValue: TDateTime): TDateTime; // ; const ANumberOfWeeks: Integer = 1)
  222. Function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer): TDateTime;
  223. Function IncDay(const AValue: TDateTime): TDateTime; //; const ANumberOfDays: Integer = 1)
  224. Function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;
  225. Function IncHour(const AValue: TDateTime): TDateTime; //; const ANumberOfHours: Int64 = 1
  226. Function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;
  227. Function IncMinute(const AValue: TDateTime): TDateTime; // ; const ANumberOfMinutes: Int64 = 1
  228. Function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64): TDateTime;
  229. Function IncSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfSeconds: Int64 = 1
  230. Function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64): TDateTime;
  231. Function IncMilliSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfMilliSeconds: Int64 = 1
  232. { ---------------------------------------------------------------------
  233. Encode/Decode of complete timestamp
  234. ---------------------------------------------------------------------}
  235. Function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  236. Procedure DecodeDateTime(const AValue: TDateTime; var AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);
  237. Function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AValue: TDateTime): Boolean;
  238. { ---------------------------------------------------------------------
  239. Encode/decode date, specifying week of year and day of week
  240. ---------------------------------------------------------------------}
  241. Function EncodeDateWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  242. Function EncodeDateWeek(const AYear, AWeekOfYear: Word): TDateTime; //; const ADayOfWeek: Word = 1
  243. Procedure DecodeDateWeek(const AValue: TDateTime; var AYear, AWeekOfYear, ADayOfWeek: Word);
  244. Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime; const ADayOfWeek: Word): Boolean;
  245. Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime): Boolean; //; const ADayOfWeek: Word = 1
  246. { ---------------------------------------------------------------------
  247. Encode/decode date, specifying day of year
  248. ---------------------------------------------------------------------}
  249. Function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;
  250. Procedure DecodeDateDay(const AValue: TDateTime; var AYear, ADayOfYear: Word);
  251. Function TryEncodeDateDay(const AYear, ADayOfYear: Word; var AValue: TDateTime): Boolean;
  252. { ---------------------------------------------------------------------
  253. Encode/decode date, specifying week of month
  254. ---------------------------------------------------------------------}
  255. Function EncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): TDateTime;
  256. Procedure DecodeDateMonthWeek(const AValue: TDateTime; var AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
  257. Function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
  258. { ---------------------------------------------------------------------
  259. Replace given element with supplied value.
  260. ---------------------------------------------------------------------}
  261. Function RecodeYear(const AValue: TDateTime; const AYear: Word): TDateTime;
  262. Function RecodeMonth(const AValue: TDateTime; const AMonth: Word): TDateTime;
  263. Function RecodeDay(const AValue: TDateTime; const ADay: Word): TDateTime;
  264. Function RecodeHour(const AValue: TDateTime; const AHour: Word): TDateTime;
  265. Function RecodeMinute(const AValue: TDateTime; const AMinute: Word): TDateTime;
  266. Function RecodeSecond(const AValue: TDateTime; const ASecond: Word): TDateTime;
  267. Function RecodeMilliSecond(const AValue: TDateTime; const AMilliSecond: Word): TDateTime;
  268. Function RecodeDate(const AValue: TDateTime; const AYear, AMonth, ADay: Word): TDateTime;
  269. Function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  270. Function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  271. Function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AResult: TDateTime): Boolean;
  272. { ---------------------------------------------------------------------
  273. Comparision of date/time
  274. ---------------------------------------------------------------------}
  275. Function CompareDateTime(const A, B: TDateTime): TValueRelationship;
  276. Function CompareDate(const A, B: TDateTime): TValueRelationship;
  277. Function CompareTime(const A, B: TDateTime): TValueRelationship;
  278. Function SameDateTime(const A, B: TDateTime): Boolean;
  279. Function SameDate(const A, B: TDateTime): Boolean;
  280. Function SameTime(const A, B: TDateTime): Boolean;
  281. { For a given date these Functions tell you the which day of the week of the
  282. month (or year). If its a Thursday, they will tell you if its the first,
  283. second, etc Thursday of the month (or year). Remember, even though its
  284. the first Thursday of the year it doesn't mean its the first week of the
  285. year. See ISO 8601 above for more information. }
  286. Function NthDayOfWeek(const AValue: TDateTime): Word;
  287. Procedure DecodeDayOfWeekInMonth(const AValue: TDateTime; var AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
  288. Function EncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word): TDateTime;
  289. Function TryEncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
  290. { ---------------------------------------------------------------------
  291. Exception throwing routines
  292. ---------------------------------------------------------------------}
  293. Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
  294. Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word); // const ABaseDate: TDateTime = 0
  295. Procedure InvalidDateWeekError(const AYear, AWeekOfYear, ADayOfWeek: Word);
  296. Procedure InvalidDateDayError(const AYear, ADayOfYear: Word);
  297. Procedure InvalidDateMonthWeekError(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
  298. Procedure InvalidDayOfWeekInMonthError(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
  299. { ---------------------------------------------------------------------
  300. Julian and Modified Julian Date conversion support
  301. ---------------------------------------------------------------------}
  302. Function DateTimeToJulianDate(const AValue: TDateTime): Double;
  303. Function JulianDateToDateTime(const AValue: Double): TDateTime;
  304. Function TryJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
  305. Function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
  306. Function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
  307. Function TryModifiedJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
  308. { ---------------------------------------------------------------------
  309. Unix timestamp support.
  310. ---------------------------------------------------------------------}
  311. Function DateTimeToUnix(const AValue: TDateTime): Int64;
  312. Function UnixToDateTime(const AValue: Int64): TDateTime;
  313. Function UnixTimeStampToMac(const AValue: Int64): Int64;
  314. { ---------------------------------------------------------------------
  315. Mac timestamp support.
  316. ---------------------------------------------------------------------}
  317. Function DateTimeToMac(const AValue: TDateTime): Int64;
  318. Function MacToDateTime(const AValue: Int64): TDateTime;
  319. Function MacTimeStampToUnix(const AValue: Int64): Int64;
  320. implementation
  321. uses sysconst;
  322. { ---------------------------------------------------------------------
  323. Auxiliary routines
  324. ---------------------------------------------------------------------}
  325. Procedure NotYetImplemented (FN : String);
  326. begin
  327. Raise Exception.CreateFmt('Function "%s" (dateutils) is not yet implemented',[FN]);
  328. end;
  329. { ---------------------------------------------------------------------
  330. Simple trimming functions.
  331. ---------------------------------------------------------------------}
  332. Function DateOf(const AValue: TDateTime): TDateTime;
  333. begin
  334. Result:=Trunc(AValue);
  335. end;
  336. Function TimeOf(const AValue: TDateTime): TDateTime;
  337. begin
  338. Result:=Frac(Avalue);
  339. end;
  340. { ---------------------------------------------------------------------
  341. Identification functions.
  342. ---------------------------------------------------------------------}
  343. Function IsInLeapYear(const AValue: TDateTime): Boolean;
  344. Var
  345. D,Y,M : Word;
  346. begin
  347. DecodeDate(AValue,Y,M,D);
  348. Result:=IsLeapYear(Y);
  349. end;
  350. Function IsPM(const AValue: TDateTime): Boolean;
  351. Var
  352. H,M,S,MS : Word;
  353. begin
  354. DecodeTime(AValue,H,M,S,MS);
  355. Result:=(H>=12);
  356. end;
  357. Function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;
  358. begin
  359. Result:=(AYear<>0) and (AYear<10000)
  360. and (AMonth in [1..12])
  361. and (ADay<>0) and (ADay<=MonthDays[IsleapYear(AYear),AMonth]);
  362. end;
  363. Function IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
  364. begin
  365. Result:=(AHour=HoursPerDay) and (AMinute=0) and (ASecond=0) and (AMillisecond=0);
  366. Result:=Result or
  367. ((AHour<HoursPerDay) and (AMinute<MinsPerHour) and (ASecond<SecsPerMin) and
  368. (AMillisecond<MSecsPerSec));
  369. end;
  370. Function IsValidDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
  371. begin
  372. Result:=IsValidDate(AYear,AMonth,ADay) and
  373. IsValidTime(AHour,AMinute,ASecond,AMillisecond)
  374. end;
  375. Function IsValidDateDay(const AYear, ADayOfYear: Word): Boolean;
  376. begin
  377. Result:=(AYear<>0) and (ADayOfYear<>0) and (AYear<10000) and
  378. (ADayOfYear<=DaysPerYear[IsLeapYear(AYear)]);
  379. end;
  380. Function IsValidDateWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): Boolean;
  381. begin
  382. Result:=(AYear<>0) and (AYear<10000)
  383. and (ADayOfWeek in [1..7])
  384. and (AWeekOfYear<>0)
  385. and (AWeekOfYear<=WeeksInaYear(AYear));
  386. { should we not also check whether the day of the week is not
  387. larger than the last day of the last week in the year 9999 ?? }
  388. end;
  389. Function IsValidDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): Boolean;
  390. begin
  391. Result:=(AYear<>0) and (AYear<10000)
  392. and (AMonth in [1..12])
  393. and (AWeekOfMonth in [1..5])
  394. and (ADayOfWeek in [1..7]);
  395. end;
  396. { ---------------------------------------------------------------------
  397. Enumeration functions.
  398. ---------------------------------------------------------------------}
  399. Function WeeksInYear(const AValue: TDateTime): Word;
  400. Var
  401. Y,M,D : Word;
  402. begin
  403. DecodeDate(AValue,Y,M,D);
  404. Result:=WeeksInAYear(Y);
  405. end;
  406. Function WeeksInAYear(const AYear: Word): Word;
  407. Var
  408. DOW : Word;
  409. begin
  410. Result:=52;
  411. DOW:=DayOfTheWeek(StartOfAYear(AYear));
  412. If (DOW=4) or ((DOW=3) and IsLeapYear(AYear)) then
  413. Inc(Result);
  414. end;
  415. Function DaysInYear(const AValue: TDateTime): Word;
  416. Var
  417. Y,M,D : Word;
  418. begin
  419. DecodeDate(AValue,Y,M,D);
  420. Result:=DaysPerYear[IsLeapYear(Y)];
  421. end;
  422. Function DaysInAYear(const AYear: Word): Word;
  423. begin
  424. Result:=DaysPerYear[Isleapyear(AYear)];
  425. end;
  426. Function DaysInMonth(const AValue: TDateTime): Word;
  427. Var
  428. Y,M,D : Word;
  429. begin
  430. Decodedate(AValue,Y,M,D);
  431. Result:=MonthDays[IsLeapYear(Y),M];
  432. end;
  433. Function DaysInAMonth(const AYear, AMonth: Word): Word;
  434. begin
  435. Result:=MonthDays[IsLeapYear(AYear),AMonth];
  436. end;
  437. { ---------------------------------------------------------------------
  438. Variations on current date/time.
  439. ---------------------------------------------------------------------}
  440. Function Today: TDateTime;
  441. begin
  442. Result:=Date;
  443. end;
  444. Function Yesterday: TDateTime;
  445. begin
  446. Result:=Date-1;
  447. end;
  448. Function Tomorrow: TDateTime;
  449. begin
  450. Result:=Date+1;
  451. end;
  452. Function IsToday(const AValue: TDateTime): Boolean;
  453. begin
  454. Result:=IsSameDay(AValue,Date);
  455. end;
  456. Function IsSameDay(const AValue, ABasis: TDateTime): Boolean;
  457. Var
  458. D : TDateTime;
  459. begin
  460. D:=AValue-Trunc(ABasis);
  461. Result:=(D>=0) and (D<1);
  462. end;
  463. const
  464. DOWMap: array [1..7] of Word = (7, 1, 2, 3, 4, 5, 6);
  465. Function PreviousDayOfWeek (DayOfWeek : Word) : Word;
  466. begin
  467. If Not (DayOfWeek in [1..7]) then
  468. Raise EConvertError.CreateFmt(SErrInvalidDayOfWeek,[DayOfWeek]);
  469. Result:=DOWMap[DayOfWeek];
  470. end;
  471. { ---------------------------------------------------------------------
  472. Extraction functions.
  473. ---------------------------------------------------------------------}
  474. Function YearOf(const AValue: TDateTime): Word;
  475. Var
  476. D,M : Word;
  477. begin
  478. DecodeDate(AValue,Result,D,M);
  479. end;
  480. Function MonthOf(const AValue: TDateTime): Word;
  481. Var
  482. Y,D : Word;
  483. begin
  484. DecodeDate(AValue,Y,Result,D);
  485. end;
  486. Function WeekOf(const AValue: TDateTime): Word;
  487. begin
  488. Result:=WeekOfTheYear(AValue);
  489. end;
  490. Function DayOf(const AValue: TDateTime): Word;
  491. Var
  492. Y,M : Word;
  493. begin
  494. DecodeDate(AValue,Y,M,Result);
  495. end;
  496. Function HourOf(const AValue: TDateTime): Word;
  497. Var
  498. N,S,MS : Word;
  499. begin
  500. DecodeTime(AValue,Result,N,S,MS);
  501. end;
  502. Function MinuteOf(const AValue: TDateTime): Word;
  503. Var
  504. H,S,MS : Word;
  505. begin
  506. DecodeTime(AValue,H,Result,S,MS);
  507. end;
  508. Function SecondOf(const AValue: TDateTime): Word;
  509. Var
  510. H,N,MS : Word;
  511. begin
  512. DecodeTime(AVAlue,H,N,Result,MS);
  513. end;
  514. Function MilliSecondOf(const AValue: TDateTime): Word;
  515. Var
  516. H,N,S : Word;
  517. begin
  518. DecodeTime(AValue,H,N,S,Result);
  519. end;
  520. { ---------------------------------------------------------------------
  521. Start/End of year functions.
  522. ---------------------------------------------------------------------}
  523. Function StartOfTheYear(const AValue: TDateTime): TDateTime;
  524. Var
  525. Y,M,D : Word;
  526. begin
  527. DecodeDate(AValue,Y,M,D);
  528. Result:=EncodeDate(Y,1,1);
  529. end;
  530. Function EndOfTheYear(const AValue: TDateTime): TDateTime;
  531. Var
  532. Y,M,D : Word;
  533. begin
  534. DecodeDate(AValue,Y,M,D);
  535. Result:=EncodeDateTime(Y,12,31,23,59,59,999);
  536. end;
  537. Function StartOfAYear(const AYear: Word): TDateTime;
  538. begin
  539. Result:=EncodeDate(AYear,1,1);
  540. end;
  541. Function EndOfAYear(const AYear: Word): TDateTime;
  542. begin
  543. Result:=(EncodeDateTime(AYear,12,31,23,59,59,999));
  544. end;
  545. { ---------------------------------------------------------------------
  546. Start/End of month functions.
  547. ---------------------------------------------------------------------}
  548. Function StartOfTheMonth(const AValue: TDateTime): TDateTime;
  549. Var
  550. Y,M,D : Word;
  551. begin
  552. DecodeDate(AValue,Y,M,D);
  553. Result:=EncodeDate(Y,M,1);
  554. // MonthDays[IsLeapYear(Y),M])
  555. end;
  556. Function EndOfTheMonth(const AValue: TDateTime): TDateTime;
  557. Var
  558. Y,M,D : Word;
  559. begin
  560. DecodeDate(AValue,Y,M,D);
  561. Result:=EncodeDateTime(Y,M,MonthDays[IsLeapYear(Y),M],23,59,59,999);
  562. end;
  563. Function StartOfAMonth(const AYear, AMonth: Word): TDateTime;
  564. begin
  565. Result:=EncodeDate(AYear,AMonth,1);
  566. end;
  567. Function EndOfAMonth(const AYear, AMonth: Word): TDateTime;
  568. begin
  569. Result:=EncodeDateTime(AYear,AMonth,MonthDays[IsLeapYear(AYear),AMonth],23,59,59,999);
  570. end;
  571. { ---------------------------------------------------------------------
  572. Start/End of week functions.
  573. ---------------------------------------------------------------------}
  574. Function StartOfTheWeek(const AValue: TDateTime): TDateTime;
  575. begin
  576. Result:=Trunc(AValue)-DayOfTheWeek(AValue)+1;
  577. end;
  578. Function EndOfTheWeek(const AValue: TDateTime): TDateTime;
  579. begin
  580. Result:=EndOfTheDay(AValue-DayOfTheWeek(AValue)+7);
  581. end;
  582. Function StartOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  583. begin
  584. Result:=EncodeDateWeek(AYear,AWeekOfYear,ADayOfWeek);
  585. end;
  586. Function StartOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // ADayOFWeek 1
  587. begin
  588. Result:=StartOfAWeek(AYear,AWeekOfYear,1)
  589. end;
  590. Function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  591. begin
  592. Result := EndOfTheDay(EncodeDateWeek(AYear, AWeekOfYear, ADayOfWeek));
  593. end;
  594. Function EndOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // const ADayOfWeek: Word = 7
  595. begin
  596. Result:=EndOfAWeek(AYear,AWeekOfYear,7);
  597. end;
  598. { ---------------------------------------------------------------------
  599. Start/End of day functions.
  600. ---------------------------------------------------------------------}
  601. Function StartOfTheDay(const AValue: TDateTime): TDateTime;
  602. begin
  603. StartOfTheDay:=Trunc(Avalue);
  604. end;
  605. Function EndOfTheDay(const AValue: TDateTime): TDateTime;
  606. Var
  607. Y,M,D : Word;
  608. begin
  609. DecodeDate(AValue,Y,M,D);
  610. Result:=EncodeDateTime(Y,M,D,23,59,59,999);
  611. end;
  612. Function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime;
  613. begin
  614. Result:=EncodeDate(AYear,AMonth,ADay);
  615. end;
  616. Function StartOfADay(const AYear, ADayOfYear: Word): TDateTime;
  617. begin
  618. Result:=StartOfAYear(AYear)+ADayOfYear-1;
  619. end;
  620. Function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime;
  621. begin
  622. Result:=EndOfTheDay(EncodeDate(AYear,AMonth,ADay));
  623. end;
  624. Function EndOfADay(const AYear, ADayOfYear: Word): TDateTime;
  625. begin
  626. Result:=StartOfAYear(AYear)+ADayOfYear-1+EncodeTime(23,59,59,999);
  627. end;
  628. { ---------------------------------------------------------------------
  629. Part of year functions.
  630. ---------------------------------------------------------------------}
  631. Function MonthOfTheYear(const AValue: TDateTime): Word;
  632. Var
  633. Y,D : Word;
  634. begin
  635. DecodeDate(AValue,Y,Result,D);
  636. end;
  637. Function WeekOfTheYear(const AValue: TDateTime): Word;
  638. Var
  639. Y,DOW : Word;
  640. begin
  641. DecodeDateWeek(AValue,Y,Result,DOW)
  642. end;
  643. Function WeekOfTheYear(const AValue: TDateTime; var AYear: Word): Word;
  644. Var
  645. DOW : Word;
  646. begin
  647. DecodeDateWeek(AValue,AYear,Result,DOW);
  648. end;
  649. Function DayOfTheYear(const AValue: TDateTime): Word;
  650. begin
  651. Result:=Trunc(AValue-StartOfTheYear(AValue)+1);
  652. end;
  653. Function HourOfTheYear(const AValue: TDateTime): Word;
  654. Var
  655. H,M,S,MS : Word;
  656. begin
  657. DecodeTime(AValue,H,M,S,MS);
  658. Result:=H+((DayOfTheYear(AValue)-1)*24);
  659. end;
  660. Function MinuteOfTheYear(const AValue: TDateTime): LongWord;
  661. Var
  662. H,M,S,MS : Word;
  663. begin
  664. DecodeTime(AValue,H,M,S,MS);
  665. Result:=M+(H+((DayOfTheYear(AValue)-1)*24))*60;
  666. end;
  667. Function SecondOfTheYear(const AValue: TDateTime): LongWord;
  668. Var
  669. H,M,S,MS : Word;
  670. begin
  671. DecodeTime(AValue,H,M,S,MS);
  672. Result:=(M+(H+((DayOfTheYear(AValue)-1)*24))*60)*60+S;
  673. end;
  674. Function MilliSecondOfTheYear(const AValue: TDateTime): Int64;
  675. Var
  676. H,M,S,MS : Word;
  677. begin
  678. DecodeTime(AValue,H,M,S,MS);
  679. Result:=((M+(H+((int64(DayOfTheYear(AValue))-1)*24))*60)*60+S)*1000+MS;
  680. end;
  681. { ---------------------------------------------------------------------
  682. Part of month functions.
  683. ---------------------------------------------------------------------}
  684. Function WeekOfTheMonth(const AValue: TDateTime): Word;
  685. var
  686. Y,M,DOW : word;
  687. begin
  688. DecodeDateMonthWeek(AValue,Y,M,Result,DOW);
  689. end;
  690. Function WeekOfTheMonth(const AValue: TDateTime; var AYear, AMonth: Word): Word;
  691. Var
  692. DOW : Word;
  693. begin
  694. DecodeDateMonthWeek(AValue,AYear,AMonth,Result,DOW);
  695. end;
  696. Function DayOfTheMonth(const AValue: TDateTime): Word;
  697. Var
  698. Y,M : Word;
  699. begin
  700. DecodeDate(AValue,Y,M,Result);
  701. end;
  702. Function HourOfTheMonth(const AValue: TDateTime): Word;
  703. Var
  704. Y,M,D,H,N,S,MS : Word;
  705. begin
  706. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  707. Result:=(D-1)*24+H;
  708. end;
  709. Function MinuteOfTheMonth(const AValue: TDateTime): Word;
  710. Var
  711. Y,M,D,H,N,S,MS : Word;
  712. begin
  713. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  714. Result:=((D-1)*24+H)*60+N;
  715. end;
  716. Function SecondOfTheMonth(const AValue: TDateTime): LongWord;
  717. Var
  718. Y,M,D,H,N,S,MS : Word;
  719. begin
  720. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  721. Result:=(((D-1)*24+H)*60+N)*60+S;
  722. end;
  723. Function MilliSecondOfTheMonth(const AValue: TDateTime): LongWord;
  724. Var
  725. Y,M,D,H,N,S,MS : Word;
  726. begin
  727. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  728. Result:=((((D-1)*24+H)*60+N)*60+S)*1000+MS;
  729. end;
  730. { ---------------------------------------------------------------------
  731. Part of week functions.
  732. ---------------------------------------------------------------------}
  733. Function DayOfTheWeek(const AValue: TDateTime): Word;
  734. begin
  735. Result:=DowMAP[DayOfWeek(AValue)];
  736. end;
  737. Function HourOfTheWeek(const AValue: TDateTime): Word;
  738. Var
  739. H,M,S,MS : Word;
  740. begin
  741. DecodeTime(AValue,H,M,S,MS);
  742. Result:=(DayOfTheWeek(AValue)-1)*24+H;
  743. end;
  744. Function MinuteOfTheWeek(const AValue: TDateTime): Word;
  745. Var
  746. H,M,S,MS : Word;
  747. begin
  748. DecodeTime(AValue,H,M,S,MS);
  749. Result:=((DayOfTheWeek(AValue)-1)*24+H)*60+M;
  750. end;
  751. Function SecondOfTheWeek(const AValue: TDateTime): LongWord;
  752. Var
  753. H,M,S,MS : Word;
  754. begin
  755. DecodeTime(AValue,H,M,S,MS);
  756. Result:=(((DayOfTheWeek(AValue)-1)*24+H)*60+M)*60+S;
  757. end;
  758. Function MilliSecondOfTheWeek(const AValue: TDateTime): LongWord;
  759. Var
  760. H,M,S,MS : Word;
  761. begin
  762. DecodeTime(AValue,H,M,S,MS);
  763. Result:=((((DayOfTheWeek(AValue)-1)*24+H)*60+M)*60+S)*1000+MS;
  764. end;
  765. { ---------------------------------------------------------------------
  766. Part of day functions.
  767. ---------------------------------------------------------------------}
  768. Function HourOfTheDay(const AValue: TDateTime): Word;
  769. Var
  770. M,S,MS : Word;
  771. begin
  772. DecodeTime(AValue,Result,M,S,MS);
  773. end;
  774. Function MinuteOfTheDay(const AValue: TDateTime): Word;
  775. Var
  776. H,M,S,MS : Word;
  777. begin
  778. DecodeTime(AValue,H,M,S,MS);
  779. Result:=(H*60)+M;
  780. end;
  781. Function SecondOfTheDay(const AValue: TDateTime): LongWord;
  782. Var
  783. H,M,S,MS : Word;
  784. begin
  785. DecodeTime(AValue,H,M,S,MS);
  786. Result:=((H*60)+M)*60+S;
  787. end;
  788. Function MilliSecondOfTheDay(const AValue: TDateTime): LongWord;
  789. Var
  790. H,M,S,MS : Word;
  791. begin
  792. DecodeTime(AValue,H,M,S,MS);
  793. Result:=(((H*60)+M)*60+S)*1000+MS;
  794. end;
  795. { ---------------------------------------------------------------------
  796. Part of hour functions.
  797. ---------------------------------------------------------------------}
  798. Function MinuteOfTheHour(const AValue: TDateTime): Word;
  799. Var
  800. H,S,MS : Word;
  801. begin
  802. DecodeTime(AValue,H,Result,S,MS);
  803. end;
  804. Function SecondOfTheHour(const AValue: TDateTime): Word;
  805. Var
  806. H,S,M,MS : Word;
  807. begin
  808. DecodeTime(AValue,H,M,S,MS);
  809. Result:=M*60+S;
  810. end;
  811. Function MilliSecondOfTheHour(const AValue: TDateTime): LongWord;
  812. Var
  813. H,S,M,MS : Word;
  814. begin
  815. DecodeTime(AValue,H,M,S,MS);
  816. Result:=(M*60+S)*1000+MS;
  817. end;
  818. { ---------------------------------------------------------------------
  819. Part of minute functions.
  820. ---------------------------------------------------------------------}
  821. Function SecondOfTheMinute(const AValue: TDateTime): Word;
  822. Var
  823. H,M,MS : Word;
  824. begin
  825. DecodeTime(AValue,H,M,Result,MS);
  826. end;
  827. Function MilliSecondOfTheMinute(const AValue: TDateTime): LongWord;
  828. Var
  829. H,S,M,MS : Word;
  830. begin
  831. DecodeTime(AValue,H,M,S,MS);
  832. Result:=S*1000+MS;
  833. end;
  834. { ---------------------------------------------------------------------
  835. Part of second functions.
  836. ---------------------------------------------------------------------}
  837. Function MilliSecondOfTheSecond(const AValue: TDateTime): Word;
  838. Var
  839. H,M,S : Word;
  840. begin
  841. DecodeTime(AValue,H,M,S,Result);
  842. end;
  843. { ---------------------------------------------------------------------
  844. Range checking functions.
  845. ---------------------------------------------------------------------}
  846. Function WithinPastYears(const ANow, AThen: TDateTime; const AYears: Integer): Boolean;
  847. begin
  848. Result:=YearsBetween(ANow,AThen)<=AYears;
  849. end;
  850. Function WithinPastMonths(const ANow, AThen: TDateTime; const AMonths: Integer): Boolean;
  851. begin
  852. Result:=MonthsBetween(ANow,AThen)<=AMonths;
  853. end;
  854. Function WithinPastWeeks(const ANow, AThen: TDateTime; const AWeeks: Integer): Boolean;
  855. begin
  856. Result:=WeeksBetween(ANow,AThen)<=AWeeks;
  857. end;
  858. Function WithinPastDays(const ANow, AThen: TDateTime; const ADays: Integer): Boolean;
  859. begin
  860. Result:=DaysBetween(ANow,AThen)<=ADays;
  861. end;
  862. Function WithinPastHours(const ANow, AThen: TDateTime; const AHours: Int64): Boolean;
  863. begin
  864. Result:=HoursBetween(ANow,AThen)<=AHours;
  865. end;
  866. Function WithinPastMinutes(const ANow, AThen: TDateTime; const AMinutes: Int64): Boolean;
  867. begin
  868. Result:=MinutesBetween(ANow,AThen)<=AMinutes;
  869. end;
  870. Function WithinPastSeconds(const ANow, AThen: TDateTime; const ASeconds: Int64): Boolean;
  871. begin
  872. Result:=SecondsBetween(ANow,Athen)<=ASeconds;
  873. end;
  874. Function WithinPastMilliSeconds(const ANow, AThen: TDateTime; const AMilliSeconds: Int64): Boolean;
  875. begin
  876. Result:=MilliSecondsBetween(ANow,AThen)<=AMilliSeconds;
  877. end;
  878. { ---------------------------------------------------------------------
  879. Period functions.
  880. ---------------------------------------------------------------------}
  881. {
  882. These functions are declared as approximate by Borland.
  883. A bit strange, since it can be calculated exactly ?
  884. }
  885. Function YearsBetween(const ANow, AThen: TDateTime): Integer;
  886. begin
  887. Result:=Trunc(Abs(ANow-AThen)/ApproxDaysPerYear);
  888. end;
  889. Function MonthsBetween(const ANow, AThen: TDateTime): Integer;
  890. begin
  891. Result:=Trunc(Abs(ANow-Athen)/ApproxDaysPerMonth);
  892. end;
  893. Function WeeksBetween(const ANow, AThen: TDateTime): Integer;
  894. begin
  895. Result:=Trunc(Abs(ANow-AThen)) div 7;
  896. end;
  897. Function DaysBetween(const ANow, AThen: TDateTime): Integer;
  898. begin
  899. Result:=Trunc(Abs(ANow-AThen));
  900. end;
  901. Function HoursBetween(const ANow, AThen: TDateTime): Int64;
  902. begin
  903. Result:=Trunc(Abs(ANow-AThen)*HoursPerDay);
  904. end;
  905. Function MinutesBetween(const ANow, AThen: TDateTime): Int64;
  906. begin
  907. Result:=Trunc(Abs(ANow-AThen)*MinsPerDay);
  908. end;
  909. Function SecondsBetween(const ANow, AThen: TDateTime): Int64;
  910. begin
  911. Result:=Trunc(Abs(ANow-AThen)*SecsPerDay);
  912. end;
  913. Function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;
  914. begin
  915. Result:=Trunc(Abs(ANow-AThen)*MSecsPerDay);
  916. end;
  917. { ---------------------------------------------------------------------
  918. Timespan in xxx functions.
  919. ---------------------------------------------------------------------}
  920. Function YearSpan(const ANow, AThen: TDateTime): Double;
  921. begin
  922. Result:=Abs(Anow-Athen)/ApproxDaysPerYear;
  923. end;
  924. Function MonthSpan(const ANow, AThen: TDateTime): Double;
  925. begin
  926. Result:=Abs(ANow-AThen)/ApproxDaysPerMonth;
  927. end;
  928. Function WeekSpan(const ANow, AThen: TDateTime): Double;
  929. begin
  930. Result:=Abs(ANow-AThen) / 7
  931. end;
  932. Function DaySpan(const ANow, AThen: TDateTime): Double;
  933. begin
  934. Result:=Abs(ANow-AThen);
  935. end;
  936. Function HourSpan(const ANow, AThen: TDateTime): Double;
  937. begin
  938. Result:=Abs(ANow-AThen)*HoursPerDay;
  939. end;
  940. Function MinuteSpan(const ANow, AThen: TDateTime): Double;
  941. begin
  942. Result:=Abs(ANow-AThen)*MinsPerDay;
  943. end;
  944. Function SecondSpan(const ANow, AThen: TDateTime): Double;
  945. begin
  946. Result:=Abs(ANow-AThen)*SecsPerDay;
  947. end;
  948. Function MilliSecondSpan(const ANow, AThen: TDateTime): Double;
  949. begin
  950. Result:=Abs(ANow-AThen)*MSecsPerDay;
  951. end;
  952. { ---------------------------------------------------------------------
  953. Increment/decrement functions.
  954. ---------------------------------------------------------------------}
  955. Function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer ): TDateTime;
  956. Var
  957. Y,M,D,H,N,S,MS : Word;
  958. begin
  959. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  960. Y:=Y+ANumberOfYears;
  961. If (M=2) and (D=29) And (Not IsLeapYear(Y)) then
  962. D:=28;
  963. Result:=EncodeDateTime(Y,M,D,H,N,S,MS);
  964. end;
  965. Function IncYear(const AValue: TDateTime): TDateTime; // ; const ANumberOfYears: Integer = 1)
  966. begin
  967. Result:=IncYear(Avalue,1);
  968. end;
  969. Function IncWeek(const AValue: TDateTime; const ANumberOfWeeks: Integer): TDateTime;
  970. begin
  971. Result:=AValue+ANumberOfWeeks*7;
  972. end;
  973. Function IncWeek(const AValue: TDateTime): TDateTime; // ; const ANumberOfWeeks: Integer = 1)
  974. begin
  975. Result:=IncWeek(Avalue,1);
  976. end;
  977. Function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer): TDateTime;
  978. begin
  979. Result:=AValue+ANumberOfDays;
  980. end;
  981. Function IncDay(const AValue: TDateTime): TDateTime; //; const ANumberOfDays: Integer = 1)
  982. begin
  983. Result:=IncDay(Avalue,1);
  984. end;
  985. Function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;
  986. begin
  987. Result:=AValue+ANumberOfHours/HoursPerDay;
  988. end;
  989. Function IncHour(const AValue: TDateTime): TDateTime; //; const ANumberOfHours: Int64 = 1
  990. begin
  991. Result:=IncHour(AValue,1);
  992. end;
  993. Function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;
  994. begin
  995. Result:=AValue+ANumberOfMinutes / MinsPerDay;
  996. end;
  997. Function IncMinute(const AValue: TDateTime): TDateTime; // ; const ANumberOfMinutes: Int64 = 1
  998. begin
  999. Result:=IncMinute(AValue,1);
  1000. end;
  1001. Function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64): TDateTime;
  1002. begin
  1003. Result:=AValue+ANumberOfSeconds / SecsPerDay;
  1004. end;
  1005. Function IncSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfSeconds: Int64 = 1
  1006. begin
  1007. Result:=IncSecond(Avalue,1);
  1008. end;
  1009. Function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64): TDateTime;
  1010. begin
  1011. Result:=AValue+ANumberOfMilliSeconds/MSecsPerDay;
  1012. end;
  1013. Function IncMilliSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfMilliSeconds: Int64 = 1
  1014. begin
  1015. Result:=IncMilliSecond(AValue,1);
  1016. end;
  1017. { ---------------------------------------------------------------------
  1018. Encode/Decode of complete timestamp
  1019. ---------------------------------------------------------------------}
  1020. Function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  1021. begin
  1022. If Not TryEncodeDateTime(AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond,Result) then
  1023. InvalidDateTimeError(AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond)
  1024. end;
  1025. Procedure DecodeDateTime(const AValue: TDateTime; var AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);
  1026. begin
  1027. DecodeDate(AValue,AYear,AMonth,ADay);
  1028. DecodeTime(AValue,AHour,AMinute,ASecond,AMilliSecond);
  1029. end;
  1030. Function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AValue: TDateTime): Boolean;
  1031. Var
  1032. tmp : TDateTime;
  1033. begin
  1034. Result:=TryEncodeDate(AYear,AMonth,ADay,AValue);
  1035. Result:=Result and TryEncodeTime(AHour,AMinute,ASecond,Amillisecond,Tmp);
  1036. If Result then
  1037. Avalue:=AValue+Tmp;
  1038. end;
  1039. { ---------------------------------------------------------------------
  1040. Encode/decode date, specifying week of year and day of week
  1041. ---------------------------------------------------------------------}
  1042. Function EncodeDateWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
  1043. begin
  1044. If Not TryEncodeDateWeek(AYear,AWeekOfYear,Result,ADayOfWeek) then
  1045. InvalidDateWeekError(AYear,AWeekOfYear,ADayOfWeek);
  1046. end;
  1047. Function EncodeDateWeek(const AYear, AWeekOfYear: Word): TDateTime; //; const ADayOfWeek: Word = 1
  1048. begin
  1049. Result := EncodeDateWeek(AYear,AWeekOfYear,1);
  1050. end;
  1051. Procedure DecodeDateWeek(const AValue: TDateTime; var AYear, AWeekOfYear, ADayOfWeek: Word);
  1052. var
  1053. DOY : Integer;
  1054. D: Word;
  1055. YS : TDateTime;
  1056. YSDOW, YEDOW: Word;
  1057. begin
  1058. AYear:=YearOf(AValue);
  1059. // Correct to ISO DOW
  1060. ADayOfWeek:=DayOfWeek(AValue)-1;
  1061. If ADAyOfWeek=0 then
  1062. ADayofweek:=7;
  1063. YS:=StartOfAYear(AYear);
  1064. DOY:=Trunc(AValue-YS)+1;
  1065. YSDOW:=DayOfTheWeek(YS);
  1066. // Correct week if later than wednesday. First week never starts later than wednesday
  1067. if (YSDOW<5) then
  1068. Inc(DOY,YSDOW-1)
  1069. else
  1070. Dec(DOY,8-YSDOW);
  1071. if (DOY<=0) then // Day is in last week of previous year.
  1072. DecodeDateWeek(YS-1,AYear,AWeekOfYear,D)
  1073. else
  1074. begin
  1075. AWeekOfYear:=DOY div 7;
  1076. if ((DOY mod 7)<>0) then
  1077. Inc(AWeekOfYear);
  1078. if (AWeekOfYear>52) then // Maybe in first week of next year ?
  1079. begin
  1080. YEDOW:=YSDOW;
  1081. if IsLeapYear(AYear) then
  1082. begin
  1083. Inc(YEDOW);
  1084. if (YEDOW>7) then
  1085. YEDOW:=1
  1086. else
  1087. end;
  1088. if (YEDOW<4) then // Really next year.
  1089. begin
  1090. Inc(AYear);
  1091. AWeekOfYear:=1;
  1092. end;
  1093. end;
  1094. end;
  1095. end;
  1096. Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime; const ADayOfWeek: Word): Boolean;
  1097. Var
  1098. DOW : Word;
  1099. Rest : Integer;
  1100. begin
  1101. Result:=IsValidDateWeek(Ayear,AWeekOfYear,ADayOfWeek);
  1102. If Result then
  1103. begin
  1104. AValue:=EncodeDate(AYear,1,1)+(7*(AWeekOfYear-1));
  1105. DOW:=DayOfTheWeek(AValue);
  1106. Rest:=ADayOfWeek-DOW;
  1107. If (DOW>4) then
  1108. Inc(Rest,7);
  1109. AValue:=AValue+Rest;
  1110. end;
  1111. end;
  1112. Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime): Boolean; //; const ADayOfWeek: Word = 1
  1113. begin
  1114. Result:=TryEncodeDateWeek(AYear,AWeekOfYear,AValue,1);
  1115. end;
  1116. { ---------------------------------------------------------------------
  1117. Encode/decode date, specifying day of year
  1118. ---------------------------------------------------------------------}
  1119. Function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;
  1120. begin
  1121. If Not TryEncodeDateDay(AYear,ADayOfYear,Result) then
  1122. InvalidDateDayError(AYear,ADayOfYear);
  1123. end;
  1124. Procedure DecodeDateDay(const AValue: TDateTime; var AYear, ADayOfYear: Word);
  1125. Var
  1126. M,D : Word;
  1127. begin
  1128. DecodeDate(AValue,AYear,M,D);
  1129. ADayOfyear:=Trunc(AValue-EncodeDate(AYear,1,1))+1;
  1130. end;
  1131. Function TryEncodeDateDay(const AYear, ADayOfYear: Word; var AValue: TDateTime): Boolean;
  1132. begin
  1133. Result:=(ADayOfYear<>0) and (ADayOfYear<=DaysPerYear [IsleapYear(AYear)]);
  1134. If Result then
  1135. AValue:=EncodeDate(AYear,1,1)+ADayOfYear-1;
  1136. end;
  1137. { ---------------------------------------------------------------------
  1138. Encode/decode date, specifying week of month
  1139. ---------------------------------------------------------------------}
  1140. Function EncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): TDateTime;
  1141. begin
  1142. If Not TryEncodeDateMonthWeek(Ayear,AMonth,AWeekOfMonth,ADayOfWeek,Result) then
  1143. InvalidDateMonthWeekError(AYear,AMonth,AWeekOfMonth,ADayOfWeek);
  1144. end;
  1145. Procedure DecodeDateMonthWeek(const AValue: TDateTime; var AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
  1146. Var
  1147. D,SDOM,EDOM : Word;
  1148. SOM : TdateTime;
  1149. DOM : Integer;
  1150. begin
  1151. DecodeDate(AValue,AYear,AMonth,D);
  1152. ADayOfWeek:=DayOfTheWeek(AValue);
  1153. SOM:=EncodeDate(Ayear,Amonth,1);
  1154. SDOM:=DayOfTheWeek(SOM);
  1155. DOM:=D-1+SDOM;
  1156. If SDOM>4 then
  1157. Dec(DOM,7);
  1158. // Too early in the month. First full week is next week, day is after thursday.
  1159. If DOM<=0 Then
  1160. DecodeDateMonthWeek(SOM-1,AYear,AMonth,AWeekOfMonth,D)
  1161. else
  1162. begin
  1163. AWeekOfMonth:=(DOM div 7)+Ord((DOM mod 7)<>0);
  1164. EDOM:=DayOfTheWeek(EndOfAMonth(Ayear,AMonth));
  1165. // In last days of last long week, so in next month...
  1166. If (EDOM<4) and ((DaysInAMonth(AYear,Amonth)-D)<EDOM) then
  1167. begin
  1168. AWeekOfMonth:=1;
  1169. Inc(AMonth);
  1170. If (AMonth=13) then
  1171. begin
  1172. AMonth:=1;
  1173. Inc(AYear);
  1174. end;
  1175. end;
  1176. end;
  1177. end;
  1178. Function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
  1179. var
  1180. S : Word;
  1181. DOM : Integer;
  1182. begin
  1183. Result:=IsValidDateMonthWeek(AYear,AMonth,AWeekOfMonth,ADayOfWeek);
  1184. if Result then
  1185. begin
  1186. AValue:=EncodeDate(AYear,AMonth,1);
  1187. DOM:=(AWeekOfMonth-1)*7+ADayOfWeek-1;
  1188. { Correct for first week in last month.}
  1189. S:=DayOfTheWeek(AValue);
  1190. Dec(DOM,S-1);
  1191. if S in [DayFriday..DaySunday] then
  1192. Inc(DOM,7);
  1193. AValue:=AValue+DOM;
  1194. end;
  1195. end;
  1196. { ---------------------------------------------------------------------
  1197. Replace given element with supplied value.
  1198. ---------------------------------------------------------------------}
  1199. Const
  1200. LFAI = RecodeLeaveFieldAsIS; // Less typing, readable code
  1201. {
  1202. Note: We have little choice but to implement it like Borland did:
  1203. If AValue contains some 'wrong' value, it will throw an error.
  1204. To simulate this we'd have to check in each function whether
  1205. both arguments are correct. To avoid it, all is routed through
  1206. the 'central' RecodeDateTime function as in Borland's implementation.
  1207. }
  1208. Function RecodeYear(const AValue: TDateTime; const AYear: Word): TDateTime;
  1209. begin
  1210. Result := RecodeDateTime(AValue,AYear,LFAI,LFAI,LFAI,LFAI,LFAI,LFAI);
  1211. end;
  1212. Function RecodeMonth(const AValue: TDateTime; const AMonth: Word): TDateTime;
  1213. begin
  1214. Result := RecodeDateTime(AValue,LFAI,AMonth,LFAI,LFAI,LFAI,LFAI,LFAI);
  1215. end;
  1216. Function RecodeDay(const AValue: TDateTime; const ADay: Word): TDateTime;
  1217. begin
  1218. Result := RecodeDateTime(AValue,LFAI,LFAI,ADay,LFAI,LFAI,LFAI,LFAI);
  1219. end;
  1220. Function RecodeHour(const AValue: TDateTime; const AHour: Word): TDateTime;
  1221. begin
  1222. Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,AHour,LFAI,LFAI,LFAI);
  1223. end;
  1224. Function RecodeMinute(const AValue: TDateTime; const AMinute: Word): TDateTime;
  1225. begin
  1226. Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,AMinute,LFAI,LFAI);
  1227. end;
  1228. Function RecodeSecond(const AValue: TDateTime; const ASecond: Word): TDateTime;
  1229. begin
  1230. Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,LFAI,ASecond,LFAI);
  1231. end;
  1232. Function RecodeMilliSecond(const AValue: TDateTime; const AMilliSecond: Word): TDateTime;
  1233. begin
  1234. Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,LFAI,LFAI,AMilliSecond);
  1235. end;
  1236. Function RecodeDate(const AValue: TDateTime; const AYear, AMonth, ADay: Word): TDateTime;
  1237. begin
  1238. Result := RecodeDateTime(AValue,AYear,AMonth,ADay,LFAI,LFAI,LFAI,LFAI);
  1239. end;
  1240. Function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  1241. begin
  1242. Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,AHour,AMinute,ASecond,AMilliSecond);
  1243. end;
  1244. Function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
  1245. begin
  1246. If Not TryRecodeDateTime(AValue,AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,Result) then
  1247. InvalidDateTimeError(AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,AValue);
  1248. end;
  1249. Function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AResult: TDateTime): Boolean;
  1250. Procedure FV (Var AV : Word; Arg : Word);
  1251. begin
  1252. If (Arg<>LFAI) then
  1253. AV:=Arg;
  1254. end;
  1255. Var
  1256. Y,M,D,H,N,S,MS : Word;
  1257. begin
  1258. DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
  1259. FV(Y,AYear);
  1260. FV(M,AMonth);
  1261. FV(D,ADay);
  1262. FV(H,AHour);
  1263. FV(N,AMinute);
  1264. FV(S,ASecond);
  1265. FV(MS,AMillisecond);
  1266. Result:=TryEncodeDateTime(Y,M,D,H,N,S,MS,AResult);
  1267. end;
  1268. { ---------------------------------------------------------------------
  1269. Comparision of date/time
  1270. ---------------------------------------------------------------------}
  1271. Function CompareDateTime(const A, B: TDateTime): TValueRelationship;
  1272. begin
  1273. If SameDateTime(A,B) then
  1274. Result:=EqualsValue
  1275. else If A>B then
  1276. Result:=GreaterThanValue
  1277. else
  1278. Result:=LessThanValue
  1279. end;
  1280. Function CompareDate(const A, B: TDateTime): TValueRelationship;
  1281. begin
  1282. If SameDate(A,B) then
  1283. Result:=EQualsValue
  1284. else if A<B then
  1285. Result:=LessThanValue
  1286. else
  1287. Result:=GreaterThanValue;
  1288. end;
  1289. Function CompareTime(const A, B: TDateTime): TValueRelationship;
  1290. begin
  1291. If SameTime(A,B) then
  1292. Result:=EQualsValue
  1293. else If Frac(A)<Frac(B) then
  1294. Result:=LessThanValue
  1295. else
  1296. Result:=GreaterThanValue;
  1297. end;
  1298. Function SameDateTime(const A, B: TDateTime): Boolean;
  1299. begin
  1300. Result:=Abs(A-B)<OneMilliSecond;
  1301. end;
  1302. Function SameDate(const A, B: TDateTime): Boolean;
  1303. begin
  1304. Result:=Trunc(A)=Trunc(B);
  1305. end;
  1306. Function SameTime(const A, B: TDateTime): Boolean;
  1307. begin
  1308. Result:=Frac(Abs(A-B))<OneMilliSecond;
  1309. end;
  1310. Function InternalNthDayOfWeek(DoM : Word) : Word;
  1311. begin
  1312. Result:=(Dom-1) div 7 +1;
  1313. end;
  1314. Function NthDayOfWeek(const AValue: TDateTime): Word;
  1315. begin
  1316. Result:=InternalNthDayOfWeek(DayOfTheMonth(AValue));
  1317. end;
  1318. Procedure DecodeDayOfWeekInMonth(const AValue: TDateTime; var AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
  1319. var
  1320. D: Word;
  1321. begin
  1322. DecodeDate(AValue,AYear,AMonth,D);
  1323. ADayOfWeek:=DayOfTheWeek(AValue);
  1324. ANthDayOfWeek:=InternalNthDayOfWeek(D);
  1325. end;
  1326. Function EncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word): TDateTime;
  1327. begin
  1328. If Not TryEncodeDayOfWeekInMonth(AYear,AMonth,ANthDayOfWeek,ADayOfWeek,Result) then
  1329. InvalidDayOfWeekInMonthError(AYear,AMonth,ANthDayOfWeek,ADayOfWeek);
  1330. end;
  1331. Function TryEncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
  1332. Var
  1333. SOM,D : Word;
  1334. begin
  1335. SOM:=DayOfTheWeek(EncodeDate(Ayear,AMonth,1));
  1336. D:=1+ADayOfWeek-SOM+7*(ANthDayOfWeek-1);
  1337. If SOM>ADayOfWeek then
  1338. D:=D+7; // Clearer would have been Inc(ANthDayOfweek) but it's a const
  1339. Result:=TryEncodeDate(Ayear,AMonth,D,AValue);
  1340. end;
  1341. { ---------------------------------------------------------------------
  1342. Exception throwing routines
  1343. ---------------------------------------------------------------------}
  1344. Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
  1345. Function DoField(Arg,Def : Word; Unknown: String) : String;
  1346. begin
  1347. If (Arg<>LFAI) then
  1348. Result:=Format('%.*d',[Length(Unknown),Arg])
  1349. else if (ABaseDate=0) then
  1350. Result:=Unknown
  1351. else
  1352. Result:=Format('%.*d',[Length(Unknown),Arg]);
  1353. end;
  1354. Var
  1355. Y,M,D,H,N,S,MS : Word;
  1356. Msg : String;
  1357. begin
  1358. DecodeDateTime(ABasedate,Y,M,D,H,N,S,MS);
  1359. Msg:=DoField(AYear,Y,'????');
  1360. Msg:=Msg+DateSeparator+DoField(AMonth,M,'??');
  1361. Msg:=Msg+DateSeparator+DoField(ADay,D,'??');
  1362. Msg:=Msg+' '+DoField(AHour,H,'??');
  1363. Msg:=Msg+TimeSeparator+DoField(AMinute,N,'??');
  1364. Msg:=Msg+TimeSeparator+Dofield(ASecond,S,'??');
  1365. Msg:=Msg+DecimalSeparator+DoField(AMilliSecond,MS,'???');
  1366. Raise EConvertError.CreateFmt(SErrInvalidTimeStamp,[Msg]);
  1367. end;
  1368. Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word); // const ABaseDate: TDateTime = 0
  1369. begin
  1370. InvalidDateTimeError(AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,0);
  1371. end;
  1372. Procedure InvalidDateWeekError(const AYear, AWeekOfYear, ADayOfWeek: Word);
  1373. begin
  1374. Raise EConvertError.CreateFmt(SErrInvalidDateWeek,[AYear,AWeekOfYear,ADayOfWeek]);
  1375. end;
  1376. Procedure InvalidDateDayError(const AYear, ADayOfYear: Word);
  1377. begin
  1378. Raise EConvertError.CreateFmt(SErrInvalidDayOfYear,[AYear,ADayOfYear]);
  1379. end;
  1380. Procedure InvalidDateMonthWeekError(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
  1381. begin
  1382. Raise EConvertError.CreateFmt(SErrInvalidDateMonthWeek,[Ayear,AMonth,AWeekOfMonth,ADayOfWeek]);
  1383. end;
  1384. Procedure InvalidDayOfWeekInMonthError(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
  1385. begin
  1386. Raise EConvertError.CreateFmt(SErrInvalidDayOfWeekInMonth,[AYear,AMonth,ANthDayOfWeek,ADayOfWeek]);
  1387. end;
  1388. { ---------------------------------------------------------------------
  1389. Julian and Modified Julian Date conversion support
  1390. ---------------------------------------------------------------------}
  1391. {$warnings off}
  1392. Function DateTimeToJulianDate(const AValue: TDateTime): Double;
  1393. begin
  1394. NotYetImplemented('DateTimeToJulianDate');
  1395. end;
  1396. Function JulianDateToDateTime(const AValue: Double): TDateTime;
  1397. begin
  1398. NotYetImplemented('JulianDateToDateTime');
  1399. end;
  1400. Function TryJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
  1401. begin
  1402. NotYetImplemented('TryJulianDateToDateTime');
  1403. end;
  1404. Function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
  1405. begin
  1406. NotYetImplemented('DateTimeToModifiedJulianDate');
  1407. end;
  1408. Function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
  1409. begin
  1410. NotYetImplemented('ModifiedJulianDateToDateTime');
  1411. end;
  1412. Function TryModifiedJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
  1413. begin
  1414. NotYetImplemented('TryModifiedJulianDateToDateTime');
  1415. end;
  1416. {$warnings on}
  1417. { ---------------------------------------------------------------------
  1418. Unix timestamp support.
  1419. ---------------------------------------------------------------------}
  1420. Function DateTimeToUnix(const AValue: TDateTime): Int64;
  1421. var
  1422. Epoch:TDateTime;
  1423. begin
  1424. Epoch:=EncodeDateTime( 1970, 1, 1, 0, 0, 0, 0 );
  1425. Result:=SecondsBetween( Epoch, AValue );
  1426. end;
  1427. Function UnixToDateTime(const AValue: Int64): TDateTime;
  1428. var
  1429. Epoch:TDateTime;
  1430. begin
  1431. Epoch:=EncodeDateTime( 1970, 1, 1, 0, 0, 0, 0 );
  1432. Result:=IncSecond( Epoch, AValue );
  1433. end;
  1434. Function UnixTimeStampToMac(const AValue: Int64): Int64;
  1435. const
  1436. Epoch=24107 * 24 * 3600;
  1437. begin
  1438. Result:=AValue + Epoch;
  1439. end;
  1440. { ---------------------------------------------------------------------
  1441. Mac timestamp support.
  1442. ---------------------------------------------------------------------}
  1443. Function DateTimeToMac(const AValue: TDateTime): Int64;
  1444. var
  1445. Epoch:TDateTime;
  1446. begin
  1447. Epoch:=EncodeDateTime( 1904, 1, 1, 0, 0, 0, 0 );
  1448. Result:=SecondsBetween( Epoch, AValue );
  1449. end;
  1450. Function MacToDateTime(const AValue: Int64): TDateTime;
  1451. var
  1452. Epoch:TDateTime;
  1453. begin
  1454. Epoch:=EncodeDateTime( 1904, 1, 1, 0, 0, 0, 0 );
  1455. Result:=IncSecond( Epoch, AValue );
  1456. end;
  1457. Function MacTimeStampToUnix(const AValue: Int64): Int64;
  1458. const
  1459. Epoch=24107 * 24 * 3600;
  1460. begin
  1461. Result:=AValue - Epoch;
  1462. end;
  1463. end.