Function StringToDate(Temp:String):TDateTime;
{©Drkb v.3(2007): www.drkb.ru,
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 temp:string):string;
begin
//возвращаем следующее слово из строки и вырезаем это слово из исходной строки
if pos(' ', temp)>0 then
begin //берём слово до пробела
result:=trim(copy(temp, 1, pos(' ', temp)));
temp:=copy(temp, pos(' ', temp)+1, length(temp));
end
else //это последнее слово в строке
begin
result:=trim(temp);
temp:='';
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: if month='' then //только если месяц ещё не определён, уменьшает вероятность ошибочного результата
for i:=12 downto 1 do // обязателен отсчёт в обратную сторону чтоб не путать май и март
if (pos(eng_monthes[i],temp1)=1) or (pos(rus_monthes[i],temp1)=1) then //сюда добавляем ещё язык если надо
month:=inttostr(i);
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;
|