Помочь знакомой в pascal

[andreyss]

Помочь знакомой в pascal

Подсчитать, сколько слов в тексте «Ехал казак на побывку» начинается и заканчивается на одну и ту же букву. Если такие слова в тексте имеются, то расположить слова из исходной фразы в порядке уменьшения длины слов.

 

[andreyss]

Программа стороковые переменные

 

[Vladimir_S]

Пожалуйста:

Const
 Smb=[' ',',',':','?','.','!','-',';','(',')'];
Type
 W=Array[1..100] of string;

Var
 st,dw:string;
 i,j,N,N1:integer;
 wrd,wrd1:W;

Procedure GetWords(s: string; var words:W; var Nw:integer);
var
 i,back: integer;
begin
 i := 1;
 Nw := 0;
 while i<=length(s) do
  begin
   while (i<=length(s)) and (s[i] in Smb) do inc(i);
   if i<=length(s) then
    begin
     back:=i;
     while (i<=length(s)) and Not(s[i] in Smb) do inc(i);
    end;
   inc(Nw);
   words[Nw]:=copy(s, back, i-back);
  end;
end;

BEGIN
 Writeln('Enter the string:');
 Readln(st);
 Writeln;

 GetWords(st, wrd, N);

 N1:=0;
 For i:=1 to N do
  If wrd[i][1]=wrd[i][length(wrd[i])] then
   begin
    Inc(N1);
    wrd1[N1]:=wrd[i];
   end;

 Writeln(N1,' words beginning and ending with similar letters:');

 For i:=1 to N1 do
  For j:=1 to N1-i do
   If length(wrd1[j])<length(wrd1[j+1]) then
    begin
     dw:=wrd1[j];
     wrd1[j]:=wrd1[j+1];
     wrd1[j+1]:=dw;
    end;

 For i:=1 to N1 do write(wrd1[i]+' ');

 readln;
END.