const InName = '2.txt'; OutName = '2.out'; type plist = ^tlist; tlist = record s:string; next:plist; end; var strings,cs,ls : plist; tocopy,cc,lc : plist; INP,OUTP : text; counter : word; NB,KB,M : word; begin Assign(INP,InName); {$I-} Reset(INP); If IOResult <> 0 then begin WriteLn('Ошибка открытия файла ''',InName,''', код: ', IOResult); Halt(200); end; Assign(OUTP,OutName); Rewrite(OUTP); If IOResult <> 0 then begin WriteLn('Ошибка открытия файла для чтения ''',OutName,''', код: ', IOResult); Halt(201); end; {$I+} Write('Введите номер первой строки с которой копировать: '); ReadLn(NB); Write('Введите номер последней строки до которой копировать: '); ReadLn(KB); Write('Введите номер строки перед которой вставить: '); ReadLn(M); counter:=1; New(cs); New(cc); strings := cs; tocopy := cc; while not EOF(INP) do begin ReadLn(INP,cs^.s); New(cs^.next); if counter in [NB..KB] then begin cc^.s := cs^.s; lc := cc; New(cc^.next); cc:=cc^.next; end; ls:=cs; cs:=cs^.next; inc(counter); end; Dispose(cc);Dispose(cs); lc^.next:=nil; ls^.next:=nil; Close(INP); counter := 1; cs:=strings; cc:=tocopy; while cs<>nil do begin if counter = M then while cc<>nil do begin WriteLn(OUTP,cc^.s); cc:=cc^.next; end; WriteLn(OUTP,cs^.s); cs:=cs^.next; inc(counter); end; if counter = M then while cc<>nil do begin WriteLn(OUTP,cc^.s); cc:=cc^.next; end; Close(OUTP); end.