| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581 |
- { $HDR$}
- {**********************************************************************}
- { Unit archived using Team Coherence }
- { Team Coherence is Copyright 2002 by Quality Software Components }
- { }
- { For further information / comments, visit our WEB site at }
- { http://www.TeamCoherence.com }
- {**********************************************************************}
- {}
- { $Log: 11235: DateTimeStamp.pas
- {
- { Rev 1.0 11/12/2002 09:15:16 PM JPMugaas
- { Initial check in. Import from FTP VC.
- }
- unit DateTimeStamp;
- interface
- uses
- IndyBox,
- IdDateTimeStamp,
- SysUtils;
- type
- TDateTimeStampBox = class(TIndyBox)
- protected
- strCmd, strIn, strOut : String;
- DTS, DTSIn, DTSOut: TIdDateTimeStamp;
- index : Integer;
- procedure AddItems(const AString : String;
- var ADTS : TIdDateTimeStamp);
- procedure CheckAgainstOutput(const AString : String;
- var ADTS : TIdDateTimeStamp);
- procedure GetNextPart(var AStr : String; var AChar : Char;
- var ANum : Integer);
- procedure ReadBasicFormat(const AString : String;
- var ADTS : TIdDateTimeStamp);
- procedure ReadTTimeStamp(const AString : String;
- var ATS : TTimeStamp);
- procedure SubtractItems(const AString : String;
- var ADTS : TIdDateTimeStamp);
- procedure DoNoTest;
- procedure DoAdd;
- procedure DoSubtract;
- procedure DoConvertFromRFC822;
- procedure DoConvertToRFC822;
- procedure DoConvertFromISO8601;
- procedure DoConvertToISO8601;
- procedure DoConvertTTimeStamp;
- public
- procedure Test; override;
- end;
- implementation
- uses
- Classes,
- Dialogs,
- IdGlobal,
- IdStrings;
- {$RANGECHECKS ON}
- { TDateTimeStampBox }
- procedure TDateTimeStampBox.DoAdd;
- begin
- ReadBasicFormat(strIn, DTS);
- AddItems(Trim(Copy(strCmd, 2, length(strCmd))), DTS);
- CheckAgainstOutput(strOut, DTS);
- end;
- procedure TDateTimeStampBox.DoConvertFromISO8601;
- begin
- DTS.SetFromISO8601(strIn);
- CheckAgainstOutput(strOut, DTS);
- end;
- procedure TDateTimeStampBox.DoConvertFromRFC822;
- begin
- DTS.SetFromRFC822(strIn);
- CheckAgainstOutput(strOut, DTS);
- end;
- procedure TDateTimeStampBox.DoConvertToISO8601;
- var
- s, format : String;
- i : Integer;
- begin
- ReadBasicFormat(strIn, DTS);
- if length(strCmd) > 1 then
- begin
- i := 0;
- case strCmd[2] of
- '1' :
- begin
- s := DTS.GetAsISO8601Calendar;
- format := 'calender';
- i := 1;
- end;
- '2' :
- begin
- s := DTS.GetAsISO8601Ordinal;
- format := 'ordinal';
- i := 2;
- end;
- '3' :
- begin
- s := DTS.GetAsISO8601Week;
- format := 'week';
- i := 3;
- end;
- end;
- if i <> 0 then begin
- Check(Trim(strOut) = s,
- 'Test ' + IntToStr(index + 1) +
- '. Failed on convert to ISO 8601 ' + format + ' format. Expected "'
- + strOut + '", got "' + s + '"');
- end;
- end;
- end;
- procedure TDateTimeStampBox.DoConvertToRFC822;
- begin
- ReadBasicFormat(strIn, DTS);
- Status('Convert to RFC 822 = ' + DTS.GetAsRFC822);
- Check(Trim(strOut) = Trim(DTS.GetAsRFC822),
- 'Test ' + IntToStr(index + 1) +
- '. Failed on convert to RFC 822 format. Expected "'
- + strOut + '", got "' + DTS.GetAsRFC822 + '"');
- end;
- procedure TDateTimeStampBox.DoNoTest;
- begin
- ReadBasicFormat(strIn, DTS);
- CheckAgainstOutput(strOut, DTS);
- end;
- procedure TDateTimeStampBox.DoSubtract;
- begin
- ReadBasicFormat(strIn, DTS);
- SubtractItems(Trim(Copy(strCmd, 2, length(strCmd))), DTS);
- CheckAgainstOutput(strOut, DTS);
- end;
- procedure TDateTimeStampBox.ReadBasicFormat(const AString: String;
- var ADTS: TIdDateTimeStamp);
- var
- c : char;
- i : Integer;
- s : String;
- begin
- s := Trim(AString);
- while length(s) > 0 do
- begin
- GetNextPart(s, c, i);
- case c of
- 'Y' : ADTS.Year := i;
- 'D' : ADTS.Day := i;
- 'S' : ADTS.Second := i;
- 'L' : ADTS.Millisecond := i;
- 'Z' : ADTS.TimeZone := i;
- end;
- end;
- end;
- procedure TDateTimeStampBox.CheckAgainstOutput(const AString : String;
- var ADTS : TIdDateTimeStamp);
- var
- c : char;
- i, j : Integer;
- resStr, s : String;
- res : Boolean;
- begin
- s := Trim(AString);
- res := false;
- j := 0;
- while length(s) > 0 do
- begin
- GetNextPart(s, c, i);
- resStr := '';
- case c of
- 'Y' :
- begin
- res := ADTS.Year = i;
- j := ADTS.Year;
- resStr := 'Year';
- end;
- 'D' :
- begin
- res := ADTS.Day = i;
- j := ADTS.Day;
- resStr := 'Day of Year';
- end;
- 'd' :
- begin
- res := ADTS.DayOfMonth = i;
- j := ADTS.DayOfMonth;
- resStr := 'Day of Month';
- end;
- 'S' :
- begin
- res := ADTS.Second = i;
- j := ADTS.Second;
- resStr := 'Second';
- end;
- 's' :
- begin
- res := ADTS.SecondOfMinute = i;
- j := ADTS.SecondOfMinute;
- resStr := 'Second of Minute';
- end;
- 'L' :
- begin
- res := ADTS.Millisecond = i;
- j := ADTS.Millisecond;
- resStr := 'Millisecond';
- end;
- 'Z' :
- begin
- res := ADTS.TimeZone = i;
- j := ADTS.TimeZone;
- resStr := 'Time Zone';
- end;
- 'B' :
- begin
- res := ADTS.BeatOfDay = i;
- j := ADTS.BeatOfDay;
- resStr := 'Beat of day';
- end;
- 'H' :
- begin
- res := ADTS.HourOf24Day = i;
- j := ADTS.HourOf24Day;
- resStr := '24-Hour';
- end;
- 'h' :
- begin
- res := ADTS.HourOf12Day = i;
- j := ADTS.HourOf12Day;
- resStr := '12-Hour';
- end;
- 'W' :
- begin
- res := ADTS.WeekOfYear = i;
- j := ADTS.WeekOfYear;
- resStr := 'Week of Year';
- end;
- 'w' :
- begin
- res := ADTS.DayOfWeek = i;
- j := ADTS.DayOfWeek;
- resStr := 'Day of Week';
- end;
- 'M' :
- begin
- res := ADTS.MonthOfYear = i;
- j := ADTS.MonthOfYear;
- resStr := 'Month of Year';
- end;
- 'm' :
- begin
- res := ADTS.MinuteOfDay = i;
- j := ADTS.MinuteOfDay;
- resStr := 'Minute Of Day';
- end;
- 'U' :
- begin
- res := ADTS.MinuteOfHour = i;
- j := ADTS.MinuteOfHour;
- resStr := 'Minute Of Hour';
- end;
- end;
- if length(resStr) <> 0 then
- begin
- Check(res, 'Test ' + IntToStr(index + 1) + '. Failed on '
- + resStr + '. Expected ' + IntToStr(i) + ', got '
- + IntToStr(j));
- end;
- end;
- end;
- procedure TDateTimeStampBox.SubtractItems(const AString : String;
- var ADTS : TIdDateTimeStamp);
- var
- c : char;
- i : Integer;
- s : String;
- begin
- s := Trim(AString);
- while length(s) > 0 do
- begin
- GetNextPart(s, c, i);
- case c of
- 'Y' :
- begin
- ADTS.SubtractYears(i);
- end;
- 'D' :
- begin
- ADTS.SubtractDays(i);
- end;
- 'S' :
- begin
- ADTS.SubtractSeconds(i);
- end;
- 'L' :
- begin
- ADTS.SubtractMilliseconds(i);
- end;
- 'H', 'h' :
- begin
- ADTS.SubtractHours(i);
- end;
- 'W' :
- begin
- ADTS.SubtractWeeks(i);
- end;
- 'm' :
- begin
- ADTS.SubtractMinutes(i);
- end;
- 'M' :
- begin
- ADTS.SubtractMonths(i);
- end;
- {
- 'Z' :
- begin
- res := ADTS.TimeZone = i;
- j := ADTS.TimeZone;
- resStr := 'Time Zone';
- end;
- 'B' :
- begin
- res := ADTS.BeatOfDay = i;
- j := ADTS.BeatOfDay;
- resStr := 'Beat of day';
- end;
- }
- end;
- end;
- end;
- procedure TDateTimeStampBox.AddItems(const AString : String;
- var ADTS : TIdDateTimeStamp);
- var
- c : char;
- i : Integer;
- s : String;
- begin
- s := Trim(AString);
- while length(s) > 0 do
- begin
- GetNextPart(s, c, i);
- case c of
- 'Y' :
- begin
- ADTS.AddYears(i);
- end;
- 'D' :
- begin
- ADTS.AddDays(i);
- end;
- 'S' :
- begin
- ADTS.AddSeconds(i);
- end;
- 'L' :
- begin
- ADTS.AddMilliseconds(i);
- end;
- 'H', 'h' :
- begin
- ADTS.AddHours(i);
- end;
- 'W' :
- begin
- ADTS.AddWeeks(i);
- end;
- 'M' :
- begin
- ADTS.AddMonths(i);
- end;
- 'm' :
- begin
- ADTS.AddMinutes(i);
- end;
- {
- 'Z' :
- begin
- res := ADTS.TimeZone = i;
- j := ADTS.TimeZone;
- resStr := 'Time Zone';
- end;
- 'B' :
- begin
- res := ADTS.BeatOfDay = i;
- j := ADTS.BeatOfDay;
- resStr := 'Beat of day';
- end;
- }
- end;
- end;
- end;
- procedure TDateTimeStampBox.Test;
- var
- TestData : TStringList;
- sindex : Integer;
- s : String;
- begin
- DTS := TIdDateTimeStamp.Create((Nil));
- DTSIn := TIdDateTimeStamp.Create(Nil);
- DTSOut := TIDDateTimeStamp.Create(Nil);
- TestData := TStringList.Create;
- try
- TestData.LoadFromFile(GetDataDir + 'DateTimeStamp.dat');
- index := 0;
- sindex := 0;
- while sindex < TestData.Count - 1 do
- begin
- s := TestData[sindex];
- if Length(s) > 0 then
- begin
- if s[1] = ':' then
- begin
- if TestData.Count > sindex + 3 then
- begin
- strCmd := TestData[sindex + 1];
- strIn := TestData[sindex + 2];
- strOut := TestData[sindex + 3];
- if length(strCmd) > 0 then begin
- DTS.Zero;
- DTSIn.Zero;
- DTSOut.Zero;
- case strCmd[1] of
- 'N' :
- begin
- DoNoTest;
- end;
- 'A' :
- begin
- DoAdd;
- end;
- 'S' :
- begin
- DoSubtract;
- end;
- 'I' :
- begin
- DoConvertFromRFC822;
- end;
- 'i' :
- begin
- DoConvertToRFC822;
- end;
- 'V' :
- begin
- DoConvertFromISO8601;
- end;
- 'v' :
- begin
- DoConvertToISO8601;
- end;
- 'T' :
- begin
- DoConvertTTimeStamp;
- end;
- end;
- end;
- Inc(sindex, 3);
- Inc(index);
- end;
- end;
- end;
- Inc(sindex);
- end;
- finally
- DTS.Free;
- DTSIn.Free;
- DTSOut.Free;
- end;
- end;
- procedure TDateTimeStampBox.GetNextPart(var AStr: String; var AChar: Char;
- var ANum: Integer);
- var
- fnd : Integer;
- num : String;
- begin
- AChar := ' ';
- ANum := 0;
- if Length(AStr) = 0 then exit;
- // Remove first character.
- AChar := AStr[1];
- System.Delete(AStr, 1, 1);
- // Should be followed by some numbers.
- fnd := FindFirstNotOf('-+0123456789', AStr);
- if fnd = 0 then
- begin
- num := AStr;
- AStr := '';
- end else
- begin
- num := Copy(AStr, 1, fnd - 1);
- end;
- AStr := Trim(Copy(AStr, fnd, length(AStr)));
- // num should now contain the numbers.
- if Length(num) = 0 then
- begin
- // The number has no content.
- exit;
- end;
- // Just to be on the safe side...
- if FindFirstNotOf('-+0123456789', num) > 0 then
- begin
- // The 'number' is not numeric.
- exit;
- end;
- ANum := StrToInt(num);
- end;
- procedure TDateTimeStampBox.DoConvertTTimeStamp;
- var
- TS : TTimeStamp;
- DT : TDateTime;
- Date : Integer;
- Time : Integer;
- begin
- ReadBasicFormat(strIn, DTS);
- TS := DTS.AsTTimeStamp;
- Date := TS.Date;
- Time := TS.Time;
- Status('TTimeStamp Date Got: ' + IntToStr(Date));
- Status('TTimeStamp Time Got: ' + IntToStr(Time));
- DT := EncodeDate(DTS.Year, DTS.MonthOfYear, DTS.DayOfMonth);
- TS := DateTimeToTimeStamp(DT);
- Status('TTimeStamp Date Expected: ' + IntToStr(TS.Date));
- Status('TTimeStamp Time Expected: ' + IntToStr(TS.Time));
- Check(Time = TS.Time, 'Test ' + IntToStr(index) +
- ': TTimeStamp.Time expected: ' + IntToStr(TS.Time) +
- ', got: ' + IntToStr(Time));
- Check(Date = TS.Date, 'Test ' + IntToStr(index) +
- ': TTimeStamp.Date expected: ' + IntToStr(TS.Date) +
- ', got: ' + IntToStr(Date));
- end;
- procedure TDateTimeStampBox.ReadTTimeStamp(const AString: String;
- var ATS: TTimeStamp);
- var
- Date, Time : String;
- i : Integer;
- begin
- Date := Copy(AString, 2, Length(AString));
- i := Pos('.', Date);
- if i = 0 then
- begin
- Check(false, 'Test ' + IntToStr(index) + ': '
- + 'Conversion of output data to TTimeStamp, no . found');
- end;
- Time := Copy(Date, i + 1, Length(Date));
- Date := Copy(Date, 0, i - 1);
- ATS.Time := StrToInt(Time);
- ATS.Date := StrToInt(Date);
- end;
- initialization
- TIndyBox.RegisterBox(TDateTimeStampBox, 'DateTimeStampProc', 'Misc');
- end.
|