Удалить абзац

var f,g:text;
    k,n:integer;
    nf,ng,s1,s2:string;
    b:boolean;
begin
clrscr;
write('Имя файла для чтения: ');
read(nf);
nf:=nf+'.txt';
assign(f,nf);
if not Fileexists(nf) then
 begin
  writeLn('Не могу открыть файл ',nf);
  writeLn('Работа программы завершена. Нажмите ENTER');
  readln;
  exit;
 end
else reset(f);
write('Имя файла для записи: ');
read(ng);
ng:=ng+'.txt';
assign(g,ng);
rewrite(g);
write('Введите номер абзаца k=');
read(k);
n:=0;{считаем абзацы}
b:=false;{нет нужного абзаца}
readln(f,s1);{читаем первую строку}
if s1='' then writeln(g,s1){если пустая}
else {иначе начало абзаца}
 begin
  n:=n+1;
  if n<>k then writeln(g,s1);
 end;
while not eof(f) do
 begin
  readln(f,s2);{читаем следующие}
  if (s2<>'')and(s1='') then n:=n+1;{если не пустая, а перед ней пустая,
                                    это новый абзац}
  if n=k then b:=true else b:=false;{если номер нужный, то меняем флаг на true,
                                     если не нужный - обратно}
  if not b or(s2='') then writeln(g,s2);{если не наш абзац или пустая строка,
                                         то пишем в новый файл}
  s1:=s2;{запоминаем последнюю прочитанную строку}
 end;
close(f);
close(g);
writeln('Измененный файл записан в файл ',ng);
if n<k then write('Абзаца с номером ',k,' нет');
end.

var
  F, R: Text;
  N, K: Integer;
  S, FName: String;
  B: Boolean;
 
function AbzCount: Integer;
begin
  Assign(F, FName);
  Reset(F);
  ReadLn(F, S);
  if S = '' Then
  begin
    N := 0;
    B := False;
  end Else
  begin
    N := 1;
    B := True;
  end;
  repeat
    ReadLn(F, S);
    if S = '' Then B := False Else
    begin
      if B = False Then
        Inc(N);
      B := True;
    end;
  until EoF(F);
  AbzCount := N;
end;
 
begin
  Write('Имя файла: ');
  ReadLn(FName);
  Write('Номер абзаца: ');
  ReadLn(K);
  if K > AbzCount Then
    WriteLn('Данного абзаца не существует') Else
  begin
    Write('Имя выходного файла: ');
    ReadLn(S);
    Assign(R, S);
    ReSet(F);
    ReWrite(R);
    ReadLn(F, S);
    if S = '' Then
    begin
      N := 0;
      B := False;
    end Else
    begin
      N := 1;
      B := True;
      if K <> 1 Then
        WriteLn(R, S);
    end;
    repeat
      ReadLn(F, S);
      if S = '' Then B := False Else
      begin
        if B = False Then
          Inc(N);
        B := True;
      end;
      if N <> K Then
        WriteLn(R, S) Else
      if S = '' Then
        WriteLn(R, S);
    until EoF(F);
    Close(R);
    WriteLn('Готово!');
  end;
end.

var
  F, R: Text;
  N, K: Integer;
  S, FName: String;
  B: Boolean;
 
function AbzCount: Integer;//Узнаём сколько абзацев одержит файл.
begin
  Assign(F, FName);
  Reset(F);
  ReadLn(F, S);
  if S = '' Then
  begin
    N := 0;
    B := False;
  end Else
  begin
    N := 1;
    B := True;
  end;
  repeat
    ReadLn(F, S);
    if S = '' Then B := False Else
    begin
      if B = False Then
        Inc(N);
      B := True;
    end;
  until EoF(F);
  AbzCount := N;
end;
 
 
begin
  Write('Имя файла: ');
  ReadLn(FName);
  Write('Номер абзаца: ');
  ReadLn(K);
  if K > AbzCount Then //Сверяемся с функцией, еслть ли такой абзац или нет.
    WriteLn('Данного абзаца не существует') Else
  begin
    Write('Имя выходного файла: ');
    ReadLn(S);
    Assign(R, S);
    ReSet(F);
    ReWrite(R);
    ReadLn(F, S);
    if S = '' Then
    begin
      N := 0;
      B := False;
    end Else
    begin
      N := 1;
      B := True;
      if K <> 1 Then
        WriteLn(R, S);
    end;
    repeat//Записываем всё в новый файл, кроме абзаца, который выбрал пользователь на удаление.
      ReadLn(F, S);
      if S = '' Then B := False Else
      begin
        if B = False Then
          Inc(N);
        B := True;
      end;
      if N <> K Then
        WriteLn(R, S) Else
      if S = '' Then
        WriteLn(R, S);
    until EoF(F);
    Close(R);
    WriteLn('Готово!');
  end;
end.