diff --git a/wst/trunk/date_utils.pas b/wst/trunk/date_utils.pas index 7e62b5974..6197e1797 100644 --- a/wst/trunk/date_utils.pas +++ b/wst/trunk/date_utils.pas @@ -24,6 +24,9 @@ type MinuteOffset : Shortint; end; +const + ZERO_DATE : TDateTimeRec = ( Date : 0; HourOffset : 0; MinuteOffset : 0; ); + function xsd_TryStrToDate(const AStr : string; out ADate : TDateTimeRec) : Boolean; function xsd_StrToDate(const AStr : string) : TDateTimeRec; @@ -33,6 +36,9 @@ type function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;{$IFDEF USE_INLINE}inline;{$ENDIF} function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;{$IFDEF USE_INLINE}inline;{$ENDIF} + function NormalizeToUTC(const ADate : TDateTimeRec) : TDateTime; + function DateEquals(const AA,AB: TDateTimeRec) : Boolean; + resourcestring SERR_InvalidDate = '"%s" is not a valid date.'; @@ -50,6 +56,29 @@ begin Result := DateOf(AValue) + DateUtils.IncMinute(TimeOf(AValue),ANumberOfMinutes); end; +function NormalizeToUTC(const ADate : TDateTimeRec) : TDateTime; +begin + Result := ADate.Date; + if ( ADate.HourOffset <> 0 ) then + Result := IncHour(Result,-ADate.HourOffset); + if ( ADate.MinuteOffset <> 0 ) then + Result := IncMinute(Result,-ADate.MinuteOffset); +end; + +function DateEquals(const AA,AB: TDateTimeRec) : Boolean; +var + e, a : TDateTime; + e_y, e_m, e_d, e_h, e_mn, e_ss, e_ms : Word; + a_y, a_m, a_d, a_h, a_mn, a_ss, a_ms : Word; +begin + e := NormalizeToUTC(AA); + a := NormalizeToUTC(AB); + DecodeDateTime(e, e_y, e_m, e_d, e_h, e_mn, e_ss, e_ms); + DecodeDateTime(a, a_y, a_m, a_d, a_h, a_mn, a_ss, a_ms); + Result := ( e_y = a_y ) and ( e_m = a_m ) and ( e_d = a_d ) and + (e_h = a_h ) and ( e_mn = a_mn ) and ( e_ss = a_ss ) and ( e_ms = a_ms ); +end; + function xsd_TryStrToDate(const AStr : string; out ADate : TDateTimeRec) : Boolean; const DATE_SEP_CHAR = '-'; TIME_MARKER_CHAR = 'T'; TIME_SEP_CHAR = ':'; @@ -79,10 +108,37 @@ var if Result then Result := TryStrToInt(Copy(buffer,locStartPos,(bufferPos-locStartPos)),AValue); end; - + + function ReadMiliSeconds(out AValue : Integer; const ASeparatorAtEnd : Char) : Boolean; + var + locDigitCount, locRes, itemp, locErcode : Integer; + begin + while ( bufferPos <= bufferLen ) and ( buffer[bufferPos] < #33 ) do begin + Inc(bufferPos); + end; + locRes := 0; + locDigitCount := 0; + while ( locDigitCount < 3 ) and ( bufferPos <= bufferLen ) and ( buffer[bufferPos] in ['0'..'9'] ) do begin + Val(buffer[bufferPos],itemp,locErcode); + locRes := ( locRes * 10 ) + itemp; + Inc(bufferPos); + Inc(locDigitCount); + end; + Result := ( locDigitCount > 0 ); + if Result then begin + if ( locDigitCount < 3 ) and ( locRes > 0 ) then begin + while ( locDigitCount < 3 ) do begin + locRes := locRes * 10; + Inc(locDigitCount); + end; + end; + AValue := locRes; + end; + end; + var d, m, y : Integer; - hh, mn, ss : Integer; + hh, mn, ss, ssss : Integer; tz_hh, tz_mn : Integer; tz_negative : Boolean; ok : Boolean; @@ -108,6 +164,7 @@ begin hh := 0; mn := 0; ss := 0; + ssss := 0; ok := True; end else begin ok := ( buffer[bufferPos -1] = TIME_MARKER_CHAR ) and ReadInt(hh,TIME_SEP_CHAR); @@ -117,6 +174,12 @@ begin if ok then begin Inc(bufferPos); ok := ReadInt(ss,#0); + if ok and ( bufferPos < bufferLen ) and ( buffer[bufferPos] = '.' ) then begin + Inc(bufferPos); + ok := ReadMiliSeconds(ssss,#0); + end else begin + ssss := 0; + end; if ok and ( bufferPos < bufferLen ) then begin tz_negative := ( buffer[bufferPos] = '-' ); Inc(bufferPos); @@ -134,10 +197,10 @@ begin end; end; if ok then begin - if ( ( y + m + d + hh + mn + ss ) = 0 ) then + if ( ( y + m + d + hh + mn + ss + ssss ) = 0 ) then ADate.Date := 0 else - ADate.Date := EncodeDate(y,m,d) + EncodeTime(hh,mn,ss,0); + ADate.Date := EncodeDate(y,m,d) + EncodeTime(hh,mn,ss,ssss); ADate.HourOffset := tz_hh; ADate.MinuteOffset := tz_mn; Result := True; @@ -200,6 +263,15 @@ begin buffer := '0' + buffer; s := Format('%s:%s',[s,buffer]); + if ( ssss > 0 ) then begin + buffer := IntToStr(ssss); + case ssss of + 0..9 : buffer := '00' + buffer; + 10..99 : buffer := '0' + buffer; + end; + s := Format('%s.%s',[s,buffer]); + end; + Result := s + 'Z'; end; diff --git a/wst/trunk/tests/test_suite/test_date_utils.pas b/wst/trunk/tests/test_suite/test_date_utils.pas index 75364b73a..10863c7a9 100644 --- a/wst/trunk/tests/test_suite/test_date_utils.pas +++ b/wst/trunk/tests/test_suite/test_date_utils.pas @@ -28,6 +28,7 @@ type published procedure xsd_TryStrToDate_date_only(); procedure xsd_TryStrToDate_date_time(); + procedure xsd_TryStrToDate_date_time_fractional_second(); procedure xsd_TryStrToDate_date_bad_separator(); procedure xsd_TryStrToDate_date_time_bad_separator(); procedure xsd_TryStrToDate_date_time_timezone_z(); @@ -37,6 +38,8 @@ type procedure xsd_DateTimeToStr_1(); procedure xsd_DateTimeToStr_2(); + procedure xsd_DateTimeToStr_fractional_second_1(); + procedure xsd_DateTimeToStr_fractional_second_2(); procedure xsd_DateTimeToStr_timezone_1(); end; @@ -75,6 +78,48 @@ begin CheckEquals(sDATE_2, xsd_DateTimeToStr(d)); end; +procedure TTest_DateUtils.xsd_DateTimeToStr_fractional_second_1(); +const + sDATE_1 = '1976-10-12T23:34:56.007Z'; + sDATE_2 = '1976-10-12T23:34:56.078Z'; + sDATE_3 = '1976-10-12T23:34:56.789Z'; +var + d : TDateTimeRec; +begin + FillChar(d,SizeOf(d),#0); + d.Date := EncodeDate(1976,10,12) + EncodeTime(23,34,56,7); + CheckEquals(sDATE_1, xsd_DateTimeToStr(d)); + + FillChar(d,SizeOf(d),#0); + d.Date := EncodeDate(1976,10,12) + EncodeTime(23,34,56,78); + CheckEquals(sDATE_2, xsd_DateTimeToStr(d)); + + FillChar(d,SizeOf(d),#0); + d.Date := EncodeDate(1976,10,12) + EncodeTime(23,34,56,789); + CheckEquals(sDATE_3, xsd_DateTimeToStr(d)); +end; + +procedure TTest_DateUtils.xsd_DateTimeToStr_fractional_second_2(); +const + sDATE_1 = '1976-10-12T23:34:56.007Z'; + sDATE_2 = '1976-10-12T23:34:56.078Z'; + sDATE_3 = '1976-10-12T23:34:56.789Z'; +var + d : TDateTime; +begin + FillChar(d,SizeOf(d),#0); + d := EncodeDate(1976,10,12) + EncodeTime(23,34,56,7); + CheckEquals(sDATE_1, xsd_DateTimeToStr(d)); + + FillChar(d,SizeOf(d),#0); + d := EncodeDate(1976,10,12) + EncodeTime(23,34,56,78); + CheckEquals(sDATE_2, xsd_DateTimeToStr(d)); + + FillChar(d,SizeOf(d),#0); + d := EncodeDate(1976,10,12) + EncodeTime(23,34,56,789); + CheckEquals(sDATE_3, xsd_DateTimeToStr(d)); +end; + procedure TTest_DateUtils.xsd_DateTimeToStr_timezone_1(); //2002-10-10T12:00:00+05:00 is 2002-10-10T07:00:00Z var @@ -149,6 +194,42 @@ begin CheckEquals(False,xsd_TryStrToDate(DATE_STR,d),Format('"%s" is not a valid date.',[DATE_STR])); end; +procedure TTest_DateUtils.xsd_TryStrToDate_date_time_fractional_second(); + + procedure do_check( + const AString : string; + const AY, AM, ADY : Word; + const AHH, AMN, ASS, ASSSS : Word + ); + var + d : TDateTimeRec; + y,m,dy : Word; + hh,mn,ss, ssss : Word; + begin + d := xsd_StrToDate(AString); + DecodeDate(d.Date,y,m,dy); + CheckEquals(AY,y,'Year'); + CheckEquals(AM,m,'Month'); + CheckEquals(ADY,dy,'Day'); + DecodeTime(d.Date,hh,mn,ss,ssss); + CheckEquals(AHH,hh,'Hour'); + CheckEquals(AMN,mn,'Minute'); + CheckEquals(ASS,ss,'Second'); + CheckEquals(ASSSS,ssss,'MiliSecond'); + CheckEquals(0,d.HourOffset,'HourOffset'); + CheckEquals(0,d.MinuteOffset,'MinuteOffset'); + end; + +begin + //'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)? + do_check('1976-10-12T23:34:56.7', 1976,10,12, 23,34,56,700); + do_check('1976-10-12T23:34:56.07', 1976,10,12, 23,34,56,70); + do_check('1976-10-12T23:34:56.007', 1976,10,12, 23,34,56,7); + do_check('1976-10-12T23:34:56.789', 1976,10,12, 23,34,56,789); + do_check('1976-10-12T23:34:56.78', 1976,10,12, 23,34,56,780); + do_check('1976-10-12T23:34:56.078', 1976,10,12, 23,34,56,78); +end; + procedure TTest_DateUtils.xsd_TryStrToDate_date_time_timezone_1(); var s : string;