скопировать во второй файл слова которые начинаются и заканчиваются на одну букву

[Екатерина А.]

задаем один файл текстовый даем ему сначало имя и создаем в него пишем строки и нужно скопировать во второй файл те слова которые начинаются и заканчиваются на одну и ту же букву


похожая задача
uses
SysUtils;

var f1,f2:textfile;
ns,n,k,i,kg:integer;
s:string;
mg:set of char;
begin
assignfile(f1,'f1.txt');
assignfile(f2,'rez.txt');
reset(f1);
rewrite(f2);
writeln('Vvedite k-nomer stroki');
readln(k);
ns:=0;
for i := 1 to k - 1 do
readln(f1,s);
for i := k to k+5 do
begin
readln(f1,s);
writeln(f2,s);
end;
closefile(f1);
closefile(f2);
reset(f2);
kg:=0;
mg:=['a','e','o','i','u','y'];
repeat
readln(f2,s);
n:=length(s);
for i := 1 to n do
if s[i] in mg then inc(kg);
until eof(f2);
closefile(f2);
writeln('kol-vo glasnuh bukv v faile',kg:2);
readln;
end.

[alex_fcsm]

uses crt;
var f,f1:text;
    s,sub,name,name1:string;
    ch:char;
    i,n:integer;
    a:array[1..100] of string;

begin
clrscr;
writeln('Path to file');
readln(name);
writeln('Path to file1');
readln(name1);
clrscr;
assign(f,name);
rewrite(f);
ch:=#0;
while ch<>#27 do
begin
readln(s);
writeln(f,s);
ch:=readkey;
end;
close(f);
assign(f,name);
reset(f);
assign(f1,name1);
rewrite(f1);
while not eof(f) do
 begin
  readln(f,s);
  i:=0;n:=0;
  repeat
  inc(i);
  if (s[i]=' ')and(s[i+1]<>' ') then begin
                   inc(n);
                   a[n]:=sub;
                   sub:='';
                   end
     else if (s[i]<>' ')then sub:=sub+s[i];
  until i=length(s);
  if sub<>'' then begin
  inc(n);
  a[n]:=sub;
  end;
  sub:='';
  for i:=1 to n do
   if a[i][1]=a[i][length(a[i])] then writeln(f1,a[i]);
end;
close(f);
close(f1);
end.

[Екатерина А.]

спасибо большое,очень помогли