нюанс со вставкой строки в текстовый файл, Срочно (стирается конец строки в самом файле) Опции

[Мистер Ди]

Задание:
ввести с клавиатуры строчку S1 и два числа №1 и №2. В тексте с позиции №1 вставить строку S1, с заменой символов (вместо старых символов), с позиции №2 вставить ту же строчку в обратной последовательности (абв - вба). Вывести измененную строку на экран до и после изменения.

У меня стирается конец строки из самого файла при вставке... Как увеличить строку, В которую вставляем?
ЗЫ вставка выделена...

program laba2;
uses crt;
var
 f:text;
 a,s:array[1..80] of string;
 k,i,dl,e,dl1,i1,dl2,w,t:integer;
 name,c,q,buf: string;
 n1,n2:integer;
 label 1;
function open_f(var f:text;name:string): boolean;
 begin
  assign(f,name);
  {$I-};reset(f);{$I+};
  if IOResult=0 then
   begin
    writeln('Файл открыт успешно');
    open_f:=true;
   end
  else
   begin
    writeln('Ошибка открытия файла ');
    writeln;
    open_f:=false;
   end;
 end;
procedure vyvod(var f:text;name:string);
 begin
  assign(f,name);
  {$I-};reset(f);{$I+};
  writeln;
  repeat
   readln(f,c);
   writeln(c);
  until EOF(f);
   close(f);
   writeln;
 end;
  begin
   clrscr;
   repeat
    write('Введите название файла :  ');
    readln(name);
     writeln;
   until open_f(f,name) = true;

   repeat
    readln(f,s[k]);
    dl:=dl+length(s[k]);
   until EOF(f);
   writeln('Введите числа №1 и №2, причём меньше  ',dl,'.');
   write('№1-');
   readln(n1);

   write('№2-');
   readln(n2);

  1: Write('Введите строку не ьольше  ',((n2-n1)+1),'-');
   Readln(q);
   dl2:=length(q);
   If dl2>((n2-n1)+1) then begin Writeln('Ошибка ввода '); goto 1  end;
clrscr;

   writeln ('Файл');
   vyvod (f,name);

   reset (f);

   Writeln('Ввод строки между позициями №1-',n1,'и №2-',n2,' и вставка перевёрнутой строки после позиции №2-',n2);
   k:=1;
   i1:=0;
   w:=1;
   e:=1;

   For i:=dl2 downto 1  do
    begin
     buf[e]:=q[i];
     inc(e);
    end;
   e:=1;

   repeat
    readln(f,s[k]);
    dl1:=length(s[k]);
    dl2:=length(q);
    For i:=1 to dl1 do
     begin
      inc(i1);
      If (i1>=n1) and (dl2>=w)  then
       begin
	s[k,i]:=q[w];
	inc(w);
       end;
      If (i1>n2) and (dl2>=e) then
      Begin
       for t:=dl1 downto i do
       begin
      

 
s[k,t+1]:=s[k,t];
       s[k,t]:=buf[e];
       dl1:=dl1+1;


	      end;
       inc(e);
	     end;
     end;
     Writeln(s[k]);
    inc(k);
   until EOF(f);
   readkey;
   close (f);
end.

Сообщение отредактировано: Мистер Ди - 9.06.2007 16:43