Строки

uses crt;
const rz=[' ','.',',',';',':','?','!'];
var s,s1,sk,sd:string;
    d,k:array[1..50] of string;
    len,i,min,max,nd,nk,p:byte;
begin
clrscr;
writeln('Введите строку из слов, отделеннvх разделителями:');
readln(s);
{обработаем строку, приведем к виду слово,слово,слово,}
for i:=1 to length(s) do{заменим разделители на запятые}
if s[i] in rz then s[i]:=',';
s:=s+',';{добавим к ней запятую}
while pos(',,',s)>0 do{удалим лишние запятые}
delete(s,pos(',,',s),1);
if s[1]=','then delete(s,1,1);{если первая запятая, удаляем}
{определим макс и мин длину}
min:=255;{длина короткого слова}
max:=0;{длина длинного слова}
s1:=s;
while pos(',',s1)>0 do{пока есть запятые}
 begin
  len:=pos(',',s1)-1;{длина очередного слова}
  if len<min then{если меньше предыдущих}
  min:=len; {его длина}
  if len>max then{если больше предыдущих}
  max:=len; {его длина}
  delete(s1,1,pos(',',s1));{удаляем проверенное слово, следующее первое}
 end;
writeln('Длина самого короткого словоа=',min);
writeln('Длина самого длинного словоа =',max);
nk:=0;
nd:=0;
while pos(',',s)>0 do{пока есть запятые}
 begin
  len:=pos(',',s)-1;{длина очередного слова}
  if len=min then{если короткое}
   begin
    nk:=nk+1;
    k[nk]:=copy(s,1,pos(',',s)-1)
   end;
  if len=max then{если длинное}
   begin
    nd:=nd+1;
    d[nd]:=copy(s,1,pos(',',s)-1)
   end;
  delete(s,1,pos(',',s));{удаляем проверенное слово, следующее первое}
 end;
writeln('Группа длинных слов:');
for i:=1 to nd do
writeln(d[i]);
writeln('Начинаются и оканчиваются на одну букву:');
p:=0;
for i:=1 to nd do
if d[i][1]=d[i][length(d[i])]then
 begin
  p:=1;
  writeln(d[i]);
 end;
if p=0 then writeln('Таких слов нет');
writeln('Группа коротких слов:');
for i:=1 to nk do
writeln(k[i]);
writeln('Начинаются и оканчиваются на одну букву:');
p:=0;
for i:=1 to nk do
if k[i][1]=k[i][length(k[i])]then
 begin
  p:=1;
  writeln(k[i]);
 end;
if p=0 then writeln('Таких слов нет');
readln
end.