Оставить в слове только первое и последнее вхождение каждой буквы

for k:=length(slovo) downto 1 do
  if pos(slovo[k],slovo)<k then delete(slovo,k,1);

procedure TForm1.Button1Click(Sender: TObject);
var s,ss:string;i,j,j1,j2:integer;
begin
s:=Trim(Edit1.Text);
ss:='';
for i:=1 to Length(s) do if Pos(s[i],ss)<=0 then ss:=ss+s[i];
for i:=1 to Length(ss) do
   begin
   j1:=0;j2:=0;
   for j:=1 to Length(s) do
      begin
      if ss[i]=s[j] then if j1=0 then j1:=j else j2:=j;
      end;
   if (j1<>0) and (j2<>0) then
      begin
      for j:=1 to Length(s) do
         begin
         if (ss[i]<>s[j]) then continue;
         if (j=j1) or (j=j2) then continue;
         s[j]:=#1;
         end;
      end;
   end;
ss:='';
for i:=1 to Length(s) do if s[i]<>#1 then ss:=ss+s[i];
Edit2.Text:=ss;
end;

        j:= 1;
        while j<= Length(s) do
        begin
          if (ss[i]<>s[j]) then j:=j+1;
          if (j=j1) or (j=j2) then j:=j+1;
          s[j]:=#1;
        end;

j:=1;
while (j<=Length(s)) do
   begin
   if (ss[i]=s[j]) and (j<>j1) and (j<>j2) then s[j]:=#1;
   inc(j);
   end;

var s,s1,sp, ss:string;
    m:set of char;
    n,i,j,k,q,j1,j2:byte;
begin
  writeln('Введите последовательность слов, разделенных пробелами');
  readln(s);
  n:=length(s);
  i:=1;
  while i<=n do{выделяю слова из строки}
  begin
    if((s[i]<>' ') or (s[i]<>','))and((i=1)or(s[i-1]=' ')) then
    begin
      j:=i;
      s1:='';
      while(j<=n)and(s[j]<>' ') do
      begin
        s1:=s1+s[j];
        j:=j+1
      end;
      ss:='';
      for i:=1 to Length(s1) do if Pos(s1[i],ss)<=0 then ss:=ss+s1[i];
      for i:=1 to Length(ss) do
      begin
        j1:=0;
        j2:=0;
        for j:=1 to Length(s1) do
        begin
          if ss[i]=s1[j] then if j1=0 then j1:=j else j2:=j;
        end;
       if (j1<>0) and (j2<>0) then
       begin
         j:=1;
         while (j<=Length(s1)) do
         begin
           if (ss[i]=s1[j]) and (j<>j1) and (j<>j2) then s1[j]:=#1;
           inc(j);
         end;
       end;
      end;
      ss:='';
      for i:=1 to Length(s1) do if s1[i]<>#1 then ss:=ss+s1[i];
      writeln('преобразованные по правилу слова: ',ss);
    end
    else i:=i+1;{пропускаем пробелы}
  end;
 
 
  sp:='';{собираю последнее слово}
  i:=n;
  while(i>0)and((s[i]<>' ') or (s[i]<>',')) do
  begin
    sp:=s[i]+sp;
    i:=i-1
  end;
  n:=i;{длина строки без последнего слова}
  writeln('Слова, отличные от последнего и не содержащие повторяющихся букв');
  q:=0;
  i:=1;
  while i<=n do{выделяю другие слова}
  if((s[i]<>' ') or (s[i]<>','))and((i=1)or(s[i-1]=' ')) then
  begin
    j:=i;
    s1:='';
    while(j<=n)and(s[j]<>' ') do
    begin
      s1:=s1+s[j];
      j:=j+1
    end;
    q:=0;
    if s1<>sp then{если не равно последнему}
    begin
      q:=q+1;
      writeln('ответ: ',s1);
    end;
    i:=i+length(s1){перешагиваю через это слово}
  end
  else i:=i+1;{пропускаем пробелы и запятые}
  if q=0 then write('Таких слов нет.');
  readln
end.