dateutil.inc 87 KB

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