DateTimeStamp.pas 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581
  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: 11235: DateTimeStamp.pas
  11. {
  12. { Rev 1.0 11/12/2002 09:15:16 PM JPMugaas
  13. { Initial check in. Import from FTP VC.
  14. }
  15. unit DateTimeStamp;
  16. interface
  17. uses
  18. IndyBox,
  19. IdDateTimeStamp,
  20. SysUtils;
  21. type
  22. TDateTimeStampBox = class(TIndyBox)
  23. protected
  24. strCmd, strIn, strOut : String;
  25. DTS, DTSIn, DTSOut: TIdDateTimeStamp;
  26. index : Integer;
  27. procedure AddItems(const AString : String;
  28. var ADTS : TIdDateTimeStamp);
  29. procedure CheckAgainstOutput(const AString : String;
  30. var ADTS : TIdDateTimeStamp);
  31. procedure GetNextPart(var AStr : String; var AChar : Char;
  32. var ANum : Integer);
  33. procedure ReadBasicFormat(const AString : String;
  34. var ADTS : TIdDateTimeStamp);
  35. procedure ReadTTimeStamp(const AString : String;
  36. var ATS : TTimeStamp);
  37. procedure SubtractItems(const AString : String;
  38. var ADTS : TIdDateTimeStamp);
  39. procedure DoNoTest;
  40. procedure DoAdd;
  41. procedure DoSubtract;
  42. procedure DoConvertFromRFC822;
  43. procedure DoConvertToRFC822;
  44. procedure DoConvertFromISO8601;
  45. procedure DoConvertToISO8601;
  46. procedure DoConvertTTimeStamp;
  47. public
  48. procedure Test; override;
  49. end;
  50. implementation
  51. uses
  52. Classes,
  53. Dialogs,
  54. IdGlobal,
  55. IdStrings;
  56. {$RANGECHECKS ON}
  57. { TDateTimeStampBox }
  58. procedure TDateTimeStampBox.DoAdd;
  59. begin
  60. ReadBasicFormat(strIn, DTS);
  61. AddItems(Trim(Copy(strCmd, 2, length(strCmd))), DTS);
  62. CheckAgainstOutput(strOut, DTS);
  63. end;
  64. procedure TDateTimeStampBox.DoConvertFromISO8601;
  65. begin
  66. DTS.SetFromISO8601(strIn);
  67. CheckAgainstOutput(strOut, DTS);
  68. end;
  69. procedure TDateTimeStampBox.DoConvertFromRFC822;
  70. begin
  71. DTS.SetFromRFC822(strIn);
  72. CheckAgainstOutput(strOut, DTS);
  73. end;
  74. procedure TDateTimeStampBox.DoConvertToISO8601;
  75. var
  76. s, format : String;
  77. i : Integer;
  78. begin
  79. ReadBasicFormat(strIn, DTS);
  80. if length(strCmd) > 1 then
  81. begin
  82. i := 0;
  83. case strCmd[2] of
  84. '1' :
  85. begin
  86. s := DTS.GetAsISO8601Calendar;
  87. format := 'calender';
  88. i := 1;
  89. end;
  90. '2' :
  91. begin
  92. s := DTS.GetAsISO8601Ordinal;
  93. format := 'ordinal';
  94. i := 2;
  95. end;
  96. '3' :
  97. begin
  98. s := DTS.GetAsISO8601Week;
  99. format := 'week';
  100. i := 3;
  101. end;
  102. end;
  103. if i <> 0 then begin
  104. Check(Trim(strOut) = s,
  105. 'Test ' + IntToStr(index + 1) +
  106. '. Failed on convert to ISO 8601 ' + format + ' format. Expected "'
  107. + strOut + '", got "' + s + '"');
  108. end;
  109. end;
  110. end;
  111. procedure TDateTimeStampBox.DoConvertToRFC822;
  112. begin
  113. ReadBasicFormat(strIn, DTS);
  114. Status('Convert to RFC 822 = ' + DTS.GetAsRFC822);
  115. Check(Trim(strOut) = Trim(DTS.GetAsRFC822),
  116. 'Test ' + IntToStr(index + 1) +
  117. '. Failed on convert to RFC 822 format. Expected "'
  118. + strOut + '", got "' + DTS.GetAsRFC822 + '"');
  119. end;
  120. procedure TDateTimeStampBox.DoNoTest;
  121. begin
  122. ReadBasicFormat(strIn, DTS);
  123. CheckAgainstOutput(strOut, DTS);
  124. end;
  125. procedure TDateTimeStampBox.DoSubtract;
  126. begin
  127. ReadBasicFormat(strIn, DTS);
  128. SubtractItems(Trim(Copy(strCmd, 2, length(strCmd))), DTS);
  129. CheckAgainstOutput(strOut, DTS);
  130. end;
  131. procedure TDateTimeStampBox.ReadBasicFormat(const AString: String;
  132. var ADTS: TIdDateTimeStamp);
  133. var
  134. c : char;
  135. i : Integer;
  136. s : String;
  137. begin
  138. s := Trim(AString);
  139. while length(s) > 0 do
  140. begin
  141. GetNextPart(s, c, i);
  142. case c of
  143. 'Y' : ADTS.Year := i;
  144. 'D' : ADTS.Day := i;
  145. 'S' : ADTS.Second := i;
  146. 'L' : ADTS.Millisecond := i;
  147. 'Z' : ADTS.TimeZone := i;
  148. end;
  149. end;
  150. end;
  151. procedure TDateTimeStampBox.CheckAgainstOutput(const AString : String;
  152. var ADTS : TIdDateTimeStamp);
  153. var
  154. c : char;
  155. i, j : Integer;
  156. resStr, s : String;
  157. res : Boolean;
  158. begin
  159. s := Trim(AString);
  160. res := false;
  161. j := 0;
  162. while length(s) > 0 do
  163. begin
  164. GetNextPart(s, c, i);
  165. resStr := '';
  166. case c of
  167. 'Y' :
  168. begin
  169. res := ADTS.Year = i;
  170. j := ADTS.Year;
  171. resStr := 'Year';
  172. end;
  173. 'D' :
  174. begin
  175. res := ADTS.Day = i;
  176. j := ADTS.Day;
  177. resStr := 'Day of Year';
  178. end;
  179. 'd' :
  180. begin
  181. res := ADTS.DayOfMonth = i;
  182. j := ADTS.DayOfMonth;
  183. resStr := 'Day of Month';
  184. end;
  185. 'S' :
  186. begin
  187. res := ADTS.Second = i;
  188. j := ADTS.Second;
  189. resStr := 'Second';
  190. end;
  191. 's' :
  192. begin
  193. res := ADTS.SecondOfMinute = i;
  194. j := ADTS.SecondOfMinute;
  195. resStr := 'Second of Minute';
  196. end;
  197. 'L' :
  198. begin
  199. res := ADTS.Millisecond = i;
  200. j := ADTS.Millisecond;
  201. resStr := 'Millisecond';
  202. end;
  203. 'Z' :
  204. begin
  205. res := ADTS.TimeZone = i;
  206. j := ADTS.TimeZone;
  207. resStr := 'Time Zone';
  208. end;
  209. 'B' :
  210. begin
  211. res := ADTS.BeatOfDay = i;
  212. j := ADTS.BeatOfDay;
  213. resStr := 'Beat of day';
  214. end;
  215. 'H' :
  216. begin
  217. res := ADTS.HourOf24Day = i;
  218. j := ADTS.HourOf24Day;
  219. resStr := '24-Hour';
  220. end;
  221. 'h' :
  222. begin
  223. res := ADTS.HourOf12Day = i;
  224. j := ADTS.HourOf12Day;
  225. resStr := '12-Hour';
  226. end;
  227. 'W' :
  228. begin
  229. res := ADTS.WeekOfYear = i;
  230. j := ADTS.WeekOfYear;
  231. resStr := 'Week of Year';
  232. end;
  233. 'w' :
  234. begin
  235. res := ADTS.DayOfWeek = i;
  236. j := ADTS.DayOfWeek;
  237. resStr := 'Day of Week';
  238. end;
  239. 'M' :
  240. begin
  241. res := ADTS.MonthOfYear = i;
  242. j := ADTS.MonthOfYear;
  243. resStr := 'Month of Year';
  244. end;
  245. 'm' :
  246. begin
  247. res := ADTS.MinuteOfDay = i;
  248. j := ADTS.MinuteOfDay;
  249. resStr := 'Minute Of Day';
  250. end;
  251. 'U' :
  252. begin
  253. res := ADTS.MinuteOfHour = i;
  254. j := ADTS.MinuteOfHour;
  255. resStr := 'Minute Of Hour';
  256. end;
  257. end;
  258. if length(resStr) <> 0 then
  259. begin
  260. Check(res, 'Test ' + IntToStr(index + 1) + '. Failed on '
  261. + resStr + '. Expected ' + IntToStr(i) + ', got '
  262. + IntToStr(j));
  263. end;
  264. end;
  265. end;
  266. procedure TDateTimeStampBox.SubtractItems(const AString : String;
  267. var ADTS : TIdDateTimeStamp);
  268. var
  269. c : char;
  270. i : Integer;
  271. s : String;
  272. begin
  273. s := Trim(AString);
  274. while length(s) > 0 do
  275. begin
  276. GetNextPart(s, c, i);
  277. case c of
  278. 'Y' :
  279. begin
  280. ADTS.SubtractYears(i);
  281. end;
  282. 'D' :
  283. begin
  284. ADTS.SubtractDays(i);
  285. end;
  286. 'S' :
  287. begin
  288. ADTS.SubtractSeconds(i);
  289. end;
  290. 'L' :
  291. begin
  292. ADTS.SubtractMilliseconds(i);
  293. end;
  294. 'H', 'h' :
  295. begin
  296. ADTS.SubtractHours(i);
  297. end;
  298. 'W' :
  299. begin
  300. ADTS.SubtractWeeks(i);
  301. end;
  302. 'm' :
  303. begin
  304. ADTS.SubtractMinutes(i);
  305. end;
  306. 'M' :
  307. begin
  308. ADTS.SubtractMonths(i);
  309. end;
  310. {
  311. 'Z' :
  312. begin
  313. res := ADTS.TimeZone = i;
  314. j := ADTS.TimeZone;
  315. resStr := 'Time Zone';
  316. end;
  317. 'B' :
  318. begin
  319. res := ADTS.BeatOfDay = i;
  320. j := ADTS.BeatOfDay;
  321. resStr := 'Beat of day';
  322. end;
  323. }
  324. end;
  325. end;
  326. end;
  327. procedure TDateTimeStampBox.AddItems(const AString : String;
  328. var ADTS : TIdDateTimeStamp);
  329. var
  330. c : char;
  331. i : Integer;
  332. s : String;
  333. begin
  334. s := Trim(AString);
  335. while length(s) > 0 do
  336. begin
  337. GetNextPart(s, c, i);
  338. case c of
  339. 'Y' :
  340. begin
  341. ADTS.AddYears(i);
  342. end;
  343. 'D' :
  344. begin
  345. ADTS.AddDays(i);
  346. end;
  347. 'S' :
  348. begin
  349. ADTS.AddSeconds(i);
  350. end;
  351. 'L' :
  352. begin
  353. ADTS.AddMilliseconds(i);
  354. end;
  355. 'H', 'h' :
  356. begin
  357. ADTS.AddHours(i);
  358. end;
  359. 'W' :
  360. begin
  361. ADTS.AddWeeks(i);
  362. end;
  363. 'M' :
  364. begin
  365. ADTS.AddMonths(i);
  366. end;
  367. 'm' :
  368. begin
  369. ADTS.AddMinutes(i);
  370. end;
  371. {
  372. 'Z' :
  373. begin
  374. res := ADTS.TimeZone = i;
  375. j := ADTS.TimeZone;
  376. resStr := 'Time Zone';
  377. end;
  378. 'B' :
  379. begin
  380. res := ADTS.BeatOfDay = i;
  381. j := ADTS.BeatOfDay;
  382. resStr := 'Beat of day';
  383. end;
  384. }
  385. end;
  386. end;
  387. end;
  388. procedure TDateTimeStampBox.Test;
  389. var
  390. TestData : TStringList;
  391. sindex : Integer;
  392. s : String;
  393. begin
  394. DTS := TIdDateTimeStamp.Create((Nil));
  395. DTSIn := TIdDateTimeStamp.Create(Nil);
  396. DTSOut := TIDDateTimeStamp.Create(Nil);
  397. TestData := TStringList.Create;
  398. try
  399. TestData.LoadFromFile(GetDataDir + 'DateTimeStamp.dat');
  400. index := 0;
  401. sindex := 0;
  402. while sindex < TestData.Count - 1 do
  403. begin
  404. s := TestData[sindex];
  405. if Length(s) > 0 then
  406. begin
  407. if s[1] = ':' then
  408. begin
  409. if TestData.Count > sindex + 3 then
  410. begin
  411. strCmd := TestData[sindex + 1];
  412. strIn := TestData[sindex + 2];
  413. strOut := TestData[sindex + 3];
  414. if length(strCmd) > 0 then begin
  415. DTS.Zero;
  416. DTSIn.Zero;
  417. DTSOut.Zero;
  418. case strCmd[1] of
  419. 'N' :
  420. begin
  421. DoNoTest;
  422. end;
  423. 'A' :
  424. begin
  425. DoAdd;
  426. end;
  427. 'S' :
  428. begin
  429. DoSubtract;
  430. end;
  431. 'I' :
  432. begin
  433. DoConvertFromRFC822;
  434. end;
  435. 'i' :
  436. begin
  437. DoConvertToRFC822;
  438. end;
  439. 'V' :
  440. begin
  441. DoConvertFromISO8601;
  442. end;
  443. 'v' :
  444. begin
  445. DoConvertToISO8601;
  446. end;
  447. 'T' :
  448. begin
  449. DoConvertTTimeStamp;
  450. end;
  451. end;
  452. end;
  453. Inc(sindex, 3);
  454. Inc(index);
  455. end;
  456. end;
  457. end;
  458. Inc(sindex);
  459. end;
  460. finally
  461. DTS.Free;
  462. DTSIn.Free;
  463. DTSOut.Free;
  464. end;
  465. end;
  466. procedure TDateTimeStampBox.GetNextPart(var AStr: String; var AChar: Char;
  467. var ANum: Integer);
  468. var
  469. fnd : Integer;
  470. num : String;
  471. begin
  472. AChar := ' ';
  473. ANum := 0;
  474. if Length(AStr) = 0 then exit;
  475. // Remove first character.
  476. AChar := AStr[1];
  477. System.Delete(AStr, 1, 1);
  478. // Should be followed by some numbers.
  479. fnd := FindFirstNotOf('-+0123456789', AStr);
  480. if fnd = 0 then
  481. begin
  482. num := AStr;
  483. AStr := '';
  484. end else
  485. begin
  486. num := Copy(AStr, 1, fnd - 1);
  487. end;
  488. AStr := Trim(Copy(AStr, fnd, length(AStr)));
  489. // num should now contain the numbers.
  490. if Length(num) = 0 then
  491. begin
  492. // The number has no content.
  493. exit;
  494. end;
  495. // Just to be on the safe side...
  496. if FindFirstNotOf('-+0123456789', num) > 0 then
  497. begin
  498. // The 'number' is not numeric.
  499. exit;
  500. end;
  501. ANum := StrToInt(num);
  502. end;
  503. procedure TDateTimeStampBox.DoConvertTTimeStamp;
  504. var
  505. TS : TTimeStamp;
  506. DT : TDateTime;
  507. Date : Integer;
  508. Time : Integer;
  509. begin
  510. ReadBasicFormat(strIn, DTS);
  511. TS := DTS.AsTTimeStamp;
  512. Date := TS.Date;
  513. Time := TS.Time;
  514. Status('TTimeStamp Date Got: ' + IntToStr(Date));
  515. Status('TTimeStamp Time Got: ' + IntToStr(Time));
  516. DT := EncodeDate(DTS.Year, DTS.MonthOfYear, DTS.DayOfMonth);
  517. TS := DateTimeToTimeStamp(DT);
  518. Status('TTimeStamp Date Expected: ' + IntToStr(TS.Date));
  519. Status('TTimeStamp Time Expected: ' + IntToStr(TS.Time));
  520. Check(Time = TS.Time, 'Test ' + IntToStr(index) +
  521. ': TTimeStamp.Time expected: ' + IntToStr(TS.Time) +
  522. ', got: ' + IntToStr(Time));
  523. Check(Date = TS.Date, 'Test ' + IntToStr(index) +
  524. ': TTimeStamp.Date expected: ' + IntToStr(TS.Date) +
  525. ', got: ' + IntToStr(Date));
  526. end;
  527. procedure TDateTimeStampBox.ReadTTimeStamp(const AString: String;
  528. var ATS: TTimeStamp);
  529. var
  530. Date, Time : String;
  531. i : Integer;
  532. begin
  533. Date := Copy(AString, 2, Length(AString));
  534. i := Pos('.', Date);
  535. if i = 0 then
  536. begin
  537. Check(false, 'Test ' + IntToStr(index) + ': '
  538. + 'Conversion of output data to TTimeStamp, no . found');
  539. end;
  540. Time := Copy(Date, i + 1, Length(Date));
  541. Date := Copy(Date, 0, i - 1);
  542. ATS.Time := StrToInt(Time);
  543. ATS.Date := StrToInt(Date);
  544. end;
  545. initialization
  546. TIndyBox.RegisterBox(TDateTimeStampBox, 'DateTimeStampProc', 'Misc');
  547. end.