IdDateTimeStamp.pas 42 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467
  1. {
  2. $Project$
  3. $Workfile$
  4. $Revision$
  5. $DateUTC$
  6. $Id$
  7. This file is part of the Indy (Internet Direct) project, and is offered
  8. under the dual-licensing agreement described on the Indy website.
  9. (http://www.indyproject.org/)
  10. Copyright:
  11. (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
  12. }
  13. {
  14. $Log$
  15. }
  16. {
  17. Rev 1.3 2004.02.03 5:45:04 PM czhower
  18. Name changes
  19. Rev 1.2 1/21/2004 1:57:38 PM JPMugaas
  20. InitComponent
  21. Rev 1.1 10/12/2003 2:01:46 PM BGooijen
  22. Compiles in DotNet
  23. Rev 1.0 11/14/2002 02:16:44 PM JPMugaas
  24. 2002-Feb-07 Pete Mee
  25. - Modified interface: GetAsRFC882 is now GetAsRFC822. ;-)
  26. - Fixed GetAsTTimeStamp (was way out).
  27. 2001-Nov-10 Pete Mee
  28. - Added SetFromDOSDateTime.
  29. 2001-Mar-29 Pete Mee
  30. - Fixed bug in SetFromRFC822. As luck would have it, my PC has changed
  31. to BST from GMT, so I caught the error. Change use of GMTToLocalDateTime
  32. to StrInternetToDateTime.
  33. 2001-Mar-27 Pete Mee
  34. - Added GetTimeZoneHour, GetTimeZoneMinutes, GetTimeZoneAsString and
  35. corresponding properties, TimeZoneHour, TimeZoneMinutes and TimeZoneAsString.
  36. - Added SetFromRFC822 and SetFromISO8601.
  37. 2001-Mar-26 Pete Mee
  38. - Fixed bug in AddDays. Was adding an extra day in the wrong centuary.
  39. - Fixed bug in AddDays. Was not altering the year with large additions.
  40. 2001-Mar-23 Pete Mee
  41. - Fixed bug in SubtractMilliseconds.
  42. - GetBeatOfDay is more accurate (based on milliseconds instead of seconds).
  43. 2001-Mar-21 Pete Mee
  44. - Altered Day, Seond and Millisecond properties to use their respective
  45. Set methods.
  46. - Added SetTimeZone, Zero, ZeroTime and ZeroDate.
  47. - Altered SetYear and SetDay to cope with the value 0.
  48. 2000-Sep-16 Pete Mee
  49. - SetYear no longer accepts zero but instead simply exits.
  50. 2000-Aug-01 Pete Mee
  51. - Fix bugs in AddDays & SubtractDays. Depending on the day of the year, the
  52. calculations could have been incorrect. Now 'rounds off' to the nearest year
  53. before any other calculation.
  54. 2000-Jul-28 Pete Mee
  55. - Fix bugs in AddDays & SubtractDays. 3 days in 400 years lost, 1 day in 100
  56. years lost.
  57. 2000-May-11 Pete Mee
  58. - Added GetAsRFC822, GetAsISO8601
  59. 2000-May-03 Pete Mee
  60. - Added detection of Day, Week and Month (various formats).
  61. 2000-May-02 Pete Mee
  62. - Started TIdDateTimeStamp
  63. }
  64. unit IdDateTimeStamp;
  65. {
  66. Development notes:
  67. The Calendar used is the Gregorian Calendar (modern western society). This
  68. Calendar's use started somtime in the 1500s but wasn't adopted by some countries
  69. until the early 1900s. No attempt is made to cope with any other Calendars.
  70. No attempt is made to cope with any Atomic time quantity less than a leap
  71. year (i.e., an exact number of seconds per day and an exact number of days
  72. per year / leap year - no leap seconds, no 1/4 days, etc).
  73. The implementation revolves around the Milliseconds, Seconds, Days and Years.
  74. The heirarchy is as follows:
  75. Milliseconds modify seconds. (0-999 Milliseconds)
  76. Seconds modify days. (0-59 Seconds)
  77. Days modify years. (1-365/366 Days)
  78. Years modify years. (..., -2, -1, 1, ...)
  79. All other time units are translated into necessary component parts. I.e.,
  80. a week is 7 days, and hour is 3600 seconds, a minute is 60 seconds, etc...
  81. The implementation could be easily expanded to represent decades, centuries,
  82. nanoseconds, and beyond in both directions. Milliseconds are included to
  83. provide easy conversion from TTimeStamp and back (and hence TDateTime). The
  84. current component is designed to give good functionality for the majority (if
  85. not all) of Internet component requirements (including Swatch's Internet Time).
  86. It is also not limited to the 2038 bug of many of today's OSs (32-bit signed
  87. number of seconds from 1st Jan 1970 = 19th Jan 2038 03:14:07, or there abouts).
  88. NB: This implementation is factors slower than those of the TDateTime and
  89. TTimeStamp components of standard Delphi. It's main use lies in the conversion
  90. to / from ISO 8601 and RFC 822 formats as well as dates ranging beyond 2037 and
  91. before 1970 (though TTimeStamp is capable here). It's also the only date component
  92. I'm aware of that complies with RFC 2550 "Y10K and Beyond"... one of those RFCs in
  93. the same category as RFC 1149, IP over Avian Carriers. ;-)
  94. Pete Mee
  95. }
  96. {
  97. ToDo: Allow localisation date / time strings generated (i.e., to zone name).
  98. ToDo: Rework SetFromRFC822 as it is (marginally) limited by it's
  99. conversion to TDateTime.
  100. ToDo: Conversion between Time Zones.
  101. }
  102. interface
  103. {$i IdCompilerDefines.inc}
  104. uses
  105. IdGlobal,
  106. IdBaseComponent;
  107. const
  108. // Some basic constants
  109. IdMilliSecondsInSecond = 1000;
  110. IdSecondsInMinute = 60;
  111. IdMinutesInHour = 60;
  112. IdHoursInDay = 24;
  113. IdDaysInWeek = 7;
  114. IdDaysInYear = 365;
  115. IdDaysInLeapYear = 366;
  116. IdYearsInShortLeapYearCycle = 4;
  117. IdDaysInShortLeapYearCycle = IdDaysInLeapYear + (IdDaysInYear * 3);
  118. IdDaysInShortNonLeapYearCycle = IdDaysInYear * IdYearsInShortLeapYearCycle;
  119. IdDaysInFourYears = IdDaysInShortLeapYearCycle;
  120. IdYearsInCentury = 100;
  121. IdDaysInCentury = (25 * IdDaysInFourYears) - 1;
  122. IdDaysInLeapCentury = IdDaysInCentury + 1;
  123. IdYearsInLeapYearCycle = 400;
  124. IdDaysInLeapYearCycle = IdDaysInCentury * 4 + 1;
  125. IdMonthsInYear = 12;
  126. // Beat time is Swatch's "Internet Time" http://www.swatch.com/ {Do not Localize}
  127. IdBeatsInDay = 1000;
  128. // Some compound constants
  129. IdHoursInHalfDay = IdHoursInDay div 2;
  130. IdSecondsInHour = IdSecondsInMinute * IdMinutesInHour;
  131. IdSecondsInDay = IdSecondsInHour * IdHoursInDay;
  132. IdSecondsInHalfDay = IdSecondsInHour * IdHoursInHalfDay;
  133. IdSecondsInWeek = IdDaysInWeek * IdSecondsInDay;
  134. IdSecondsInYear = IdSecondsInDay * IdDaysInYear;
  135. IdSecondsInLeapYear = IdSecondsInDay * IdDaysInLeapYear;
  136. IdMillisecondsInMinute = IdSecondsInMinute * IdMillisecondsInSecond;
  137. IdMillisecondsInHour = IdSecondsInHour * IdMillisecondsInSecond;
  138. IdMillisecondsInDay = IdSecondsInDay * IdMillisecondsInSecond;
  139. IdMillisecondsInWeek = IdSecondsInWeek * IdMillisecondsInSecond;
  140. SShortMonthNameJan = 'Jan';
  141. SShortMonthNameFeb = 'Feb';
  142. SShortMonthNameMar = 'Mar';
  143. SShortMonthNameApr = 'Apr';
  144. SShortMonthNameMay = 'May';
  145. SShortMonthNameJun = 'Jun';
  146. SShortMonthNameJul = 'Jul';
  147. SShortMonthNameAug = 'Aug';
  148. SShortMonthNameSep = 'Sep';
  149. SShortMonthNameOct = 'Oct';
  150. SShortMonthNameNov = 'Nov';
  151. SShortMonthNameDec = 'Dec';
  152. SLongMonthNameJan = 'January';
  153. SLongMonthNameFeb = 'February';
  154. SLongMonthNameMar = 'March';
  155. SLongMonthNameApr = 'April';
  156. SLongMonthNameMay = 'May';
  157. SLongMonthNameJun = 'June';
  158. SLongMonthNameJul = 'July';
  159. SLongMonthNameAug = 'August';
  160. SLongMonthNameSep = 'September';
  161. SLongMonthNameOct = 'October';
  162. SLongMonthNameNov = 'November';
  163. SLongMonthNameDec = 'December';
  164. SShortDayNameSun = 'Sun';
  165. SShortDayNameMon = 'Mon';
  166. SShortDayNameTue = 'Tue';
  167. SShortDayNameWed = 'Wed';
  168. SShortDayNameThu = 'Thu';
  169. SShortDayNameFri = 'Fri';
  170. SShortDayNameSat = 'Sat';
  171. SLongDayNameSun = 'Sunday';
  172. SLongDayNameMon = 'Monday';
  173. SLongDayNameTue = 'Tuesday';
  174. SLongDayNameWed = 'Wednesday';
  175. SLongDayNameThu = 'Thursday';
  176. SLongDayNameFri = 'Friday';
  177. SLongDayNameSat = 'Saturday';
  178. IdDaysInMonth : array[1..IdMonthsInYear] of byte =
  179. (
  180. 31, 28, 31, 30, 31, 30,
  181. 31, 31, 30, 31, 30, 31
  182. );
  183. IdMonthNames : array[0..IdMonthsInYear] of string =
  184. ( '', {Do not Localize}
  185. SLongMonthNameJan, SLongMonthNameFeb, SLongMonthNameMar,
  186. SLongMonthNameApr, SLongMonthNameMay, SLongMonthNameJun,
  187. SLongMonthNameJul, SLongMonthNameAug, SLongMonthNameSep,
  188. SLongMonthNameOct, SLongMonthNameNov, SLongMonthNameDec );
  189. IdMonthShortNames : array[0..IdMonthsInYear] of string =
  190. ( '', // Used for GetMonth {Do not Localize}
  191. SShortMonthNameJan, SShortMonthNameFeb, SShortMonthNameMar,
  192. SShortMonthNameApr, SShortMonthNameMay, SShortMonthNameJun,
  193. SShortMonthNameJul, SShortMonthNameAug, SShortMonthNameSep,
  194. SShortMonthNameOct, SShortMonthNameNov, SShortMonthNameDec );
  195. IdDayNames : array[0..IdDaysInWeek] of string =
  196. ( '', SLongDayNameSun, SLongDayNameMon, SLongDayNameTue, {Do not Localize}
  197. SLongDayNameWed, SLongDayNameThu, SLongDayNameFri,
  198. SLongDayNameSat );
  199. IdDayShortNames : array[0..IdDaysInWeek] of string =
  200. ( '', SShortDayNameSun, SShortDayNameMon, SShortDayNameTue, {Do not Localize}
  201. SShortDayNameWed, SShortDayNameThu, SShortDayNameFri,
  202. SShortDayNameSat );
  203. // Area Time Zones
  204. TZ_NZDT = 13; // New Zealand Daylight Time
  205. TZ_IDLE = 12; // International Date Line East
  206. TZ_NZST = TZ_IDLE;// New Zealand Standard Time
  207. TZ_NZT = TZ_IDLE; // New Zealand Time
  208. TZ_EADT = 11; // Eastern Australian Daylight Time
  209. TZ_GST = 10; // Guam Standard Time / Russia Zone 9
  210. TZ_JST = 9; // Japan Standard Time / Russia Zone 8
  211. TZ_CCT = 8; // China Coast Time / Russia Zone 7
  212. TZ_WADT = TZ_CCT; // West Australian Daylight Time
  213. TZ_WAST = 7; // West Australian Standard Time / Russia Zone 6
  214. TZ_ZP6 = 6; // Chesapeake Bay / Russia Zone 5
  215. TZ_ZP5 = 5; // Chesapeake Bay / Russia Zone 4
  216. TZ_ZP4 = 4; // Russia Zone 3
  217. TZ_BT = 3; // Baghdad Time / Russia Zone 2
  218. TZ_EET = 2; // Eastern European Time / Russia Zone 1
  219. TZ_MEST = TZ_EET; // Middle European Summer Time
  220. TZ_MESZ = TZ_EET; // Middle European Summer Zone
  221. TZ_SST = TZ_EET; // Swedish Summer Time
  222. TZ_FST = TZ_EET; // French Summer Time
  223. TZ_CET = 1; // Central European Time
  224. TZ_FWT = TZ_CET; // French Winter Time
  225. TZ_MET = TZ_CET; // Middle European Time
  226. TZ_MEWT = TZ_CET; // Middle European Winter Time
  227. TZ_SWT = TZ_CET; // Swedish Winter Time
  228. TZ_GMT = 0; // Greenwich Meanttime
  229. TZ_UT = TZ_GMT; // Universla Time
  230. TZ_UTC = TZ_GMT; // Universal Time Co-ordinated
  231. TZ_WET = TZ_GMT; // Western European Time
  232. TZ_WAT = -1; // West Africa Time
  233. TZ_BST = TZ_WAT; // British Summer Time
  234. TZ_AT = -2; // Azores Time
  235. TZ_ADT = -3; // Atlantic Daylight Time
  236. TZ_AST = -4; // Atlantic Standard Time
  237. TZ_EDT = TZ_AST; // Eastern Daylight Time
  238. TZ_EST = -5; // Eastern Standard Time
  239. TZ_CDT = TZ_EST; // Central Daylight Time
  240. TZ_CST = -6; // Central Standard Time
  241. TZ_MDT = TZ_CST; // Mountain Daylight Time
  242. TZ_MST = -7; // Mountain Standard Time
  243. TZ_PDT = TZ_MST; // Pacific Daylight Time
  244. TZ_PST = -8; // Pacific Standard Time
  245. TZ_YDT = TZ_PST; // Yukon Daylight Time
  246. TZ_YST = -9; // Yukon Standard Time
  247. TZ_HDT = TZ_YST; // Hawaii Daylight Time
  248. TZ_AHST = -10; // Alaska-Hawaii Standard Time
  249. TZ_CAT = TZ_AHST;// Central Alaska Time
  250. TZ_HST = TZ_AHST; // Hawaii Standard Time
  251. TZ_EAST = TZ_AHST;// East Australian Standard Time
  252. TZ_NT = -11; // -None-
  253. TZ_IDLW = -12; // International Date Line West
  254. // Military Time Zones
  255. TZM_A = TZ_WAT;
  256. TZM_Alpha = TZM_A;
  257. TZM_B = TZ_AT;
  258. TZM_Bravo = TZM_B;
  259. TZM_C = TZ_ADT;
  260. TZM_Charlie = TZM_C;
  261. TZM_D = TZ_AST;
  262. TZM_Delta = TZM_D;
  263. TZM_E = TZ_EST;
  264. TZM_Echo = TZM_E;
  265. TZM_F = TZ_CST;
  266. TZM_Foxtrot = TZM_F;
  267. TZM_G = TZ_MST;
  268. TZM_Golf = TZM_G;
  269. TZM_H = TZ_PST;
  270. TZM_Hotel = TZM_H;
  271. TZM_J = TZ_YST;
  272. TZM_Juliet = TZM_J;
  273. TZM_K = TZ_AHST;
  274. TZM_Kilo = TZM_K;
  275. TZM_L = TZ_NT;
  276. TZM_Lima = TZM_L;
  277. TZM_M = TZ_IDLW;
  278. TZM_Mike = TZM_M;
  279. TZM_N = TZ_CET;
  280. TZM_November = TZM_N;
  281. TZM_O = TZ_EET;
  282. TZM_Oscar = TZM_O;
  283. TZM_P = TZ_BT;
  284. TZM_Papa = TZM_P;
  285. TZM_Q = TZ_ZP4;
  286. TZM_Quebec = TZM_Q;
  287. TZM_R = TZ_ZP5;
  288. TZM_Romeo = TZM_R;
  289. TZM_S = TZ_ZP6;
  290. TZM_Sierra = TZM_S;
  291. TZM_T = TZ_WAST;
  292. TZM_Tango = TZM_T;
  293. TZM_U = TZ_CCT;
  294. TZM_Uniform = TZM_U;
  295. TZM_V = TZ_JST;
  296. TZM_Victor = TZM_V;
  297. TZM_W = TZ_GST;
  298. TZM_Whiskey = TZM_W;
  299. TZM_X = TZ_NT;
  300. TZM_XRay = TZM_X;
  301. TZM_Y = TZ_IDLE;
  302. TZM_Yankee = TZM_Y;
  303. TZM_Z = TZ_GMT;
  304. TZM_Zulu = TZM_Z;
  305. type
  306. { TODO: I'm sure these are stored in a unit elsewhere... need to find out } {Do not Localize}
  307. TDays = (TDaySun, TDayMon, TDayTue, TDayWed, TDayThu, TDayFri, TDaySat);
  308. TMonths = (TMthJan, TMthFeb, TMthMar, TMthApr, TMthMay, TMthJun,
  309. TMthJul, TMthAug, TMthSep, TMthOct, TMthNov, TMthDec);
  310. TIdDateTimeStamp = class(TIdBaseComponent)
  311. protected
  312. FDay : Integer;
  313. FIsLeapYear : Boolean;
  314. FMillisecond : Integer;
  315. FSecond : Integer;
  316. FTimeZone : Integer; // Number of minutes + / - from GMT / UTC
  317. FYear : Integer;
  318. procedure CheckLeapYear;
  319. procedure SetDateFromISO8601(AString : String);
  320. procedure SetTimeFromISO8601(AString : String);
  321. procedure InitComponent; override;
  322. public
  323. procedure AddDays(ANumber : UInt32);
  324. procedure AddHours(ANumber : UInt32);
  325. procedure AddMilliseconds(ANumber : UInt32);
  326. procedure AddMinutes(ANumber : UInt32);
  327. procedure AddMonths(ANumber : UInt32);
  328. procedure AddSeconds(ANumber : UInt32);
  329. procedure AddTDateTime(ADateTime : TDateTime);
  330. procedure AddTIdDateTimeStamp(AIdDateTime : TIdDateTimeStamp);
  331. procedure AddTTimeStamp(ATimeStamp : TIdDateTimeStamp);
  332. procedure AddWeeks(ANumber : UInt32);
  333. procedure AddYears(ANumber : UInt32);
  334. function GetAsISO8601Calendar : String;
  335. function GetAsISO8601Ordinal : String;
  336. function GetAsISO8601Week : String;
  337. function GetAsRFC822 : String;
  338. {TODO : function GetAsRFC977DateTime : String;}
  339. function GetAsTDateTime : TDateTime;
  340. function GetAsTTimeStamp : TIdDateTimeStamp;
  341. function GetAsTimeOfDay : String; // HH:MM:SS
  342. function GetBeatOfDay : Integer;
  343. function GetDaysInYear : Integer;
  344. function GetDayOfMonth : Integer;
  345. function GetDayOfWeek : Integer;
  346. function GetDayOfWeekName : String;
  347. function GetDayOfWeekShortName : String;
  348. function GetHourOf12Day : Integer;
  349. function GetHourOf24Day : Integer;
  350. function GetIsMorning : Boolean;
  351. function GetMinuteOfDay : Integer;
  352. function GetMinuteOfHour : Integer;
  353. function GetMonthOfYear : Integer;
  354. function GetMonthName : String;
  355. function GetMonthShortName : String;
  356. function GetSecondsInYear : Integer;
  357. function GetSecondOfMinute : Integer;
  358. function GetTimeZoneAsString: String;
  359. function GetTimeZoneHour: Integer;
  360. function GetTimeZoneMinutes: Integer;
  361. function GetWeekOfYear : Integer;
  362. procedure SetFromDOSDateTime(ADate, ATime : Word);
  363. procedure SetFromISO8601(AString : String);
  364. procedure SetFromRFC822(AString : String);
  365. procedure SetFromTDateTime(ADateTime : TDateTime);
  366. procedure SetFromTTimeStamp(ATimeStamp : TIdDateTimeStamp);
  367. procedure SetDay(ANumber : Integer);
  368. procedure SetMillisecond(ANumber : Integer);
  369. procedure SetSecond(ANumber : Integer);
  370. procedure SetTimeZone(const Value: Integer);
  371. procedure SetYear(ANumber : Integer);
  372. procedure SubtractDays(ANumber : UInt32);
  373. procedure SubtractHours(ANumber : UInt32);
  374. procedure SubtractMilliseconds(ANumber : UInt32);
  375. procedure SubtractMinutes(ANumber : UInt32);
  376. procedure SubtractMonths(ANumber : UInt32);
  377. procedure SubtractSeconds(ANumber : UInt32);
  378. procedure SubtractTDateTime(ADateTime : TDateTime);
  379. procedure SubtractTIdDateTimeStamp(AIdDateTime : TIdDateTimeStamp);
  380. procedure SubtractTTimeStamp(ATimeStamp : TIdDateTimeStamp);
  381. procedure SubtractWeeks(ANumber : UInt32);
  382. procedure SubtractYears(ANumber : UInt32);
  383. procedure Zero;
  384. procedure ZeroDate;
  385. procedure ZeroTime;
  386. property AsISO8601Calendar : String read GetAsISO8601Calendar;
  387. property AsISO8601Ordinal : String read GetAsISO8601Ordinal;
  388. property AsISO8601Week : String read GetAsISO8601Week;
  389. property AsRFC822 : String read GetAsRFC822;
  390. property AsTDateTime : TDateTime read GetAsTDateTime;
  391. property AsTTimeStamp : TIdDateTimeStamp read GetAsTTimeStamp;
  392. property AsTimeOfDay : String read GetAsTimeOfDay;
  393. property BeatOfDay : Integer read GetBeatOfDay;
  394. property Day : Integer read FDay write SetDay;
  395. property DaysInYear : Integer read GetDaysInYear;
  396. property DayOfMonth : Integer read GetDayOfMonth;
  397. property DayOfWeek : Integer read GetDayOfWeek;
  398. property DayOfWeekName : String read GetDayOfWeekName;
  399. property DayOfWeekShortName : String read GetDayOfWeekShortName;
  400. property HourOf12Day : Integer read GetHourOf12Day;
  401. property HourOf24Day : Integer read GetHourOf24Day;
  402. property IsLeapYear : Boolean read FIsLeapYear;
  403. property IsMorning : Boolean read GetIsMorning;
  404. property Millisecond : Integer read FMillisecond write SetMillisecond;
  405. property MinuteOfDay : Integer read GetMinuteOfDay;
  406. property MinuteOfHour : Integer read GetMinuteOfHour;
  407. property MonthOfYear : Integer read GetMonthOfYear;
  408. property MonthName : String read GetMonthName;
  409. property MonthShortName : String read GetMonthShortName;
  410. property Second : Integer read FSecond write SetSecond;
  411. property SecondsInYear : Integer read GetSecondsInYear;
  412. property SecondOfMinute : Integer read GetSecondOfMinute;
  413. property TimeZone : Integer read FTimeZone write SetTimeZone;
  414. property TimeZoneHour : Integer read GetTimeZoneHour;
  415. property TimeZoneMinutes : Integer read GetTimeZoneMinutes;
  416. property TimeZoneAsString : String read GetTimeZoneAsString;
  417. property Year : Integer read FYear write SetYear;
  418. property WeekOfYear : Integer read GetWeekOfYear;
  419. end;
  420. implementation
  421. uses
  422. IdGlobalProtocols,
  423. SysUtils;
  424. const
  425. MaxWeekAdd : UInt32 = $FFFFFFFF div IdDaysInWeek;
  426. MaxMinutesAdd : UInt32 = $FFFFFFFF div IdSecondsInMinute;
  427. DIGITS : String = '0123456789'; {Do not Localize}
  428. function LocalDateTimeToTimeStamp(ADateTime: TDateTime): TIdDateTimeStamp;
  429. var
  430. Year,
  431. Month,
  432. Day,
  433. Hour,
  434. Minute,
  435. Second,
  436. MSec: Word;
  437. begin
  438. DecodeDate(ADateTime, Year, Month, Day);
  439. DecodeTime(ADateTime, Hour, Minute, Second, MSec);
  440. Result := TIdDateTimeStamp.Create;
  441. Result.Zero;
  442. Result.AddYears(Year);
  443. Result.AddMonths(Month);
  444. Result.AddDays(Day);
  445. Result.AddHours(Hour);
  446. Result.AddMinutes(Minute);
  447. Result.AddSeconds(Second);
  448. Result.AddMilliseconds(MSec);
  449. end;
  450. procedure ValidateTimeStamp(const ATimeStamp: TIdDateTimeStamp);
  451. begin
  452. IdGlobal.ToDo('ValidateTimeStamp() function in IdDateTimeStamp.pas is not implemented yet'); {do not localize}
  453. // if (ATimeStamp.Time < 0) or (ATimeStamp.Date <= 0) then
  454. // EIdExceptionBase.CreateFmt('''%d.%d'' is not a valid timestamp', [ATimeStamp.Date, ATimeStamp.Time]);
  455. end;
  456. function LocalTimeStampToDateTime(const ATimeStamp: TIdDateTimeStamp): TDateTime;
  457. begin
  458. ValidateTimeStamp(ATimeStamp);
  459. Result := EncodeDate(ATimeStamp.Year, ATimeStamp.MonthOfYear, ATimeStamp.DayOfMonth) +
  460. EncodeTime(ATimeStamp.HourOf24Day, ATimeStamp.MinuteOfHour, ATimeStamp.SecondOfMinute, ATimeStamp.Millisecond);
  461. end;
  462. ///////////////////
  463. // TIdDateTimeStamp
  464. ///////////////////
  465. procedure TIdDateTimeStamp.InitComponent;
  466. begin
  467. inherited InitComponent;
  468. Zero;
  469. FTimeZone := 0;
  470. end;
  471. procedure TIdDateTimeStamp.AddDays;
  472. var
  473. i : Integer;
  474. begin
  475. // First 'round off' the current day of the year. This is done to prevent {Do not Localize}
  476. // miscalculations in leap years and also as an optimisation for small
  477. // increments.
  478. if (ANumber > UInt32(DaysInYear - FDay)) and (not (FDay = 1)) then begin
  479. ANumber := ANumber - UInt32(DaysInYear - FDay);
  480. FDay := 0;
  481. AddYears(1);
  482. end else begin
  483. // The number of days added is contained within this year.
  484. FDay := FDay + Integer(ANumber);
  485. if FDay > DaysInYear then
  486. begin
  487. ANumber := FDay;
  488. FDay := 0;
  489. AddDays(ANumber);
  490. end;
  491. Exit;
  492. end;
  493. if ANumber >= IdDaysInLeapYearCycle then begin
  494. i := ANumber div IdDaysInLeapYearCycle;
  495. AddYears(i * IdYearsInLeapYearCycle);
  496. ANumber := ANumber - UInt32(i * IdDaysInLeapYearCycle);
  497. end;
  498. if ANumber >= IdDaysInLeapCentury then begin
  499. while ANumber >= IDDaysInLeapCentury do begin
  500. i := FYear div 100;
  501. if i mod 4 = 3 then begin
  502. // Going forward through a 'leap' century {Do not Localize}
  503. AddYears(IdYearsInCentury);
  504. ANumber := ANumber - UInt32(IdDaysInLeapCentury);
  505. end else begin
  506. AddYears(IdYearsInCentury);
  507. ANumber := ANumber - UInt32(IdDaysInCentury);
  508. end;
  509. end;
  510. end;
  511. if ANumber >= IdDaysInShortLeapYearCycle then begin
  512. i := ANumber div IdDaysInShortLeapYearCycle;
  513. AddYears(i * IdYearsInShortLeapYearCycle);
  514. ANumber := ANumber - UInt32(i * IdDaysInShortLeapYearCycle);
  515. end;
  516. i := GetDaysInYear;
  517. while Integer(ANumber) > i do begin
  518. AddYears(1);
  519. Dec(ANumber, i);
  520. i := GetDaysInYear;
  521. end;
  522. if FDay + Integer(ANumber) > i then begin
  523. AddYears(1);
  524. Dec(ANumber, i - FDay);
  525. FDay := ANumber;
  526. end else begin
  527. Inc(FDay, ANumber);
  528. end;
  529. end;
  530. procedure TIdDateTimeStamp.AddHours;
  531. var
  532. i : UInt32;
  533. begin
  534. i := ANumber div IdHoursInDay;
  535. AddDays(i);
  536. Dec(ANumber, i * IdHoursInDay);
  537. AddSeconds(ANumber * IdSecondsInHour);
  538. end;
  539. procedure TIdDateTimeStamp.AddMilliseconds;
  540. var
  541. i : UInt32;
  542. begin
  543. i := ANumber div IdMillisecondsInDay;
  544. if i > 0 then begin
  545. AddDays(i);
  546. Dec(ANumber, i * IdMillisecondsInDay);
  547. end;
  548. i := ANumber div IdMillisecondsInSecond;
  549. if i > 0 then begin
  550. AddSeconds(i);
  551. Dec(ANumber, i * IdMillisecondsInSecond);
  552. end;
  553. Inc(FMillisecond, ANumber);
  554. while FMillisecond > IdMillisecondsInSecond do begin
  555. // Should only happen once...
  556. AddSeconds(1);
  557. Dec(FMillisecond, IdMillisecondsInSecond);
  558. end;
  559. end;
  560. procedure TIdDateTimeStamp.AddMinutes;
  561. begin
  562. // Convert down to seconds
  563. while ANumber > MaxMinutesAdd do begin
  564. AddSeconds(MaxMinutesAdd);
  565. Dec(ANumber, MaxMinutesAdd);
  566. end;
  567. AddSeconds(ANumber * IdSecondsInMinute);
  568. end;
  569. procedure TIdDateTimeStamp.AddMonths;
  570. var
  571. i : Integer;
  572. begin
  573. i := ANumber div IdMonthsInYear;
  574. AddYears(i);
  575. Dec(ANumber, i * IdMonthsInYear);
  576. i := MonthOfYear;
  577. while ANumber > 0 do begin
  578. if i = 12 then begin
  579. i := 1;
  580. end;
  581. if (i = 2) and (IsLeapYear) then begin
  582. AddDays(IdDaysInMonth[i] + 1);
  583. end else begin
  584. AddDays(IdDaysInMonth[i]);
  585. end;
  586. Dec(ANumber);
  587. Inc(i);
  588. end;
  589. end;
  590. procedure TIdDateTimeStamp.AddSeconds;
  591. var
  592. i : UInt32;
  593. begin
  594. i := ANumber Div IdSecondsInDay;
  595. if i > 0 then begin
  596. AddDays(i);
  597. ANumber := ANumber - (i * IdSecondsInDay);
  598. end;
  599. Inc(FSecond, ANumber);
  600. while FSecond > IdSecondsInDay do begin
  601. // Should only ever happen once...
  602. AddDays(1);
  603. Dec(FSecond, IdSecondsInDay);
  604. end;
  605. end;
  606. procedure TIdDateTimeStamp.AddTDateTime;
  607. begin
  608. // todo:
  609. // AddTTimeStamp(DateTimeToTimeStamp(ADateTime));
  610. end;
  611. procedure TIdDateTimeStamp.AddTIdDateTimeStamp;
  612. begin
  613. { TODO : Check for accuracy }
  614. AddYears(AIdDateTime.Year);
  615. AddDays(AIdDateTime.Day);
  616. AddSeconds(AIdDateTime.Second);
  617. AddMilliseconds(AIdDateTime.Millisecond);
  618. end;
  619. procedure TIdDateTimeStamp.AddTTimeStamp;
  620. begin
  621. AddTIdDateTimeStamp(ATimeStamp);
  622. end;
  623. procedure TIdDateTimeStamp.AddWeeks;
  624. begin
  625. // Cannot add years as there are not exactly 52 weeks in the year and there
  626. // is no exact match between weeks and the 400 year leap cycle
  627. // Convert down to days...
  628. while ANumber > MaxWeekAdd do begin
  629. AddDays(MaxWeekAdd);
  630. Dec(ANumber, MaxWeekAdd);
  631. end;
  632. AddDays(ANumber * IdDaysInWeek);
  633. end;
  634. procedure TIdDateTimeStamp.AddYears;
  635. begin
  636. {TODO: Capture overflow because adding UInt32 to Integer }
  637. if (FYear <= -1) and (Integer(ANumber) >= -FYear) then begin
  638. Inc(ANumber);
  639. end;
  640. Inc(FYear, ANumber);
  641. CheckLeapYear;
  642. end;
  643. procedure TIdDateTimeStamp.CheckLeapYear;
  644. begin
  645. // Nested if done to prevent unnecessary calcs on slower machines
  646. if FYear mod 4 = 0 then begin
  647. if FYear mod 100 = 0 then begin
  648. if FYear mod 400 = 0 then begin
  649. FIsLeapYear := True;
  650. end else begin
  651. FIsLeapYear := False;
  652. end;
  653. end else begin
  654. FIsLeapYear := True;
  655. end;
  656. end else begin
  657. FIsLeapYear := False;
  658. end;
  659. {TODO : If (FIsLeapYear = false) and (FDay = IdDaysInLeapYear) then begin
  660. and, do what?
  661. }
  662. end;
  663. function TIdDateTimeStamp.GetAsISO8601Calendar : String;
  664. begin
  665. Result := IntToStr(FYear) + '-' {Do not Localize}
  666. + IntToStr(MonthOfYear) + '-' {Do not Localize}
  667. + IntToStr(DayOfMonth) + 'T' {Do not Localize}
  668. + AsTimeOfDay;
  669. end;
  670. function TIdDateTimeStamp.GetAsISO8601Ordinal : String;
  671. begin
  672. Result := IntToStr(FYear) + '-' {Do not Localize}
  673. + IntToStr(FDay) + 'T' {Do not Localize}
  674. + AsTimeOfDay;
  675. end;
  676. function TIdDateTimeStamp.GetAsISO8601Week : String;
  677. begin
  678. Result := IntToStr(FYear) + '-W' {Do not Localize}
  679. + IntToStr(WeekOfYear) + '-' {Do not Localize}
  680. + IntToStr(DayOfWeek) + 'T' {Do not Localize}
  681. + AsTimeOfDay;
  682. end;
  683. function TIdDateTimeStamp.GetAsRFC822 : String;
  684. begin
  685. Result := IdDayShortNames[DayOfWeek] + ', ' {Do not Localize}
  686. + IntToStr(DayOfMonth) + ' ' {Do not Localize}
  687. + IdMonthShortNames[MonthOfYear] + ' ' {Do not Localize}
  688. + IntToStr(Year) + ' ' {Do not Localize}
  689. + AsTimeOfDay + ' ' {Do not Localize}
  690. + TimeZoneAsString;
  691. end;
  692. function TIdDateTimeStamp.GetAsTDateTime : TDateTime;
  693. begin
  694. Result := LocalTimeStampToDateTime(GetAsTTimeStamp);
  695. end;
  696. function TIdDateTimeStamp.GetAsTTimeStamp : TIdDateTimeStamp;
  697. begin
  698. Result := Self;
  699. end;
  700. function TIdDateTimeStamp.GetAsTimeOfDay : String;
  701. begin
  702. Result := IndyFormat('%.2d:%.2d:%.2d', {Do not localize}
  703. [HourOf24Day, MinuteOfHour, SecondOfMinute]);
  704. end;
  705. function TIdDateTimeStamp.GetBeatOfDay : Integer;
  706. var
  707. i64 : Int64;
  708. DTS : TIdDateTimeStamp;
  709. begin
  710. // Check
  711. if FTimeZone <> TZ_MET then
  712. begin
  713. // Rather than messing about with this instance, create
  714. // a new one.
  715. DTS := TIdDateTimeStamp.Create;
  716. try
  717. DTS.SetYear(FYear);
  718. DTS.SetDay(FDay);
  719. DTS.SetSecond(FSecond);
  720. DTS.SetMillisecond(FMillisecond);
  721. DTS.SetTimeZone(TZ_MET);
  722. DTS.AddMinutes( (TZ_MET * IdMinutesInHour) - FTimeZone);
  723. Result := DTS.GetBeatOfDay;
  724. finally
  725. DTS.Free;
  726. end;
  727. end else
  728. begin
  729. i64 := (FSecond * IdMillisecondsInSecond) + FMillisecond;
  730. i64 := i64 * IdBeatsInDay;
  731. i64 := i64 div IdMillisecondsInDay;
  732. Result := Integer(i64);
  733. end;
  734. end;
  735. function TIdDateTimeStamp.GetDaysInYear : Integer;
  736. begin
  737. if IsLeapYear then begin
  738. Result := IdDaysInLeapYear;
  739. end else begin
  740. Result := IdDaysInYear;
  741. end;
  742. end;
  743. function TIdDateTimeStamp.GetDayOfMonth : Integer;
  744. var
  745. count, mnth, days : Integer;
  746. begin
  747. mnth := MonthOfYear;
  748. if IsLeapYear and (mnth > 2) then begin
  749. days := 1;
  750. end else begin
  751. days := 0;
  752. end;
  753. for count := 1 to mnth - 1 do begin
  754. Inc(days, IdDaysInMonth[count]);
  755. end;
  756. days := Day - days;
  757. if days < 0 then begin
  758. Result := 0;
  759. end else begin
  760. Result := days;
  761. end;
  762. end;
  763. function TIdDateTimeStamp.GetDayOfWeek : Integer;
  764. var
  765. a, y, m, d, mnth : Integer;
  766. begin
  767. // Thanks to the "FAQ About Calendars" by Claus Tøndering for this algorithm
  768. // http://www.tondering.dk/claus/calendar.html
  769. mnth := MonthOfYear;
  770. a := (14 - mnth) div 12;
  771. y := Year - a;
  772. m := mnth + (12 * a) - 2;
  773. d := DayOfMonth + y + (y div 4) - (y div 100) + (y div 400) + ((31 * m) div 12);
  774. d := d mod 7;
  775. Result := d + 1;
  776. end;
  777. function TIdDateTimeStamp.GetDayOfWeekName : String;
  778. begin
  779. result := IdDayNames[GetDayOfWeek];
  780. end;
  781. function TIdDateTimeStamp.GetDayOfWeekShortName : String;
  782. begin
  783. result := IdDayShortNames[GetDayOfWeek];
  784. end;
  785. function TIdDateTimeStamp.GetHourOf12Day : Integer;
  786. var
  787. hr : Integer;
  788. begin
  789. hr := GetHourOf24Day;
  790. if hr > IdHoursInHalfDay then begin
  791. Dec(hr, IdHoursInHalfDay);
  792. end;
  793. Result := hr;
  794. end;
  795. function TIdDateTimeStamp.GetHourOf24Day : Integer;
  796. begin
  797. Result := Second div IdSecondsInHour;
  798. end;
  799. function TIdDateTimeStamp.GetIsMorning : Boolean;
  800. begin
  801. Result := Second <= (IdSecondsInHalfDay + 1);
  802. end;
  803. function TIdDateTimeStamp.GetMinuteOfDay : Integer;
  804. begin
  805. Result := Second div IdSecondsInMinute;
  806. end;
  807. function TIdDateTimeStamp.GetMinuteOfHour : Integer;
  808. begin
  809. Result := GetMinuteOfDay - (IdMinutesInHour * GetHourOf24Day);
  810. end;
  811. function TIdDateTimeStamp.GetMonthOfYear : Integer;
  812. var
  813. AddOne, Count : Byte;
  814. Today : Integer;
  815. begin
  816. Result := 0;
  817. if IsLeapYear then begin
  818. AddOne := 1;
  819. end else begin
  820. AddOne := 0;
  821. end;
  822. Today := Day;
  823. Count := 1;
  824. while Count <> 13 do begin
  825. if Count = 2 then begin
  826. if Today > IdDaysInMonth[Count] + AddOne then begin
  827. Dec(Today, IdDaysInMonth[Count] + AddOne);
  828. end else begin
  829. Result := Count;
  830. Break;
  831. end;
  832. end else begin
  833. if Today > IdDaysInMonth[Count] then begin
  834. Dec(Today, IdDaysInMonth[Count]);
  835. end else begin
  836. Result := Count;
  837. Break;
  838. end;
  839. end;
  840. Inc(Count);
  841. end;
  842. end;
  843. function TIdDateTimeStamp.GetMonthName : String;
  844. begin
  845. Result := IdMonthNames[MonthOfYear];
  846. end;
  847. function TIdDateTimeStamp.GetMonthShortName : String;
  848. begin
  849. Result := IdMonthShortNames[MonthOfYear];
  850. end;
  851. function TIdDateTimeStamp.GetSecondsInYear : Integer;
  852. begin
  853. if IsLeapYear then begin
  854. Result := IdSecondsInLeapYear;
  855. end else begin
  856. Result := IdSecondsInYear;
  857. end;
  858. end;
  859. function TIdDateTimeStamp.GetSecondOfMinute : Integer;
  860. begin
  861. Result := Second - (GetMinuteOfDay * IdSecondsInMinute);
  862. end;
  863. function TIdDateTimeStamp.GetTimeZoneAsString: String;
  864. var
  865. i : Integer;
  866. begin
  867. i := GetTimeZoneHour;
  868. if i < 0 then begin
  869. if i < -9 then begin
  870. Result := IntToStr(i);
  871. end else begin
  872. Result := '-0' + IntToStr(Abs(i)); {Do not Localize}
  873. end;
  874. end
  875. else if i <= 9 then begin
  876. Result := '+0' + IntToStr(i); {Do not Localize}
  877. end else
  878. begin
  879. Result := '+' + IntToStr(i); {Do not Localize}
  880. end;
  881. i := GetTimeZoneMinutes;
  882. if i <= 9 then begin
  883. Result := Result + '0'; {Do not Localize}
  884. end;
  885. Result := Result + IntToStr(i);
  886. end;
  887. function TIdDateTimeStamp.GetTimeZoneHour: Integer;
  888. begin
  889. Result := FTimeZone div 60;
  890. end;
  891. function TIdDateTimeStamp.GetTimeZoneMinutes: Integer;
  892. begin
  893. Result := Abs(FTimeZone) mod 60;
  894. end;
  895. function TIdDateTimeStamp.GetWeekOfYear : Integer;
  896. var
  897. w : Integer;
  898. DT : TIdDateTimeStamp;
  899. begin
  900. DT := TIdDateTimeStamp.Create;
  901. try
  902. DT.SetYear(Year);
  903. w := DT.DayOfWeek; // Get the first day of this year & hence number of
  904. // days of the first week that are in the previous year
  905. w := w + Day - 2; // Get complete weeks
  906. w := w div 7;
  907. Result := w + 1;
  908. finally
  909. DT.Free;
  910. end;
  911. end;
  912. procedure TIdDateTimeStamp.SetFromDOSDateTime(ADate, ATime: Word);
  913. begin
  914. Zero;
  915. SetYear(1980);
  916. AddYears(ADate shr 9);
  917. AddMonths(((ADate and $1E0) shr 5) - 1);
  918. AddDays((ADate and $1F) - 1);
  919. AddHours(ATime shr 11);
  920. AddMinutes((ATime and $7E0) shr 5);
  921. AddSeconds((ATime and $1F) - 1);
  922. end;
  923. procedure TIdDateTimeStamp.SetDateFromISO8601(AString: String);
  924. var
  925. i, week : Integer;
  926. s : String;
  927. begin
  928. // AString should be in one of three formats:
  929. // Calender - YYYY-MM-DD
  930. // Ordinal - YYYY-XXX where XXX is the day of the year
  931. // Week - YYYY-WXX-D where W is a literal and XX is the week of the year.
  932. i := IndyPos('-', AString); {Do not Localize}
  933. if i > 0 then
  934. begin
  935. s := Trim(Copy(AString, 1, i - 1));
  936. AString := Trim(Copy(AString, i + 1, MaxInt));
  937. i := FindFirstNotOf('0123456789', s); {Do not Localize}
  938. if i = 0 then
  939. begin
  940. SetYear(IndyStrToInt(s));
  941. if Length(AString) > 0 then
  942. begin
  943. i := IndyPos('-', AString); {Do not Localize}
  944. if TextStartsWith(AString, 'W') then {Do not Localize}
  945. begin
  946. // Week format
  947. s := Trim(Copy(AString, 2, i - 2));
  948. AString := Trim(Copy(AString, i + 1, MaxInt));
  949. week := -1;
  950. i := -1;
  951. if (Length(AString) > 0) and (FindFirstNotOf(DIGITS, AString) = 0) then
  952. begin
  953. i := IndyStrToInt(AString);
  954. end;
  955. if (Length(s) > 0) and (FindFirstNotOf(DIGITS, AString) = 0) then
  956. begin
  957. week := IndyStrToInt(s);
  958. end;
  959. if (week > 0) and (i >= 0) then
  960. begin
  961. Dec(week);
  962. FDay := 1 + (IdDaysInWeek * week);
  963. // Now have the correct week of the year
  964. if i < GetDayOfWeek then begin
  965. SubtractDays(GetDayOfWeek - i);
  966. end else begin
  967. AddDays(i - GetDayOfWeek);
  968. end;
  969. end;
  970. end
  971. else if i > 0 then
  972. begin
  973. // Calender format
  974. s := Trim(Copy(AString, 1, i - 1));
  975. AString := Trim(Copy(AString, i + 1, MaxInt));
  976. // Set the day first due to internal format.
  977. if (Length(AString) > 0) and (FindFirstNotOf(DIGITS, s) = 0) then
  978. begin
  979. SetDay(IndyStrToInt(AString));
  980. end;
  981. // Add the months.
  982. if (Length(s) > 0) and (FindFirstNotOf(DIGITS, s) = 0) then
  983. begin
  984. AddMonths(IndyStrToInt(s) - 1);
  985. end;
  986. end else
  987. begin
  988. // Ordinal format
  989. i := FindFirstNotOf(DIGITS, AString);
  990. if i = 0 then begin
  991. SetDay(IndyStrToInt(AString));
  992. end;
  993. end;
  994. end;
  995. end;
  996. end;
  997. end;
  998. procedure TIdDateTimeStamp.SetTimeFromISO8601(AString: String);
  999. var
  1000. i : Integer;
  1001. Hour, Minute : String;
  1002. begin
  1003. // AString should be in the format of HH:MM:SS where : is a literal.
  1004. i := IndyPos(':', AString); {Do not Localize}
  1005. Hour := Trim(Copy(AString, 1, i - 1));
  1006. AString := Trim(Copy(AString, i + 1, MaxInt));
  1007. i := IndyPos(':', AString); {Do not Localize}
  1008. Minute := Trim(Copy(AString, 1, i - 1));
  1009. AString := Trim(Copy(AString, i + 1, MaxInt));
  1010. // Set seconds first due to internal format.
  1011. if (Length(AString) > 0) and (FindFirstNotOf(DIGITS, AString) = 0) then
  1012. begin
  1013. SetSecond(IndyStrToInt(AString));
  1014. end;
  1015. if (Length(Minute) > 0) and (FindFirstNotOf(DIGITS, Minute) = 0) then
  1016. begin
  1017. AddMinutes(IndyStrToInt(Minute));
  1018. end;
  1019. if (Length(Hour) > 0) and (FindFirstNotOf(DIGITS, Hour) = 0) then
  1020. begin
  1021. AddHours(IndyStrToInt(Hour));
  1022. end;
  1023. end;
  1024. procedure TIdDateTimeStamp.SetFromISO8601(AString: String);
  1025. var
  1026. i : Integer;
  1027. begin
  1028. Zero;
  1029. i := IndyPos('T', AString); {Do not Localize}
  1030. if i > 0 then
  1031. begin
  1032. SetDateFromISO8601(Trim(Copy(AString, 1, i - 1)));
  1033. SetTimeFromISO8601(Trim(Copy(AString, i + 1, MaxInt)));
  1034. end else
  1035. begin
  1036. SetDateFromISO8601(AString);
  1037. SetTimeFromISO8601(AString);
  1038. end;
  1039. end;
  1040. procedure TIdDateTimeStamp.SetFromRFC822(AString: String);
  1041. begin
  1042. SetFromTDateTime(StrInternetToDateTime(AString))
  1043. end;
  1044. procedure TIdDateTimeStamp.SetFromTDateTime(ADateTime : TDateTime);
  1045. var
  1046. LStamp: TIdDateTimeStamp;
  1047. begin
  1048. LStamp := LocalDateTimeToTimeStamp(ADateTime);
  1049. try
  1050. SetFromTTimeStamp(LStamp);
  1051. finally
  1052. FreeAndNil(LStamp);
  1053. end;
  1054. end;
  1055. procedure TIdDateTimeStamp.SetFromTTimeStamp(ATimeStamp : TIdDateTimeStamp);
  1056. begin
  1057. FDay := ATimeStamp.Day;
  1058. FMillisecond := ATimeStamp.Millisecond;
  1059. FIsLeapYear := ATimeStamp.IsLeapYear;
  1060. FSecond := ATimeStamp.Second;
  1061. FTimeZone := ATimeStamp.TimeZone;
  1062. FYear := ATimeStamp.Year;
  1063. end;
  1064. procedure TIdDateTimeStamp.SetDay(ANumber : Integer);
  1065. begin
  1066. if ANumber > 0 then begin
  1067. FDay := 0;
  1068. AddDays(ANumber);
  1069. end else begin
  1070. FDay := 1;
  1071. end;
  1072. end;
  1073. procedure TIdDateTimeStamp.SetMillisecond(ANumber : Integer);
  1074. begin
  1075. FMillisecond := 0;
  1076. AddMilliseconds(ANumber);
  1077. end;
  1078. procedure TIdDateTimeStamp.SetSecond(ANumber : Integer);
  1079. begin
  1080. FSecond := 0;
  1081. AddSeconds(ANumber);
  1082. end;
  1083. procedure TIdDateTimeStamp.SetTimeZone(const Value: Integer);
  1084. begin
  1085. FTimeZone := Value;
  1086. end;
  1087. procedure TIdDateTimeStamp.SetYear(ANumber : Integer);
  1088. begin
  1089. If ANumber = 0 then begin
  1090. FYear := 1;
  1091. end else begin
  1092. FYear := ANumber;
  1093. end;
  1094. CheckLeapYear;
  1095. end;
  1096. procedure TIdDateTimeStamp.SubtractDays(ANumber : UInt32);
  1097. var
  1098. i : Integer;
  1099. begin
  1100. if ANumber = 0 then begin
  1101. Exit;
  1102. end;
  1103. // First remove the number of days in this year. As with AddDays this
  1104. // is both an optimisation and a fix for calculations that begin in leap years.
  1105. if ANumber >= UInt32(FDay - 1) then begin
  1106. ANumber := ANumber - UInt32(FDay - 1);
  1107. FDay := 1;
  1108. end else begin
  1109. FDay := FDay - Integer(ANumber);
  1110. end;
  1111. // Subtract the number of whole leap year cycles = 400 years
  1112. if ANumber >= IdDaysInLeapYearCycle then begin
  1113. i := ANumber div IdDaysInLeapYearCycle;
  1114. SubtractYears(i * IdYearsInLeapYearCycle);
  1115. ANumber := ANumber - UInt32(i * IdDaysInLeapYearCycle);
  1116. end;
  1117. // Next subtract the centuries, checking for the century that is passed through
  1118. if ANumber >= IdDaysInLeapCentury then begin
  1119. while ANumber >= IdDaysInLeapCentury do begin
  1120. i := FYear div 100;
  1121. if i mod 4 = 0 then begin
  1122. // Going back through a 'leap' century {Do not Localize}
  1123. SubtractYears(IdYearsInCentury);
  1124. ANumber := ANumber - UInt32(IdDaysInLeapCentury);
  1125. end else begin
  1126. SubtractYears(IdYearsInCentury);
  1127. ANumber := ANumber - UInt32(IdDaysInCentury);
  1128. end;
  1129. end;
  1130. end;
  1131. // Subtract multiples of 4 ("Short" Leap year cycle)
  1132. if ANumber >= IdDaysInShortLeapYearCycle then begin
  1133. while ANumber >= IdDaysInShortLeapYearCycle do begin
  1134. // Round off current year to nearest four.
  1135. i := (FYear shr 2) shl 2;
  1136. if SysUtils.IsLeapYear(i) then begin
  1137. // Normal
  1138. SubtractYears(IdYearsInShortLeapYearCycle);
  1139. ANumber := ANumber - UInt32(IdDaysInShortLeapYearCycle);
  1140. end else begin
  1141. // Subtraction crosses a 100-year (but not 400-year) boundary. Add the
  1142. // same number of years, but one less day.
  1143. SubtractYears(IdYearsInShortLeapYearCycle);
  1144. ANumber := ANumber - UInt32(IdDaysInShortNonLeapYearCycle);
  1145. end;
  1146. end;
  1147. end;
  1148. // Now the individual years
  1149. while ANumber > UInt32(DaysInYear) do begin
  1150. SubtractYears(1);
  1151. Dec(ANumber, DaysInYear);
  1152. if Self.IsLeapYear then begin
  1153. // Correct the assumption of a non-leap year
  1154. AddDays(1);
  1155. end;
  1156. end;
  1157. // and finally the remainders
  1158. if ANumber >= UInt32(FDay) then begin
  1159. SubtractYears(1);
  1160. ANumber := ANumber - UInt32(FDay);
  1161. Day := DaysInYear - Integer(ANumber);
  1162. end else begin
  1163. Dec(FDay, ANumber);
  1164. end;
  1165. end;
  1166. procedure TIdDateTimeStamp.SubtractHours(ANumber : UInt32);
  1167. var
  1168. i : UInt32;
  1169. begin
  1170. i := ANumber div IdHoursInDay;
  1171. SubtractDays(i);
  1172. Dec(ANumber, i * IdHoursInDay);
  1173. SubtractSeconds(ANumber * IdSecondsInHour);
  1174. end;
  1175. procedure TIdDateTimeStamp.SubtractMilliseconds(ANumber : UInt32);
  1176. var
  1177. i : UInt32;
  1178. begin
  1179. if ANumber = 0 then begin
  1180. Exit;
  1181. end;
  1182. i := ANumber div IdMillisecondsInDay;
  1183. SubtractDays(i);
  1184. Dec(ANumber, i * IdMillisecondsInDay);
  1185. i := ANumber div IdMillisecondsInSecond;
  1186. SubtractSeconds(i);
  1187. Dec(ANumber, i * IdMillisecondsInSecond);
  1188. Dec(FMillisecond, ANumber);
  1189. while FMillisecond <= 0 do begin
  1190. SubtractSeconds(1);
  1191. // FMillisecond is already negative, so add it.
  1192. FMillisecond := IdMillisecondsInSecond + FMillisecond;
  1193. end;
  1194. end;
  1195. procedure TIdDateTimeStamp.SubtractMinutes(ANumber : UInt32);
  1196. begin
  1197. // Down size to seconds
  1198. while ANumber > MaxMinutesAdd do begin
  1199. SubtractSeconds(MaxMinutesAdd * IdSecondsInMinute);
  1200. Dec(ANumber, MaxMinutesAdd);
  1201. end;
  1202. SubtractSeconds(ANumber * IdSecondsInMinute);
  1203. end;
  1204. procedure TIdDateTimeStamp.SubtractMonths(ANumber : UInt32);
  1205. var
  1206. i : Integer;
  1207. begin
  1208. i := ANumber div IdMonthsInYear;
  1209. SubtractYears(i);
  1210. Dec(ANumber, i * IdMonthsInYear);
  1211. while ANumber > 0 do begin
  1212. i := MonthOfYear;
  1213. if i = 1 then begin
  1214. i := 13;
  1215. end;
  1216. if (i = 3) and (IsLeapYear) then begin
  1217. SubtractDays(IdDaysInMonth[2] + 1);
  1218. end else begin
  1219. SubtractDays(IdDaysInMonth[i - 1]);
  1220. end;
  1221. Dec(ANumber);
  1222. end;
  1223. end;
  1224. procedure TIdDateTimeStamp.SubtractSeconds(ANumber : UInt32);
  1225. var
  1226. i : UInt32;
  1227. begin
  1228. if ANumber = 0 then begin
  1229. Exit;
  1230. end;
  1231. i := ANumber div IdSecondsInDay;
  1232. SubtractDays(i);
  1233. Dec(ANumber, i * IdSecondsInDay);
  1234. Dec(FSecond, ANumber);
  1235. If FSecond < 0 then begin
  1236. SubtractDays(1);
  1237. FSecond := IdSecondsInDay + FSecond;
  1238. end;
  1239. end;
  1240. procedure TIdDateTimeStamp.SubtractTDateTime(ADateTime : TDateTime);
  1241. var LStamp : TIdDateTimeStamp;
  1242. begin
  1243. LStamp := LocalDateTimeToTimeStamp(ADateTime);
  1244. try
  1245. SubtractTIdDateTimeStamp(LStamp);
  1246. finally
  1247. FreeAndNil(LStamp);
  1248. end;
  1249. end;
  1250. procedure TIdDateTimeStamp.SubtractTIdDateTimeStamp(AIdDateTime : TIdDateTimeStamp);
  1251. begin
  1252. { TODO : Check for accuracy }
  1253. SubtractYears(AIdDateTime.Year);
  1254. SubtractDays(AIdDateTime.Day);
  1255. SubtractSeconds(AIdDateTime.Second);
  1256. SubtractMilliseconds(AIdDateTime.Millisecond);
  1257. end;
  1258. procedure TIdDateTimeStamp.SubtractTTimeStamp(ATimeStamp : TIdDateTimeStamp);
  1259. begin
  1260. SubtractTIdDateTimeStamp(ATimeStamp);
  1261. end;
  1262. procedure TIdDateTimeStamp.SubtractWeeks(ANumber : UInt32);
  1263. begin
  1264. if ANumber = 0 then begin
  1265. Exit;
  1266. end;
  1267. // Down size to subtracting Days
  1268. while ANumber > MaxWeekAdd do begin
  1269. SubtractDays(MaxWeekAdd * IdDaysInWeek);
  1270. Dec(ANumber, MaxWeekAdd * IdDaysInWeek);
  1271. end;
  1272. SubtractDays(ANumber * IdDaysInWeek);
  1273. end;
  1274. procedure TIdDateTimeStamp.SubtractYears(ANumber : UInt32);
  1275. begin
  1276. if (FYear > 0) and (ANumber >= UInt32(FYear)) then begin
  1277. Inc(ANumber);
  1278. end;
  1279. FYear := FYear - Integer(ANumber);
  1280. CheckLeapYear;
  1281. end;
  1282. procedure TIdDateTimeStamp.Zero;
  1283. begin
  1284. ZeroDate;
  1285. ZeroTime;
  1286. FTimeZone := 0;
  1287. end;
  1288. procedure TIdDateTimeStamp.ZeroDate;
  1289. begin
  1290. SetYear(1);
  1291. SetDay(1);
  1292. end;
  1293. procedure TIdDateTimeStamp.ZeroTime;
  1294. begin
  1295. SetSecond(0);
  1296. SetMillisecond(0);
  1297. end;
  1298. end.