Заменить в файле слова синонимами

n:=0;
while not eof(f1) do
 begin
  readln(f1,s);
  for i:=1 to length(s) do
  if s[i] ib rz then s[i]:=',';//заменим все разделители на запятые
  s:=s+',';//добавим запятую в конец
  while pos(',,',s)>0 do//пока есть 2 запятые рядом
  delete(s,pos(',,',s),1);//1 удалим
  if s[1]=',' then delete(s,1,1);//если первая запятая, удалим ее
//получим строку типа слово,слово,слово,слово
//сейчас ее слова легко собирать в массив
  while pos(',',s)>0 do
   begin
    n:=n+1;
    mas[n]:=copy(s,1,pos(',',s)-1);
    delete(s,1,pos(',',s));
   end;
 end;

type mas_sl=array[1..100] of string;
     var f1,f2,f3:text; j,i:integer; z1,z2:byte;
     a1:array[1..100] of string; a2:array[1..100] of string; h:char;
     procedure from_file_to_mas(var f:text; var x:mas_sl; var n:byte);
               var b,c:char;
               begin
                    reset(f); c:=' '; n:=1; x[1]:='';
                    while not eof(f) do begin
                    b:=c;
                    read(f,c);
                    if (c<>' ') and(pos(c,'!,.?()*:;"[]')=0) then x[n]:=x[n]+c else
                    if (b<>' ') and (pos(c,'!,.?()*:;"[]')=0) then begin inc(n);
                                         x[n]:='';
                    end;
                    end;
                    end;
     begin
          assign(f1,'');
          assign(f2,'');
          assign(f3,'');
          reset(f1);
          reset(f2);
          rewrite(f3);
          from_file_to_mas(f1,a1,z1);
          a2[1]:=''; i:=1; z2:=1;
          while not eof(f2) do begin
          read(f2,h);
          if h<>',' then
          a2[i]:=a2[i]+h else begin
                         inc(i);
                         a2[i]:='';
                         z2:=z2+1;
                         end;
                         end;
          for i:=1 to z1 do
              for j:=1 to z2 do begin
              if a1[i]=a2[j]then begin write(f3,a2[j+1]);
                                       write(f3,',');
                                       end
              else if a1[i]=a2[j+1] then begin write(f3,a2[j]);
                                            write(f3,',');
                                            end;
              j:=j+1;
              end;
              close(f1);
              close(f2);
              close(f3);
              end.