Mega Code Archive
Date String (any format) to TDateTime
<![CDATA[
Title: Date String (any format) to TDateTime
Question: When extracting data from text or other operating systems the format of date strings can vary dramatically. Borland function StrToDateTime() converts a string to a TDateTime value, but it is limited to the fact that the string parameter must be in the format of the current locales date/time format.
eg. "MM/DD/YY HH:MM:SS"
This is of little use when extracting dates such as ..
1) "Friday 18 October 2002 08:34am (45 secs)"
2) "20020431"
3) "12.Nov.03"
4) "14 Hour 31 Minute 25 Second 321 MSecs"
This function will evaluate a DateTime string in accordance to the DateTime specifier format string supplied. The following specifiers are supported ...
dd the day as a number with a leading zero or space (01-31).
ddd the day as an abbreviation (Sun-Sat)
dddd the day as a full name (Sunday-Saturday)
mm the month as a number with a leading zero or space (01-12).
mmm the month as an abbreviation (Jan-Dec)
mmmm the month as a full name (January-December)
yy the year as a two-digit number (00-99).
yyyy the year as a four-digit number (0000-9999).
hh the hour with a leading zero or space (00-23)
nn the minute with a leading zero or space (00-59).
ss the second with a leading zero or space (00-59).
zzz the millisecond with a leading zero (000-999).
ampm Specifies am or pm flag hours (0..12)
ap Specifies a or p flag hours (0..12)
NOTE : One assumption I have to make is that DAYS, MONTHS,
HOURS and MINUTES have a leading ZERO or
SPACE (ie. are 2 chars long) and MILLISECONDS are 3
chars long (ZERO or SPACE padded)
Using function
DateTimeStrEval(const DateTimeFormat : string;
const DateTimeStr : string) : TDateTime;
The above Examples (1..4) can be evaluated as ...
(Assume DT1 to DT3 equals example strings 1..4)
1) DateTimeStrEval('dddd dd mmmm yyyy hh:nnampm (ss xxxx)',DT1);
2) DateTimeStrEval('yyyymmdd',DT2);
3) DateTimeStrEval('dd-mmm-yy',DT3);
4) DateTimeStrEval('hh xxxx nn xxxxxx ss xxxxxx zzz xxxxx',DT4);
Answer:
uses SysUtils, DateUtils
// =============================================================================
// Evaluate a date time string into a TDateTime obeying the
// rules of the specified DateTimeFormat string
// eg. DateTimeStrEval('dd-MMM-yyyy hh:nn','23-May-2002 12:34)
//
// NOTE : One assumption I have to make that DAYS,MONTHS,HOURS and
// MINUTES have a leading ZERO or SPACE (ie. are 2 chars long)
// and MILLISECONDS are 3 chars long (ZERO or SPACE padded)
//
// Supports DateTimeFormat Specifiers
//
// dd the day as a number with a leading zero or space (01-31).
// ddd the day as an abbreviation (Sun-Sat)
// dddd the day as a full name (Sunday-Saturday)
// mm the month as a number with a leading zero or space (01-12).
// mmm the month as an abbreviation (Jan-Dec)
// mmmm the month as a full name (January-December)
// yy the year as a two-digit number (00-99).
// yyyy the year as a four-digit number (0000-9999).
// hh the hour with a leading zero or space (00-23)
// nn the minute with a leading zero or space (00-59).
// ss the second with a leading zero or space (00-59).
// zzz the millisecond with a leading zero (000-999).
// ampm Specifies am or pm flag hours (0..12)
// ap Specifies a or p flag hours (0..12)
//
//
// Delphi 6 Specific in DateUtils can be translated to ....
//
// YearOf()
//
// function YearOf(const AValue: TDateTime): Word;
// var LMonth, LDay : word;
// begin
// DecodeDate(AValue,Result,LMonth,LDay);
// end;
//
// TryEncodeDateTime()
//
// function TryEncodeDateTime(const AYear,AMonth,ADay,AHour,AMinute,ASecond,
// AMilliSecond : word;
// out AValue : TDateTime): Boolean;
// var LTime : TDateTime;
// begin
// Result := TryEncodeDate(AYear, AMonth, ADay, AValue);
// if Result then begin
// Result := TryEncodeTime(AHour, AMinute, ASecond, AMilliSecond, LTime);
// if Result then
// AValue := AValue + LTime;
// end;
// end;
//
// =============================================================================
function DateTimeStrEval(const DateTimeFormat : string;
const DateTimeStr : string) : TDateTime;
var i,ii,iii : integer;
Retvar : TDateTime;
Tmp,
Fmt,Data,Mask,Spec : string;
Year,Month,Day,Hour,
Minute,Second,MSec : word;
AmPm : integer;
begin
Year := 1;
Month := 1;
Day := 1;
Hour := 0;
Minute := 0;
Second := 0;
MSec := 0;
Fmt := UpperCase(DateTimeFormat);
Data := UpperCase(DateTimeStr);
i := 1;
Mask := '';
AmPm := 0;
while i if Fmt[i] in ['A','P','D','M','Y','H','N','S','Z'] then begin
// Start of a date specifier
Mask := Fmt[i];
ii := i + 1;
// Keep going till not valid specifier
while true do begin
if ii length(Fmt) then Break; // End of specifier string
Spec := Mask + Fmt[ii];
if (Spec = 'DD') or (Spec = 'DDD') or (Spec = 'DDDD') or
(Spec = 'MM') or (Spec = 'MMM') or (Spec = 'MMMM') or
(Spec = 'YY') or (Spec = 'YYY') or (Spec = 'YYYY') or
(Spec = 'HH') or (Spec = 'NN') or (Spec = 'SS') or
(Spec = 'ZZ') or (Spec = 'ZZZ') or
(Spec = 'AP') or (Spec = 'AM') or (Spec = 'AMP') or
(Spec = 'AMPM') then begin
Mask := Spec;
inc(ii);
end
else begin
// End of or Invalid specifier
Break;
end;
end;
// Got a valid specifier ? - evaluate it from data string
if (Mask '') and (length(Data) 0) then begin
// Day 1..31
if (Mask = 'DD') then begin
Day := StrToIntDef(trim(copy(Data,1,2)),0);
delete(Data,1,2);
end;
// Day Sun..Sat (Just remove from data string)
if Mask = 'DDD' then delete(Data,1,3);
// Day Sunday..Saturday (Just remove from data string LEN)
if Mask = 'DDDD' then begin
Tmp := copy(Data,1,3);
for iii := 1 to 7 do begin
if Tmp = Uppercase(copy(LongDayNames[iii],1,3)) then begin
delete(Data,1,length(LongDayNames[iii]));
Break;
end;
end;
end;
// Month 1..12
if (Mask = 'MM') then begin
Month := StrToIntDef(trim(copy(Data,1,2)),0);
delete(Data,1,2);
end;
// Month Jan..Dec
if Mask = 'MMM' then begin
Tmp := copy(Data,1,3);
for iii := 1 to 12 do begin
if Tmp = Uppercase(copy(LongMonthNames[iii],1,3)) then begin
Month := iii;
delete(Data,1,3);
Break;
end;
end;
end;
// Month January..December
if Mask = 'MMMM' then begin
Tmp := copy(Data,1,3);
for iii := 1 to 12 do begin
if Tmp = Uppercase(copy(LongMonthNames[iii],1,3)) then begin
Month := iii;
delete(Data,1,length(LongMonthNames[iii]));
Break;
end;
end;
end;
// Year 2 Digit
if Mask = 'YY' then begin
Year := StrToIntDef(copy(Data,1,2),0);
delete(Data,1,2);
if Year Year := (YearOf(Date) div 100) * 100 + Year
else
Year := (YearOf(Date) div 100 - 1) * 100 + Year;
end;
// Year 4 Digit
if Mask = 'YYYY' then begin
Year := StrToIntDef(copy(Data,1,4),0);
delete(Data,1,4);
end;
// Hours
if Mask = 'HH' then begin
Hour := StrToIntDef(trim(copy(Data,1,2)),0);
delete(Data,1,2);
end;
// Minutes
if Mask = 'NN' then begin
Minute := StrToIntDef(trim(copy(Data,1,2)),0);
delete(Data,1,2);
end;
// Seconds
if Mask = 'SS' then begin
Second := StrToIntDef(trim(copy(Data,1,2)),0);
delete(Data,1,2);
end;
// Milliseconds
if (Mask = 'ZZ') or (Mask = 'ZZZ') then begin
MSec := StrToIntDef(trim(copy(Data,1,3)),0);
delete(Data,1,3);
end;
// AmPm A or P flag
if (Mask = 'AP') then begin
if Data[1] = 'A' then
AmPm := -1
else
AmPm := 1;
delete(Data,1,1);
end;
// AmPm AM or PM flag
if (Mask = 'AM') or (Mask = 'AMP') or (Mask = 'AMPM') then begin
if copy(Data,1,2) = 'AM' then
AmPm := -1
else
AmPm := 1;
delete(Data,1,2);
end;
Mask := '';
i := ii;
end;
end
else begin
// Remove delimiter from data string
if length(Data) 1 then delete(Data,1,1);
inc(i);
end;
end;
if AmPm = 1 then Hour := Hour + 12;
if not TryEncodeDateTime(Year,Month,Day,Hour,Minute,Second,MSec,Retvar) then
Retvar := 0.0;
Result := Retvar;
end;
]]>