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

var
f:text;
st:string
begin
assign (f,'file1.txt');
rewrite (f);
repeat
begin
write ('введите строку для записи');
read (st);
writeln (f,st);
end;
until st='';

var
  f : text;
  st : string;
begin
  assign(f, 'fi.txt');
  rewrite(f);
  repeat
    write('введите строку для записи: ');
    readln(st);
    writeln(f, st)
  until st = '';
  close(f);
  readln
end.

program zad2;
var
 f:text;
 st,st1,st2:string;
 m:array[1..50] of string;
 m2,m1:array[1..50] of string;
 i,j,k:integer;
 function inttostr(o:integer):string;
 var s:string;
 begin
  str(o,s);
  inttostr:=s;
 end;
begin
 for i:=1 to 10 do
  m[i]:=inttostr(i-1); {заполняю массив числами от нуля до девяти}
 m1[1]:='nol'; m1[2]:='odin';
 m1[3]:='dva'; m1[4]:='tri';
 m1[5]:='cheture'; m1[6]:='piat';
 m1[7]:='shest'; m1[8]:='sem';
 m1[9]:='vosem'; m1[10]:='deviat';
 assign (f,'file1.txt');
 rewrite (f);
 repeat {Ввод данных в файл}
 begin
  write ('vvedite stroku dlya zapisi v fail');
  readln (st);
  writeln (f,st);
 end;
 until st='';
 close (f);
 readln;
 reset (f);
 j:=1;
 while not eof(f) do 
 begin
  readln (f,st);
  for i:=1 to length(st) do {нахожу в строке цифры}
   for j:=1 to 10 do
   if st[i]=m[j][1] then
   begin
    delete (st,i,1); {удаляю найденную цифру и вставляю на ее место ее буквенное название}
    insert (m1[j],st,i);
   end;
  k:=0;
  for i:=1 to length(st) do {ищу в строке точки (считаем точку признаком конца предложения)}
  begin
   if (st[i]='.') and (k<>0) then {если не первая, то удаляем предложение до первой точки и копируем в массив}
   begin
    m2[j]:=copy(st,k+1,i-k+1);
    delete (st,k+1,i-k+1);
    j:=j+1;
   end;
   if (st[i]='.') and (k=0) then {если это первая точка, запоминаем ее и копируем предложение в массив}
   begin
    k:=i;
    m2[j]:=copy(st,1,k);
    j:=j+1;
   end;
  end;
  st:='';
 end;
 close (f);
 writeln;
 for i:=1 to j do {выводим получившийся массив предложений} 
 begin
  writeln (m2[i]);
 end;
end.