PageRenderTime 54ms CodeModel.GetById 18ms RepoModel.GetById 0ms app.codeStats 0ms

/ProSnooperFx_src/indy10.0.52_source/Protocols/IdDateTimeStamp.pas

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