Вывести на экран те символы, которые встречаются в строке только один раз

uses crt;
var s,s1:string;
    c:char;
    i,j,k:byte;
begin
writeln('Введите строку');
read(s);
s1:=s;{сделаем копию строки, если строка не нужна, то можно и не делать}
i:=1;
while i<length(s1) do
 begin
  c:=s1[i];{запомним символ}
  k:=0;
  for j:=length(s1) downto i+1 do{с конца строки ищем такие же}
  if s1[j]=c then{если есть}
   begin
    k:=1;{фиксируем}
    delete(s1,j,1);{удаляем}
   end;
  if k=1 then delete(s1,i,1){если не один, удаляем}
  else i:=i+1;{иначе проверяем следующий}
 end;
writeln('Символы по 1 разу');
if s1='' then write('Таких символов нет')
else write(s1);
end.

uses crt;
var s:array[1..20] of string;
    n,i,j,p,k:byte;
    c:char;
begin
write('Количество строк n=');
read(n);
writeln('Введите ',n,' строк:');
for i:=1 to n do
read(s[i]);
writeln;
writeln('Символы, которые входят в строки более 1 раза:');
for i:=1 to n do
 begin
  while length(s[i])>0 do
   begin
    c:=s[i][1];
    k:=0;
    for p:=length(s[i]) downto 1 do
    if s[i][p]=c then
     begin
      k:=k+1;
      delete(s[i],p,1);
     end;
   if k>1 then write(c);
  end;
 end;
end.

program p;
var f:text;
    s:string;
    i,j,k:integer;
    m:set of char;
begin write('***************************************************');
      assign(f,'e:\F11.txt');
      reset(f);
      m:=['*'..'п'];
      writeln('символы:');
      while not(eof(f)) do
        begin readln(f,s);
              for i:=1 to length(s) do
                begin k:=0;
                      for j:=1 to length(s) do
                              if (s[i] in m)and(s[j] in m)and(s[i]=s[j])
                                 then k:=k+1;
                    if k=1  then write(s[i],' ');
                end;
          end;
    close(f);
end.

program symb_finder;
var 
 f:text;
 input,str1:string;
 set2:set of char;
 i:integer;
begin
assign(f,'input.txt');
reset(f);
str1:='';
set2 := [];
while not(eof(f)) do
 begin
  readln(f,input);
  for i := 1 to length(input) do
   if not(input[i] in set2) then
    begin
     str1 := str1 + input[i];
     set2 := set2 + [input[i]];
    end else
     delete(str1,pos(input[i],str1),1);
  end;
close(f);
writeln('Символы, которые встречаются в тексте один раз (в том порядке, в котором встречены в тексте): ', str1);
readln;
end.