old/PAS/!SPbSTU/2nd/2.PAS

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.