Строки.Выписать буквы, которые встретились три раза подряд

var
  s, r: String;
  i, j: Integer;
  c: set of char;
begin
  Write('Введите строку: '); ReadLn(s); {r:=''; c:=[];}
  for i:=1 to Length(s)-2 do
    if (s[i]=s[i+1]) and (s[i]=s[i+2]) then
      if not (s[i] in c) then begin
        Include(c,s[i]);
        j:=1; while (j<=Length(s)) and (s[i]>r[j]) do Inc(j);
        Insert(s[i],r,j);
      end else if Pos(s[i],r)>0 then Delete(r,Pos(s[i],r),1);
  WriteLn(r);
end.

var s,r:string;
    i,j,n:integer;
    c:char;
begin
Writeln('Введите строку: ');
ReadLn(s);
r:='';
for i:=1 to Length(s)-2 do
if (s[i]=s[i+1]) and (s[i]=s[i+2]) then
r:=r+s[i];
if r='' then write('Нет подряд трех одинаковых букв')
else
 begin
  n:=length(r);
  for i:=1 to n-1 do
  for j:=i+1 to n do
  if r[i]>r[j] then
   begin
    c:=r[i];
    r[i]:=r[j];
    r[j]:=c
   end;
  write(r)
 end;
end.

var
  s,s2:string;
  s1:char;
  i,j:integer;
  a:array[char] of integer;
begin
  readln(s);s1:=s[1];a[s1]:=1;s:=s+' ';
  for i:=2 to length(s) do 
    if s1=s[i] then inc(a[s1]) else begin
      if a[s1]=3 then s2:=s2+s1;
       s1:=s[i];
       a[s1]:=1;
    end;
  for s1:='a' to 'z' do if pos(s1,s2)>0 then write(s1);   
end.