dateutil.inc 85 KB

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