From 9e1462203c2622879ea63a447b59d3d3165c11f4 Mon Sep 17 00:00:00 2001 From: marco Date: Sun, 23 Sep 2007 20:03:12 +0000 Subject: [PATCH] * dateutils.scandatetime, an inverse of formatdatetime git-svn-id: trunk@8624 - --- rtl/objpas/dateutil.inc | 300 ++++++++++++++++++++++++++++++++++++++++ rtl/objpas/sysconst.pp | 6 + 2 files changed, 306 insertions(+) diff --git a/rtl/objpas/dateutil.inc b/rtl/objpas/dateutil.inc index aa097e771d..982a9bff74 100644 --- a/rtl/objpas/dateutil.inc +++ b/rtl/objpas/dateutil.inc @@ -407,6 +407,10 @@ Function DateTimeToMac(const AValue: TDateTime): Int64; Function MacToDateTime(const AValue: Int64): TDateTime; Function MacTimeStampToUnix(const AValue: Int64): Int64; +{ ScanDateTime is a limited inverse of formatdatetime } +function ScanDateTime(const Pattern:string;const s:string;const fmt:TFormatSettings;startpos:integer=1) : tdatetime; overload; +function ScanDateTime(const Pattern:string;const s:string;startpos:integer=1) : tdatetime; overload; + implementation uses sysconst; @@ -2069,5 +2073,301 @@ begin Result:=AValue - Epoch; end; +{ + Inverse of formatdatetime, destined for the dateutils unit of FPC. + + Limitations/implementation details: + - An inverse of FormatDateTime is not 100% an inverse, simply because one can put e.g. time tokens twice in the format string, + and scandatetime wouldn't know which time to pick. + - Strings like hn can't be reversed safely. E.g. 1:2 (2 minutes after 1) delivers 12 which is parsed as 12:00 and then + misses chars for the "n" part. + - trailing characters are ignored. + - no support for Eastern Asian formatting characters since they are windows only. + - no MBCS support. + + Extensions + - #9 eats whitespace. + - whitespace at the end of a pattern is optional. + - ? matches any char. + - Quote the above chars to really match the char. +} + +const whitespace = [' ',#13,#10]; + hrfactor = 1/(24); + minfactor = 1/(24*60); + secfactor = 1/(24*60*60); + mssecfactor = 1/(24*60*60*1000); + +const AMPMformatting : array[0..2] of string =('am/pm','a/p','ampm'); + +procedure raiseexception(const s:string); + +begin + raise EConvertError.Create(s); +end; + +function scandatetime(const pattern:string;const s:string;const fmt:TFormatSettings;startpos:integer=1) : tdatetime; + +var len ,ind : integer; + yy,mm,dd : integer; + timeval : TDateTime; + activequote: char; + +procedure intscandate(ptrn:pchar;plen:integer;poffs:integer); +// poffs is the offset to + +var + pind : integer; + +function findimatch(const mnts:array of string;p:pchar):integer; +var i : integer; +begin + result:=-1; + i:=0; + while (i<=high(mnts)) and (result=-1) do + begin + if AnsiStrLIComp(p,@mnts[i][1],length(mnts[i]))=0 then + result:=i; + inc(i); + end; +end; + +procedure arraymatcherror; + +begin + raiseexception(format(SNoArrayMatch,[pind+1,ind])) +end; + +function findmatch(const mnts : array of string;const s:string):integer; + +begin + result:=findimatch(mnts,@s[ind]); + if result=-1 then + arraymatcherror + else + begin + inc(ind,length(mnts[result])+1); + inc(pind,length(mnts[result])+1); + inc(result); // was 0 based. + end; +end; + +var + pivot, + i : integer; + +function scanfixedint(maxv:integer):integer; +var c : char; + oi:integer; +begin + result:=0; + oi:=ind; + c:=ptrn[pind]; + while (pind0) and (ind<=len) and (s[ind] IN ['0'..'9']) do + begin + result:=result*10+ord(s[ind])-48; + inc(ind); + dec(maxv); + end; + if oi=ind then + raiseexception(format(SPatternCharMismatch,[c,oi])); +end; + +procedure matchchar(c:char); + +begin + if (ind>len) or (s[ind]<>c) then + raiseexception(format(SNoCharMatch,[s[ind],c,pind+poffs+1,ind])); + inc(pind); + inc(ind); +end; + +function scanpatlen:integer; +var c : char; + lind : Integer; +begin + result:=pind; + lind:=pind; + c:=ptrn[lind]; + + while (lind<=plen) and (ptrn[lind]=c) do + inc(lind); + result:=lind-result; +end; + +procedure matchpattern(const lptr:string); + +var len:integer; +begin + len:=length(lptr); + if len>0 then + intscandate(@lptr[1],len,pind+poffs); +end; + +var lasttoken,lch : char; + +begin + pind:=0; lasttoken:=' '; + while (ind<=len) and (pind2 then + raiseexception(format(Shhmmerror,[poffs+pind+1])); + timeval:=timeval+scanfixedint(2)* minfactor; + end + else + case lch of + 'H': timeval:=timeval+scanfixedint(2)* hrfactor; + 'D': begin + i:=scanpatlen; + case i of + 1,2 : dd:=scanfixedint(2); + 3 : dd:=findmatch(fmt.shortDayNames,s); + 4 : dd:=findmatch(fmt.longDayNames,s); + 5 : matchpattern(fmt.shortdateformat); + 6 : matchpattern(fmt.longdateformat); + end; + end; + 'N': timeval:=timeval+scanfixedint(2)* minfactor; + 'S': timeval:=timeval+scanfixedint(2)* secfactor; + 'Z': timeval:=timeval+scanfixedint(3)* mssecfactor; + 'Y': begin + i:=scanpatlen; + yy:=scanfixedint(i); + if i<=2 then + begin + pivot:=YearOf(now)-fmt.TwoDigitYearCenturyWindow; + inc(yy, pivot div 100 * 100); + if (fmt.TwoDigitYearCenturyWindow > 0) and (yy < pivot) then + inc(yy, 100); + end; + end; + 'M': begin + i:=scanpatlen; + case i of + 1,2: mm:=scanfixedint(2); + 3: mm:=findmatch(fmt.ShortMonthNames,s); + 4: mm:=findmatch(fmt.LongMonthNames,s); + end; + end; + 'T' : begin + i:=scanpatlen; + case i of + 1: matchpattern(fmt.shortdateformat); + 2: matchpattern(fmt.longtimeformat); + end; + end; + 'A' : begin + i:=findimatch(AMPMformatting,@ptrn[pind]); + case i of + 0: begin + i:=findimatch(['AM','PM'],@s[ind]); + case i of + 0: ; + 1: timeval:=timeval+12*hrfactor; + else + arraymatcherror + end; + inc(pind,length(AMPMformatting[0])); + inc(ind,2); + end; + 1: begin + case upcase(s[ind]) of + 'A' : ; + 'P' : timeval:=timeval+12*hrfactor; + else + arraymatcherror + end; + inc(pind,length(AMPMformatting[1])); + inc(ind); + end; + 2: begin + i:=findimatch([fmt.timeamstring,fmt.timepmstring],@s[ind]); + case i of + 0: inc(ind,length(fmt.timeamstring)); + 1: begin + timeval:=timeval+12*hrfactor; + inc(ind,length(fmt.timepmstring)); + end; + else + arraymatcherror + end; + inc(pind,length(AMPMformatting[2])); + inc(pind,2); + inc(ind,2); + end; + else // no AM/PM match. Assume 'a' is simply a char + matchchar(ptrn[pind]); + end; + end; + '/' : matchchar(fmt.dateSeparator); + ':' : begin + matchchar(fmt.TimeSeparator); + lch:=lasttoken; + end; + #39,'"' : begin + activequote:=lch; + inc(pind); + end; + 'C' : begin + intscandate(@fmt.shortdateformat[1],length(fmt.ShortDateFormat),pind+poffs); + intscandate(@fmt.longtimeformat[1],length(fmt.longtimeformat),pind+poffs); + inc(pind); + end; + '?' : begin + inc(pind); + inc(ind); + end; + #9 : begin + while (ind<=len) and (s[ind] in whitespace) do + inc(ind); + inc(pind); + end; + else + matchchar(ptrn[pind]); + end; {case} + lasttoken:=lch; + end + else + begin + if activequote=lch then + begin + activequote:=#0; + inc(pind); + end + else + matchchar(ptrn[pind]); + end; + end; + if (pind0) and (ptrn[plen-1]<>#9) then // allow omission of trailing whitespace + RaiseException(format(SFullpattern,[poffs+pind+1])); +end; + +var plen:integer; + +begin + activequote:=#0; + yy:=0; mm:=0; dd:=0; + timeval:=0.0; + len:=length(s); ind:=startpos; + plen:=length(pattern); + intscandate(@pattern[1],plen,0); + result:=timeval; + if (yy>0) and (mm>0) and (dd>0) then + result:=result+encodedate(yy,mm,dd); +end; + + +function scandatetime(const pattern:string;const s:string;startpos:integer=1) : tdatetime; overload; + +begin + result:=scandatetime(pattern,s,defaultformatsettings); +end; end. diff --git a/rtl/objpas/sysconst.pp b/rtl/objpas/sysconst.pp index 00ad4bbd4d..c7559a3660 100644 --- a/rtl/objpas/sysconst.pp +++ b/rtl/objpas/sysconst.pp @@ -114,6 +114,12 @@ resourcestring SNoToolserver = 'Toolserver is not installed, cannot execute Tool'; + SNoArrayMatch = 'Can''t match any allowed value at pattern position %d, string position %d.'; + SNoCharMatch = 'Mismatch char "%s" <> "%s" at pattern position %d, string position %d.'; + SHHMMError = 'mm in a sequence hh:mm is interpreted as minutes. No longer versions allowed! (Position : %d).' ; + SFullpattern = 'Couldn''t match entire pattern string. Input too short at pattern position %d.'; + SPatternCharMismatch = 'Pattern mismatch char "%s" at position %d.'; + SShortMonthNameJan = 'Jan'; SShortMonthNameFeb = 'Feb'; SShortMonthNameMar = 'Mar';