Перевести дату, заданную в свободном формате, в формат "day month yyyy"

var k,dd,mm:byte;i,yyyy:integer;s:string;
begin
readln(s);{ввод}
k:=0;
for i:=1 to length(s) do {для каждого символа}
if (strtoint(s[i]) >=47) (strtoint(s[i])<=58) then begin {если число}
inc(k);
case k of
1,2:dd:=dd*10+strtoint(s[i]); {приписать к дням}
3,4:mm:=mm+strtoint(s[i]); {месяцу}
5..8:yy:=strtoint(s[i]); {году}
9:break; { лишние числа пропускаем}
end;
end;
case month of
1,3,5,7,8,10,12: if dd >31 then writeln('Не верно указан день')
4,6,9,11:if dd>30 then 
2:if dd>29 then {не чувствителен к високосному}
13..maxint:writeln('Не верно указан месяц')
end;
end.

uses System;
 
// Функция для получения числового значения дня месяца в прописном виде
function inWords(Day : Integer) : String;
const
  D : array of String[9] = ('', 'десять ', 'двадцать ', 'тридцать ');
  E : array of String[8] = ('', 'первое', 'второе', 'третье', 'четвёртое',
      'пятое', 'шестое', 'седьмое', 'восьмое', 'девятое');
  Z : array of String[12] = ('десятое', 'одиннадцатое', 'двенадцатое',
        'тринадцатое', 'четырнадцатое', 'пятнадцатое', 'шестнадцатое',
        'семнадцатое', 'восемнадцатое', 'девятнадцатое');
begin
  if (Day > 9) and (Day < 20) then
    Result := Z[Day mod 10]
  else
    Result := D[Day div 10] + E[Day mod 10];
end;
 
begin
  WriteLn('Дату можно ввести одним из следующих способов:');
  WriteLn('1.1.1990, 1/1/1990, 1.01.1990, 01-01-1990, 01 01 1990');
  WriteLn;
  var S : String;
  
  try // Не знаем когда возникнет ошибка
    // Вводим дату в виде строки
    S := ReadLnString('Введите дату:');
    
    // Парсим строку (разбиваем на составляющие «День», «Месяц» и «Год»)
    var d := ('./- ').ToCharArray;
    var A : array of String := S.ToWords(d);
    var Day   := StrToInt(A[0]);
    var Month := StrToInt(A[1]);
    var Year  := StrToInt(A[2]);
    
    // Получим дату в виде '1 января 1990'
    var dt := New DateTime(A[2].ToInteger, A[1].ToInteger, A[0].ToInteger);
    S := String.Format('{0:d MMMM yyyy}', dt);
    
    // В полученной строке нужно число «День» заменить на пропись
    S := inWords(Day) + S.Remove(0, Day.ToString.Length);
  
  except // Любая ошибка приведёт сюда
    S := 'Ошибка ввода даты.';
  end;
  
  WriteLn(S);
end.

var d,m,y:string;
    d1,m1,y1 : integer;
    i, index, err :integer;
    date :string;
    arr: array [1..4] of string;
 
  function day(d : integer): string;
  var s1 : string;
 
  
  begin
    case d of
      1: s1:='первое';
      2: s1:='второе';
      3: s1:='третье';
      4: s1:='четвертое';
      5: s1:='пятое';
      6: s1:='шестое';
      7: s1:='седьмое';
      8: s1:='восьмое';
      9: s1:='девятое';
      10: s1:='десятое';
      11: s1:='одиннадцатое';
      12: s1:='двенадцатое';
      13: s1:='тринадцатое';
      14: s1:='четырнадцатое';
      15: s1:='пятнадцатое';
      16: s1:='шестнадцатое';
      17: s1:='семнадцатое';
      18: s1:='восемнадцатое';
      19: s1:='девятнадцатое';
      20: s1:='двадцатое';
      21: s1:='двадцать первое';
      22: s1:='двадцать второе';
      23: s1:='двадцать третье';
      24: s1:='двадцать четвертое';
      25: s1:='двадцать пятое';
      26: s1:='двадцать шестое';
      27: s1:='двадцать седьмое';
      28: s1:='двадцать восьмое';
      29: s1:='двадцать девятое';
      30: s1:='тридцатое';
      31: s1:='тридцать первое';
      end;
      day := s1;
  end;
    function month(m : integer): string;
  var s2 : string;
 begin
    case m of
      1: s2:='января';
      2: s2:='февраля';
      3: s2:='марта';
      4: s2:='апреля';
      5: s2:='мая';
      6: s2:='июня';
      7: s2:='июля';
      8: s2:='августа';
      9: s2:='сентября';
      10: s2:='октября';
      11: s2:='ноября';
      12: s2:='декабря';
      end;
      month:=s2;
end;      
 
 
begin
  arr[1] := '.';
  arr[2] := ' ';
  arr[3] := '/';
  arr[4] := '-';
 
  writeln('введите дату');
  readln(date);
  
  for i:=1 to 4 do
    if(pos(arr[i], date) >= 1) then
      index := i;
      if index = 0 then begin
      writeln('это не дата...');
      exit;
      end
      else
  d := copy(date,1,pos(arr[index], date)-1);
  delete(date,1,pos(arr[index], date));
  m := copy(date,1,pos(arr[index], date)-1);
  delete(date,1,pos(arr[index], date));
  y := date;
 
  val(d, d1,err);
  val(m, m1,err);
  val(y, y1,err);
  
  if(y1 < 1950) or (y1 > 2099) then
  begin
  writeln('введите другую дату'); //год 
  exit;
  end
  else
  if(m1 < 1) or (m1 > 12) then
  begin
  writeln('uncorrect month');
  exit;
  end
  else
  if (y1 mod 4 = 0) and (y1 mod 100 <> 0) or (y1 mod 400 = 0) then
  begin
case m1 of
  1,3,5,7,8,10,12: if d1 > 31 then exit;
 
  4,6,9,11: if d1 > 30 then exit;
  
  2: if d1 > 29 then exit;
  end; 
  end
 
else
  case m1 of
  1,3,5,7,8,10,12: if d1 > 31 then exit;
 
  4,6,9,11: if d1 > 30 then exit;
  
  2: if d1 > 28 then exit;
  end;
  
  date := day(d1)+ ' ' + month(m1) + ' ' + y1;
 
writeln(date);
 
end.