Представить текст в виде двусвязного списка...

{$I-}
Program xa;
uses
  crt;
type
  spisok=^vs;
  vs=record
    nom:integer;
    s:string;
    next:spisok;
    nped:spisok;
  end;
var
  a,adr,adr1,adr2,nach,kon:spisok;
  f:text;
  s:string;
  p:boolean;
  i,n,b,c,d:integer;
  namefile:string;
begin
  repeat
    clrscr;
    Writeln('BBedute HaumeHobaHue fauLa be3 pacLLIUPeHuia');
    readln(namefile);
    namefile:=namefile+'.txt';
    assign(f,namefile);
    reset(f);
    p:=true;
    if IOResult<>0 then
    begin
      Writeln('Faul otkpblT c oLLiubkou. noBToPuTe BBod');
      readkey;
      p:=false;
    end;
  until p=true;
{$I+}
  close(f);
  new(a);
  adr:=a;    {adr- adpec Ha4ala cnucka c LeBogo boka :D }
  adr2:=a;  {adr2- adpec Ha4ala cnucka c npaBoGo boka :D }
  adr1:=nil;   {adr1 - ucnoLb3yetC9 Bo Bpem9 co3DaHu9}
  a^.next:=nil;      { cledyI-OLLIeGo eleMEHta cnucka}
  a^.nped:=nil;
  Readln(f,s);
  a^.nom:=1;
  a^.s:=copy(s,1,Pos(' ',s)-1);
  delete(s,1,Pos(' ',s));
  while s<>'' do
  begin
    new(a^.next);
    adr1:=a;
    a:=a^.next;
    a^.nped:=adr1;
    a^.next:=nil;
    adr2:=a;
    a^.nom:=1;
    a^.s:=copy(s,1,Pos(' ',s)-1);
    delete(s,1,Pos(' ',s));
  end;
 
 {a:=adr2;
  while a<>nil do
  begin
    Write(a^.s, ' ');
    a:=a^.nped;
  end;}
 
  i:=1;
  while not(EoF(f)) do
  begin
    s:='';
    readln(f,s);
    inc(i);
    while s<>'' do
    begin
      new(a^.next);
      adr1:=a;
      a:=a^.next;
      a^.nped:=adr1;
      a^.next:=nil;
      adr2:=a;
      a^.nom:=i;
      a^.s:=copy(s,1,Pos(' ',s)-1);
      delete(s,1,Pos(' ',s));
    end;
  end;
  repeat
    clrscr;
    Writeln('BBedute Homepa Ha4aLbHou u KoHe4Hou ctpoku');
    writeln;
    Writeln('Ctpoku HA4uHaI-Ot HyMePaL/uI-O c 1-L/bl u oKaH4uBaI-OT');
    writeln('B TekctoBoM faule ' ,namefile, ' ' ,i, ' -ou ctpokou');
    Writeln('He BblbuPaute Becb tekcT (c 1-ou no nocleDHeu ctpoku)');
    Writeln;
    b:=0;
    c:=0;
    d:=0;
    p:=true;
    repeat
      Write('na4aLbHa9 ctpoka=');
      readln(b);
      if (b<1) or (b>=i) then
      begin
        gotoxy(1,wherey-1);
        clreol;
      end
    until (b>0) and (b<i);
    writeln;
    repeat
      Write('KoHe4Ha9 ctpoka=');
      readln(c);
      if (c<b+1) or (c>i) then
      begin
        gotoxy(1,wherey-1);
        clreol;
      end
    until (c>b) and (c<=i);
    if (b=1) and (c=i) then
      p:=false;
  until p;
  Writeln;
  Writeln('BBedute Homep ctpoku nocle kotopou Bbl }l{elaete BctaBUTb');
  Writeln('BbldeLeHHble B DaHHblu momeHt cTpoku ' ,b, ' - ' ,c);
  repeat
    Write('Kyda BctaBl9em? ');
    readln(d);
    if (d<1) or (d=b) or (d=c) or (d>i) then
    begin
      gotoxy(1,wherey-1);
      clreol;
    end;
  until ((d>0) and (d<b)) or ((d>c) and (d<=i));
 
  a:=adr;
  if a^.nom<>b then
  begin
    while a^.next^.nom<>b do  {Udem c Lebogo boka cnucka}
      a:=a^.next;
    nach:=a;  {adpec Ha4ala "nodL/ena ctpok"}
  end
  else
  begin
    nach:=a;  {adpec Ha4ala "nodL/ena ctpok"}
    while a^.nom<>(c+1) do
      a:=a^.next;
    adr:=a
  end;
 
  a:=adr2;
  if a^.nom <> c then
  begin
    while a^.nped^.nom<>c do  {udem c npaBogo boka cnucka}
      a:=a^.nped;
    kon:=a;   {adpec KoHL/a "nodL/ena ctpok"}
  end
  else
  begin
    kon:=a;   {adpec KoHL/a "nodL/ena ctpok"}
    while a^.nom<>(b-1) do
      a:=a^.next;
    adr2:=a;
  end;
 
  {!!!  Pa3PblBaem Cb93u...  !!!}
  a:=nach;         {Ha4alo Pa3PblBaHu9 c LeBogo boka}
  adr1:=nach;
  nach:=a^.next;
  nach^.nped:=nil;
  a^.next:=kon;
                   {Ha4alo Pa3PblBaHu9 c npaBogo boka}
  a:=kon;
  kon:=a^.nped;
  kon^.next:=nil;
  a^.nped:=adr2;
  {!!!KoHeL/ pa3PblBaHUia !!!}
 
  if d=1 then {BctaBl9eM B Ha4alo cnucka}
  begin
    a:=adr;
    adr:=nach;
    kon^.next:=a;
    a^.nped:=kon;
  end
  else
    if d=i then {BctaBl9eM B KoHeL/ cnucka}
    begin
      a:=adr2;
      adr2:=kon;
      nach^.nped:=a;
      a^.next:=nach;
    end
    else
    begin
       a:=adr;
       while a^.next^.nom<>d+1 do
         a:=a^.next;        {HaLLILu kyda BctaBL9Tb}
       {a ceu4ac mecto nocle kotopogo BctaBl9Tb ctpoku}
       adr1:=a^.next;
       {adr1 mecto neped kotopblM}
       nach^.nped:=a;
       a^.next:=nach;
       kon^.next:=adr1;
       adr1^.nped:=kon;
    end;
  {Y hac ecTb b,c,d }
 
  a:=adr;
  while a<>nil do
  begin
    Write(a^.s, ' ');
    a:=a^.next;
  end;
  a:=adr;
  while a<>nil do
  begin
    adr:=a^.next;
    dispose(a);
    a:=adr;
  end;
  readkey;
end.