Lista.txt

program Lista;

{uses Crt;}

type
  Wskaznik = ^Element;         { wskaznik do elementu listy }
  Element = record             { element listy }
              Tekst : string;  { jego zawartosc }
              Wsk : Wskaznik;  { wskaznik do nastepnego }
            end;


var
   tekst, tekst2:string;
   nr:integer;
const
   Glowa:Wskaznik = nil;      { tworzymy od razu pusta liste }



procedure UtworzElement(g:string; Poprzedni:Wskaznik);
{ tworzy element listy nie bedacy glowa }
var
   Nowy:Wskaznik;
begin
   new(Nowy);                 { utworz element }
   Nowy^.Tekst:=g;            { wpisz jego tresc }
   Nowy^.Wsk:=Poprzedni^.Wsk; { ustaw wskaznik nowego elementu }
   Poprzedni^.Wsk:=Nowy;      { dolacz go do listy }
end;


procedure UtworzGlowe(g:string);
{ tworzy glowe nieistniejacej listy }
begin
   new(Glowa);                { utworz glowe }
   Glowa^.Tekst:=g;           { wpisz tekst do glowy }
   Glowa^.Wsk:=nil;           { zakoncz liste na pierwszym elemencie }
end;

function Szukaj(g:string):Wskaznik;
{ zwraca wskaznik do elementu listy zawierajacego lancuch s }
{ lub nil, jezli nie znaleziono lancucha }
var
   pomoc : Wskaznik;
begin
   pomoc := Glowa;              { zacznij od poczatku listy }
  while (pomoc^.Wsk <> nil)    { koniec listy? }
    and (pomoc^.Tekst <> g) do { znaleziono ^a�cuch? }
   pomoc := pomoc^.Wsk;       { skocz do nast�pnego elementu }
   Szukaj := pomoc;
end;

procedure Wstaw(g:string;Po:string);
{ wstawia element o zawarto~ci s po elemencie zawierajacym lancuch Po }
begin
   if Glowa = nil then          { lista nie istnieje }
      UtworzGlowe(g)
   else { znajd� miejsce wstawienia i wstaw element }
      UtworzElement(g,Szukaj(Po));
end;

procedure Dopisz(g:string);
{ dopisuje element o zawartosci s na koncu listy }
var
   pomoc, Nowy : Wskaznik;
begin
   Wstaw(g, '');                { znajdz koniec listy i wstaw tam element }
end;

procedure Usun(s:string);
{ usuwa z listy element zawierajacy lancuch s }
var
   pomoc : Wskaznik;
   i : integer;
begin
   if Glowa^.Tekst = s then
      begin
         dispose(Glowa);          { zwolnij pamiec }
         Glowa := Glowa^.Wsk;     { nowa glowa = element 2. }
      end
   else { usuwamy element 2... ostatni }
      begin
         pomoc := Glowa;          { zaczynamy od poczatku listy }
      while (pomoc^.Wsk <> nil) and    { znajdz element }
            (pomoc^.Wsk^.Tekst <> s) do{ poprzedzajacy szukany}
             pomoc := pomoc^.Wsk;
             dispose(pomoc^.Wsk);             { usun element }
             pomoc^.Wsk := pomoc^.Wsk^.Wsk;   { przeskocz puste miejsce}
      end
end;

procedure WypiszListe;
{ wypisuje cala zawartosc listy }
var
   pomoc : Wskaznik;
begin
   pomoc := Glowa;              { wypisujemy od poczatku }
   writeln('Zawartosc listy: ');
   while pomoc <> nil do
      begin
         writeln(pomoc^.Tekst);   { nastepny element }
         pomoc := pomoc^.Wsk      { wypisz go }
      end;
   writeln;
end;

procedure Usuwanie;
{ usuwa cala zawartosc listy }
var
   pomoc, nastepny : Wskaznik;
begin
   pomoc:=Glowa;                { wypisujemy od poczatku }
   while pomoc^.Wsk <> nil do
      begin
         nastepny:=pomoc^.Wsk;    { zapamietaj wskaznik nastepnego }
         dispose(pomoc);          { usun element }
         pomoc:=nastepny;         { przejdz do nastepnego elementu }
      end;
end;

begin
 { ClrScr;}

repeat
   writeln('1.Dopisz');
   writeln('2.Wstaw');
   writeln('3.Wypisz');
   writeln('4.Usun');
   writeln('5.Zamknij');
   readln(nr);
   if nr=1 then
   begin
      Writeln('Podaj tekst');
      Readln(tekst);
      Dopisz(tekst);  { dopisz kilka tekstow }
   end
   else if nr=2 then
   begin
      writeln('Podaj tekst ktory ma byc wstawiony');
      readln(tekst);
      writeln('Podaj tekst po kt�rym nasz tekst ma by� wstawiony');
      readln(tekst2);
      Wstaw(tekst,tekst2);
   end
   else if nr=3 then
   begin
      WypiszListe;
   end
   else if nr=4 then
   begin
      writeln('Podaj tekst do usuniecia:');
      readln(tekst);
      Usun(tekst);
   end;

until nr=5;

   Usuwanie;
end.