uses item, list;

var
 l: tlist;
 s: string;
 p: ptitem;
 count, index: integer;

begin
 L.init;

 repeat
   write('вводите строку: '); readln(s);
   if s <> '' then L.append(s);
 until s = '';

 write('Введите еще один элемент: '); readln(s);
 L.append(s);
 L.print;

 p := L.first; count := 0;
 while assigned(p) do
   begin
     inc(count);
     p := p^.next
   end;
 writeln('count = ', count);

 write('Введите номер элемента, который следует удалить: ');
 readln(index);

 p := L.first;
 while index > 1 do
   begin
     dec(index); p := p^.next
   end;
 L.remove_item(p);
 L.print;

 L.done;
end.

Program spiski;
uses crt;
type Ukazat=^Inform;
    Inform=record fam:string[15];
    ††††next:Ukazat;
    prev:Ukazat;
                  end;
var temp,first,wqw,cut,p,pk:Ukazat;
   ch:char;
      ffam:string[15];
{========================================================================}
   Procedure Zapolnenie;
begin
ClrScr;
new(temp);
write('Vvedite element: ');
readln(temp^.fam);
if first=nil then
  begin
  temp^.prev:=nil;
  temp^.next:=nil;
  first:=temp;
  cut:=temp;
  end
     else begin
     temp^.next:=nil;
     temp^.prev:=cut;
     cut^.next:=temp;
     cut:=temp;
     end;
end;
{========================================================================}
   Procedure Udal;
begin
ClrScr;
if first=nil then
begin
writeln;
writeln('!!!!!!!  Tablisa pusta   !!!!!!!!!');
end
  else
   begin
   write('Vvedite udalayemiy element spiska: ');
   readln(ffam);
       temp:=first;
                 wqw:=first;
while temp<>nil do begin
temp:=wqw;
while (ffam<>temp^.fam) and (temp<>nil)
do temp:=temp^.next;
      if temp=nil then
   begin
   write{('Takogo elementa net')};
   readln;
   end
   else
    begin
    if first<>cut then
   if temp^.prev=nil then
                begin
                temp^.next^.prev:=temp^.prev;
                first:=temp^.next;
  end
      else
 if temp^.next=nil then
                  begin
                  temp^.prev^.next:=temp^.next;
                  cut:=temp^.prev;
                  end
    else begin
                    temp^.prev^.next:=temp^.next;
                    temp^.next^.prev:=temp^.prev;
   end
                else  first:=nil;
      dispose(temp);
      end;
   end;  end;
end;
{======================================================================}
       Procedure Poisk;
begin
ClrScr;
if first=nil then
begin
writeln;
writeln('!!!!!!!  Tablisa pusta   !!!!!!!!!');
end
  else
   begin
   write('Vvedite element: ');
   readln(ffam);
       temp:=first;
while (ffam<>temp^.fam) and (temp<>nil)
do  temp:=temp^.next;
      if ffam=temp^.fam then
   begin
   writeln('Spisok sodergit danniy element ');
   readln;
   end;
 if temp=nil then
   begin
   write('Takogo  elementa v spiske net');
   readln;
   end; end;end;
{=======================================================================}
         PROCEDURE Vstavka;
begin
ClrScr;
   begin
   write('Vvedite element posle kotorogo vi hotite vstavit : ');
   readln(ffam);
       temp:=first;
  while (ffam<>temp^.fam) and (temp<>nil)
  do  temp:=temp^.next;
if ffam=temp^.fam then
   begin
new(pk);
write('Vvedite vstavlayemiy element: ');
readln(pk^.fam);
†pk^.next:=temp^.next;
     pk^.prev:=temp;
     temp^.next:=pk;
     pk^.next^.prev:=pk;
     end;  end;
  if temp=nil then
   begin
   write('Takogo  elementa v spiske net');
   readln;
   end; end;
{===========================================================================}
         Procedure Prosm;
begin
ClrScr;
temp:=first;
if first<>nil then
begin   writeln('Spisok elementov:  ');
while temp<>nil do
      begin
 writeln('  ',temp^.fam);
temp:=temp^.next;
  end;
  end
else writeln('Tablica pusta':40);
readln;
end;
begin clrscr; Textcolor(6);
repeat
writeln;
writeln( '           Viberite deistvie:');
writeln('1-Zapolnenie');
writeln('2-Udalit');
writeln('3-Prosmotret');
writeln('4 -Poisk ');
writeln('5 -Vstavka ');
writeln('0-Vixod');
readln(ch);
case ch of
'1':Zapolnenie;
'2':Udal;
'3':Prosm;
'4':Poisk;
'5':Vstavka
 end;
until ch='0';
end.