Улучшить и сжать код

Program Sym;
uses crt;
var
    i,j,k,n: integer;                   {i,j - индексы символов в строках, k - счетчик }
    str,new,new1: string;
    ch:char;
    s: set of char;
begin
clrscr;
s:=[];
writeln('Введите строку:');
readln(str);
for i:=1 to length(str) do
    begin
       ch:=str[i];
       if str[i] in s then
          begin
             s:=s;
          end
       else
          begin
             s:=s+[ch];
             new:=new+ch;
             k:=k+1;
          end;
    end;
for i:=1 to length(new) do
    begin
         for j:=1 to length(str) do
             begin
                 if new[i]=str[j] then
                     begin
                         n:=n+1;
                     end
                else
                     begin
                         n:=n;
                     end;
            end;
    if n>=2 then new1:=new1+new[i];
        n:=0;
    end;
writeln;
writeln ('Более двух раз в строке встречаются следующие символы: ', new1);
writeln;
writeln('Конец программы. Нажмите любую клавишу');
readkey;
end.

procedure meet (s:string);
var
m:set of char;
i,k,j:integer;
begin
m:=[];
for i:=1 to length(s) do begin
k:=0;
for j:=1 to length(s) do
if s[i]=s[j] then
inc(k);
if k=2 then
m:=m+[s[i]];
end;
for i:=33 to 255 do
if chr(i) in m then
write(chr(i),' ');
end;
 
 
var
s:string;
begin
readln(s);
meet(s);
end.