Как преобразовать строку в дату?

=== Как преобразовать строку в дату? ===
Код распознаёт и русский и английский языки. Кстати вполне корректно обрабатывает и падежи типа: 
2 мая 2002
май месяц 1999 года, 3е число
3е мая 1999 года
Солнечный апрельский день в 1998м году, 20е число
Корректно распознаёт что-нибудь типа
July 3, 99
но естественно не способен распознать
01-jan-03
т.е. год если двузначный, то должен быть больше 31. Иначе необоходим дополнительный параметер, указывающий годом считать первую или вторую найденную цифру в строке 
function StringToDate(Temp: string): TDateTime;
{©Drkb v.3(2007): www.drkb.ru, 
 ®Vit (Vitaly Nevzorov) - nevzorov@yahoo.com}
type
 TDateItem = (diYear, diMonth, diDay, diUnknown);
 TCharId=(ciAlpha, ciNumber, ciSpace);
// языковые настройки. Для включения нового языка добавляем раскладку сюда, дополняем тип alpha и меняем 
// единственную строку где используется эта константа
const
 eng_monthes: array[1..12] of string=('jan', 'feb', 'mar', 'apr', 'may', 'jun', 'jul', 'aug', 'sep', 'oct', 'nov', 'dec');
 rus_monthes: array[1..12] of string=('янв', 'фев', 'мар', 'апр', 'ма', 'июн', 'июл', 'авг', 'сен', 'окт', 'ноя', 'дес');
 alpha: set of char=['a'..'z','а'..'я'];
// временные переменные
var
 month, day, year: string;
 temp1: string;
 i, j: integer;
 ci1, ci2: TCharId;
 function GetWord(var ATemp: string): string;
 begin
 // возвращаем следующее слово из строки и вырезаем это слово из исходной строки
 if Pos(' ', ATemp) > 0 then
 begin // берём слово до пробела
 Result := Trim(Copy(ATemp, 1, Pos(' ', ATemp)));
 ATemp := Copy(ATemp, Pos(' ', ATemp)+1, Length(ATemp));
 end
 else // это последнее слово в строке
 begin
 Result := Trim(ATemp);
 ATemp:=;
 end;
 end;
 function GetDateItemType(temp: string): TDateItem;
 var i, j: Integer;
 begin
 // распознаём тип слова
 i := StrToIntDef(temp, 0); // попытка преобразовать слово в цифру
 case i of
 0: Result := diMonth; // не число, значит или месяц или мусор
 1..31: Result := diDay; // числа от 1 до 31 считаем днём
 else
 Result := diYear; // любые другие числа считаем годами
 end;
 end;
 function GetCharId(ch: Char): TCharId;
 begin
 // узнаём тип символа, нужно для распознавания "склееных" дней или лет с месяцем 
 case ch of
 ' ': Result := ciSpace;
 '0'..'9': Result := ciNumber;
 else
 Result := ciAlpha;
 end;
 end;
begin
 temp := Trim(AnsiLowerCase(temp));
 month := ;
 day := ;
 year := ;
 // замена любого мусора на пробелы
 for i := 1 to Length(temp) do
 if not (temp[i] in alpha + ['0'..'9']) then temp[i] := ' ';
 // удаление лишних пробелов
 while Pos(' ', temp) > 0 do
 Temp := StringReplace(temp, ' ', ' ', [rfReplaceAll]);
 // вставка пробелов если месяц слеплен с днём или годом
 ci1 := GetCharId(temp[1]);
 i := 1;
 repeat
 Inc(i);
 ci2 := GetCharId(temp[i]);
 if ((ci1 = ciAlpha) and (ci2 = ciNumber)) or ((ci1 = ciNumber) and (ci2 = ciAlpha)) then
 Insert(' ', temp, i);
 ci1 := ci2;
 until i >= Length(temp);
 // собственно парсинг
 while temp > do
 begin
 temp1 := GetWord(temp);
 case GetDateItemType(temp1) of
 diMonth:
 begin
 if month = then
 begin
 // только если месяц ещё не определён, уменьшает вероятность ошибочного результата
 for i := 12 downto 1 do // обязателен отсчёт в обратную сторону чтоб не путать май и март
 begin 
 if (Pos(eng_monthes[i], temp1) = 1) 
 or (Pos(rus_monthes[i], temp1) = 1) then // сюда добавляем ещё язык если надо
 month := IntToStr(i);
 end;
 end;
 end;
 diDay: Day := temp1;
 diYear: Year := temp1;
 end;
 end;
 // проверка - все ли элементы определены
 if (month = ) or (Day = ) or (Year = ) then
 raise Exception.Create('Could not be converted!');
 // поправка на двузначный год
 if Length(year) < 3 then year := '19' + year;
 // кодирование результата
 Result := EncodeDate(Strtoint(Year), Strtoint(month), Strtoint(Day));
end;
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
ID: 00182
----
Функция StrToDate преобразует только числа, поэтому, если у Вас месяцы в виде имён, то придётся использовать VarToDateTime.
var
 D1, D2, D3 : TDateTime;
begin
 D1 := VarToDateTime('December 6, 1969');
 D2 := VarToDateTime('6-Apr-1998');
 D3 := VarToDateTime('1998-Apr-6');
 ShowMessage(DateToStr(D1)+' '+DateToStr(D2)+' '+
 DateToStr(D3));
end;
Source: Взято из http://forum.sources.ru
ID: 00183
----
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 locale's date/time format. eg. "MM/DD/YY HH:MM:SS" 
Answer:
This is of little use when extracting dates such as .. 
1) "Friday 18 October 2002 08:34am (45 secs)" or "Wednesday 15 May 2002 06:12 (22 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) 
 (Any other character corresponds to a literal or delimiter.)
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 DT4 equals example strings 1..4) 
MyDate := DateTimeStrEval('dddd dd mmmm yyyy hh:nnampm (ss xxxx)', DT1);
MyDate := DateTimeStrEval('yyyymmdd', DT2);
MyDate := DateTimeStrEval('dd-mmm-yy', DT3);
MyDate := DateTimeStrEval('hh xxxx nn xxxxxx ss xxxxxx zzz xxxxx', DT4);
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)
 //
 // 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;
 //
 // (TryEncodeDate() and TryEncodeTime() is the same as EncodeDate() and
 // EncodeTime() with error checking and boolean return value)
 //
 // =============================================================================
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 < length(Fmt) do
 begin
 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 < TwoDigitYearCenturyWindow then
 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;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 00184