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

program TEST7;
uses crt;
var
  f_in,f_out:text;  
  p:integer;
  s,slovo:string;
{----------------------------------------------------------------------------------------------------------------------}
function unique_letters(s:string):string;
label flag;
var i,j:integer;
begin
  flag:
  for i:=1 to length(s) do
    for j:=i+1 to length(s) do
      if s[i]=s[j] then
      begin
        delete(s,j,1);
        goto flag;
      end;
      unique_letters:=s;
end;
{----------------------------------------------------------------------------------------------------------------------} 
begin
  clrscr;
  assign(f_in,'TMP1.TXT');
   reset(f_in);
  if IOResult <> 0 then
  begin
    writeln('ne mogu otkrit fail ','TMP1.TXT');
    writeln('rabota programmi zavershena. najmite ENTER');
    readln;
    exit;
  end;
  assign(f_out,'TMP2.TXT');
  rewrite(f_out);
  writeln('"ishodnik:"');
  while not EOF (f_in) do
  begin
    readln(f_in,s);
    writeln(s);
    if pos('.',s) <> 0 then
      delete(s,pos('.',s),1);
    while pos('  ',s) <> 0 do
      delete(s,pos('  ',s),1);
    repeat
      p:=pos(' ',s);
      slovo:=copy(s,1,p-1);
      if p<>0 then
      begin
        write(f_out,unique_letters(slovo),' ');
        delete(s,1,p);
      end;
    until p=0;
    delete(s,1,p);
    writeln(f_out,unique_letters(s));
  end;
  close (f_in);
  close (f_out);
 
  {$I-} reset(f_out); {$I+}
  if IOResult <> 0 then
  begin
    writeln('ne mogu otkrit fail ','TMP2.TXT');
    writeln('rabota programmi zavershena. najmite ENTER');
    readln;
    exit;
  end;
  writeln;
  writeln('"itog:"');
  while not EOF (f_out) do
  begin
    readln(f_out,s);   
    writeln(s);
  end;
 
  writeln;
  write('"fail perepisan! (TMP2.TXT)"');
  readln
end.