uses crt;
function Slovo(s:string;n:integer):string;
const lim =[' ',',','!'];
var ss:string;
k,c,i:integer;
begin
ss:=''; c:=1; k:=1;
while k<=length(s) do begin
while not(s[k] in lim) and (k<=length(s)) do begin
if c=n then ss:=ss+s[k];
inc (k); end;
inc ( c );
while (s[k] in lim) and (k<=length(s)) do inc (k);
end;
Slovo:=ss;
end;
const n=128;
var
a : array[1..n] of string;
i, n1, j : integer;
s1, s2 : string;
found : boolean;
begin
clrscr;
writeln (' vvedite stroky');
readln (s1);
s2 := '';
for j := 1 to n do a[j] := '';
n1 := 1;
i := 0;
while slovo(s1, n1) <> '' do
begin
found := false;
for j := 1 to i do
if a[j] = slovo (s1, n1) then found := true;
if found then s2 := s2 + slovo (s1, n1) + ' '
else
begin
inc (i);
a[i] := slovo (s1, n1);
end;
inc (n1);
end;
writeln (' stroka - resultat:');
writeln (s2);
readkey;
end.
А какое нужно добавить условие, чтоб код можно было применить для слов, повторяющихся 2 раза.