dateutil.inc 66 KB

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