Мне нужно вывести слова, повторяющиеся, например, 2 раза. Если слово, просто повторяется - этот случай разобран (тема "Слова повторяющиеся хотя бы раз"), вот код

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 раза.

var
a : array[1..n] of record 
  s: string;
  count: integer;
end;

...
while slovo(s1, n1) <> '' do begin
  found := false;
  for j := 1 to i do
    if a[j].s = slovo (s1, n1) then begin
      inc(a[j].count); found := true;
    end;

  if not found then begin
    inc (i);
    a[i].r := slovo (s1, n1);
    a[i].count := 1;
  end;

  inc (n1); { <--- Следующее слово }
end;

А потом просто пробегаешь по массиву, и печатаешь те слова, у которых поле count равно 2 (или сколько тебе надо)