Работа со строками - Pascal ABC - Ответ 13036573

var
  s,t:string;
  i,j,k,l:integer;
  a,b:array[1..125] of string;
  z:boolean;
begin
 // s:='Oh, jingle bells, jingle bells Jingle all the way; Oh,   what fun it is to ride In a   one horse open sleigh.';
 // writeln(s);
  write('s=');
  readln(s);
 
  //убираем знаки препинания
  for i:=length(s) downto 1 do 
    if s[i] in [':',';','.',',','-','?','!','"'] then delete(s,i,1);
  //оставляеи 1 пробел между словами
  i:=pos('  ',s);
  while i>0 do begin 
    delete(s,i,1);  
    i:=pos('  ',s);
  end;
  writeln('1.');
  writeln(s);
  // в массив
  j:=0;t:='';s:=s+' ';
  for i:=1 to length(s) do 
    if s[i]<>' '  then t:=t+s[i]
    else begin
      j:=j+1;
      a[j]:=t;
      t:='';
    end;
  writeln('2.');
  for i:=1 to j do writeln(i,' : ',a[i]);
  // каждое слово со строчных букв. Проверял на PascalAbc.Net 
  for i:=1 to j do a[i][1]:=UpperCase(a[i][1]);
  writeln('3.');
  for i:=1 to j do writeln(i,' : ',a[i]);
  // массив не повторяющихся слов
  b[1]:=a[1];l:=1;
  for i:=2 to j do begin
    z:=true;
    for k:=1 to l do
      if b[k]=a[i] then z:=false;
    if z then begin
      l:=l+1;
      b[l]:=a[i];
    end;
  end;  
  writeln('4.');
  for i:=1 to l do writeln(i,' : ',b[i]);
  //сортировка массива
    for i:=1 to l-1 do
      for j:=i+1 to l do
        if b[i]>b[j] then begin
          t:=b[i];b[i]:=b[j];b[j]:=t;
        end;
  writeln('5.');
  for i:=1 to l do writeln(i,' : ',b[i]);
        
end.