API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jun 18th, 2018
122
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 12.95 KB | None | 0 0
raw download clone embed print report
  1. uses Crt,SysUtils;
  2.  
  3. type
  4.   plista_d = ^tosoba;
  5.   tosoba = record
  6.   imie: string[25];
  7.   nazwisko: string[40];
  8.   wiek: byte;
  9.   PESEL: string[11];
  10.   nast,pop: plista_d;
  11.   end;
  12.  
  13. var
  14.   pocz:plista_d;
  15.   numer:integer;
  16.  
  17. procedure wstawDoListy(var pocz:plista_d; temp:plista_d);
  18. var
  19.   poczatek:plista_d;
  20. begin
  21.   if pocz=nil then
  22.   begin
  23.     temp^.pop:=nil;
  24.     temp^.nast:=nil;
  25.     pocz:=temp;
  26.   end
  27.   else
  28.   begin
  29.     poczatek:=pocz;
  30.     while(pocz<>nil) do
  31.     begin
  32.       if (temp^.nazwisko<pocz^.nazwisko) then
  33.       begin
  34.         if(pocz^.pop=nil) then
  35.         begin
  36.           temp^.nast:=pocz;
  37.           temp^.pop:=nil;
  38.           pocz^.pop:=temp;
  39.           pocz:=temp;
  40.           break;
  41.         end
  42.         else
  43.         begin
  44.           temp^.nast:=pocz;
  45.           temp^.pop:=pocz^.pop;
  46.           pocz^.pop^.nast:=temp;
  47.           pocz^.pop:=temp;
  48.           pocz:=temp;
  49.           pocz:=poczatek;
  50.           break;
  51.         end;
  52.       end
  53.       else
  54.       begin
  55.         if(pocz^.nast=nil) then
  56.         begin
  57.           temp^.nast:=nil;
  58.           temp^.pop:=pocz;
  59.           pocz^.nast:=temp;
  60.           pocz:=poczatek;
  61.           break;
  62.         end;
  63.         pocz:=pocz^.nast;
  64.       end;
  65.     end;
  66.   end;
  67. end;
  68.  
  69.  
  70.  
  71. procedure dodaj(var pocz:plista_d);
  72. var
  73.   temp,nazwisko:plista_d;
  74.   czyWystapil:boolean;
  75.   numer:integer;
  76. begin
  77.   repeat
  78.     writeln('Wybierz w jaki sposob chcesz dodac:');
  79.     writeln('1) Dodaj z zachowaniem porzadku klucza (nazwisko)');
  80.     writeln('2) Dodaj z zachowaniem porzadku klucza (nazwisko) oraz sprawdzeniem unikalnosci');
  81.     readln(numer);
  82.   until (numer=1) or (numer=2);
  83.  
  84.   new(temp);
  85.   writeln('Podaj imie:');
  86.   readln(temp^.imie);
  87.   if(numer=1) then
  88.   begin
  89.     writeln('Podaj nazwisko:');
  90.     readln(temp^.nazwisko);
  91.   end
  92.   else
  93.   begin
  94.     repeat
  95.     nazwisko:=pocz;
  96.     czyWystapil:=false;
  97.     writeln('Podaj nazwisko:');
  98.     readln(temp^.nazwisko);
  99.     if pocz<>nil then
  100.     begin
  101.       repeat
  102.       if(nazwisko^.nazwisko=temp^.nazwisko) then
  103.       begin
  104.          writeln('Takie nazwisko juz jest na liscie!');
  105.          czyWystapil:=true;
  106.       end;
  107.       nazwisko:=nazwisko^.nast;
  108.       until nazwisko=nil;
  109.     end
  110.     until czyWystapil=false;
  111.   end;
  112.   writeln('Podaj wiek:');
  113.   readln(temp^.wiek);
  114.   writeln('Podaj PESEL:');
  115.   readln(temp^.PESEL);
  116.   wstawDoListy(pocz,temp);
  117.   writeln('Gotowe!');
  118.   writeln('Nacisnij ENTER, aby kontynuowac...');
  119.   readln;
  120. end;
  121.  
  122. function usunZListy(var pocz:plista_d; nazwisko:string):boolean;
  123. var
  124.   poczatek,temp:plista_d;
  125. begin
  126.   poczatek:=nil;
  127.   if(pocz^.nazwisko=nazwisko) then
  128.   begin
  129.      temp:=pocz;
  130.      if pocz^.nast<>nil then
  131.       begin
  132.         pocz:=pocz^.nast;
  133.         pocz^.pop:=nil;
  134.       end
  135.      else pocz:=nil;
  136.      dispose(temp);
  137.      temp:=nil;
  138.      usunZListy:=true;
  139.   end
  140.   else
  141.   begin
  142.     poczatek:=pocz;
  143.     pocz:=pocz^.nast;
  144.     while pocz<>nil do
  145.     begin
  146.        if(pocz^.nazwisko=nazwisko) then
  147.         begin
  148.            temp:=pocz;
  149.            if pocz^.nast<>nil then
  150.             begin
  151.               pocz^.pop^.nast:=pocz^.nast;
  152.               pocz^.nast^.pop:=pocz^.pop;
  153.             end
  154.            else
  155.              pocz^.pop^.nast:=nil;
  156.            dispose(temp);
  157.            temp:=nil;
  158.            usunZListy:=true;
  159.            break;
  160.         end
  161.        else pocz:=pocz^.nast;
  162.     end;
  163.     if(pocz=nil) then usunZListy:=false;
  164.     pocz:=poczatek;
  165.   end;
  166. end;
  167.  
  168. function usunPoPeselu(var pocz:plista_d; pesel:string):boolean;
  169. var
  170.   poczatek,temp:plista_d;
  171. begin
  172.   poczatek:=nil;
  173.   if(pocz^.PESEL=pesel) then
  174.   begin
  175.      temp:=pocz;
  176.      if pocz^.nast<>nil then
  177.       begin
  178.         pocz:=pocz^.nast;
  179.         pocz^.pop:=nil;
  180.       end
  181.      else pocz:=nil;
  182.      dispose(temp);
  183.      temp:=nil;
  184.      usunPoPeselu:=true;
  185.   end
  186.   else
  187.   begin
  188.     poczatek:=pocz;
  189.     pocz:=pocz^.nast;
  190.     while pocz<>nil do
  191.     begin
  192.        if(pocz^.PESEL=pesel) then
  193.         begin
  194.            temp:=pocz;
  195.            if pocz^.nast<>nil then
  196.             begin
  197.               pocz^.pop^.nast:=pocz^.nast;
  198.               pocz^.nast^.pop:=pocz^.pop;
  199.             end
  200.            else
  201.              pocz^.pop^.nast:=nil;
  202.            dispose(temp);
  203.            temp:=nil;
  204.            usunPoPeselu:=true;
  205.            break;
  206.         end
  207.        else pocz:=pocz^.nast;
  208.     end;
  209.     if(pocz=nil) then usunPoPeselu:=false;
  210.     pocz:=poczatek;
  211.   end;
  212. end;
  213.  
  214. procedure usun(var pocz:plista_d);
  215. var
  216.   nazwisko:string;
  217. begin
  218.   if(pocz=nil) then
  219.   writeln('Nie mozesz nic usunac, poniewaz lista jest pusta!')
  220.   else
  221.   begin
  222.    writeln('Podaj nazwisko do usuniecia:');
  223.    readln(nazwisko);
  224.    if (usunZListy(pocz,nazwisko)) then
  225.       writeln('Usunieto element o podanym nazwisku z listy.')
  226.    else
  227.       writeln('Brak takiego nazwiska w liscie.');
  228.   end;
  229.   writeln('Nacisnij ENTER, aby kontynuowac...');
  230.   readln;
  231. end;
  232.  
  233.  
  234. procedure usunWszystko(var pocz:plista_d);
  235. var
  236.   temp,poczatek:plista_d;
  237.   nazwisko:string;
  238.   licznik:integer;
  239. begin
  240.   licznik:=0;
  241.   poczatek:=pocz;
  242.   if pocz=nil then writeln('Nie mozesz nic usunac, poniewaz lista jest pusta!')
  243.   else
  244.   begin
  245.   writeln('Podaj nazwisko do usuniecia:');
  246.   readln(nazwisko);
  247.   while pocz<>nil do
  248.   begin
  249.     if(pocz^.nazwisko=nazwisko) then
  250.      begin
  251.         if(pocz^.pop=nil) then
  252.         begin
  253.            temp:=pocz;
  254.            if pocz^.nast<>nil then
  255.             begin
  256.               pocz:=pocz^.nast;
  257.               pocz^.pop:=nil;
  258.             end
  259.            else pocz:=nil;
  260.            dispose(temp);
  261.            temp:=nil;
  262.            poczatek:=pocz;
  263.            writeln('Usunieto element o podanym nazwisku z listy.');
  264.            inc(licznik);
  265.            continue;
  266.         end;
  267.         if(pocz^.pop<>nil) then
  268.         begin
  269.            temp:=pocz;
  270.            if pocz^.nast<>nil then
  271.             begin
  272.               pocz^.pop^.nast:=pocz^.nast;
  273.               pocz^.nast^.pop:=pocz^.pop;
  274.             end
  275.            else
  276.              pocz^.pop^.nast:=nil;
  277.            pocz:=pocz^.nast;
  278.            dispose(temp);
  279.            temp:=nil;
  280.            writeln('Usunieto element o podanym nazwisku z listy.');
  281.            inc(licznik);
  282.         end;
  283.       end
  284.       else pocz:=pocz^.nast;
  285.   end;
  286.   pocz:=poczatek;
  287.   if licznik=0 then writeln('Brak takiego nazwiska w liscie.');
  288.   end;
  289.   writeln('Nacisnij ENTER, aby kontynuowac...');
  290.   readln;
  291. end;
  292.  
  293. procedure edytuj(var pocz:plista_d);
  294. var
  295.   element:string;
  296.   poczatek,temp:plista_d;
  297.   licznik:integer;
  298. begin
  299.   licznik:=0;
  300.   if(pocz=nil) then writeln('Nie mozesz edytowac pustej listy!')
  301.   else
  302.   begin
  303.     repeat
  304.       writeln('Wybierz po jakim elemencie chcesz edytowac:');
  305.       writeln('1) Edytuj poprzez "NAZWISKO"');
  306.       writeln('2) Edytuj poprzez "PESEL"');
  307.       readln(numer);
  308.     until (numer=1) or (numer=2);
  309.      poczatek:=pocz;
  310.      new(temp);
  311.      if(numer=1) then
  312.        writeln('Wpisz NAZWISKO osoby, ktorej dane chcesz zmienic:')
  313.      else
  314.        writeln('Wpisz PESEL osoby, ktorej dane chcesz zmienic:');
  315.      readln(element);
  316.      while(pocz<>nil) do
  317.      begin {
  318.         if(pocz^.PESEL=element) or (pocz^.nazwisko=element) then
  319.         begin
  320.           if(numer=1) then
  321.           begin
  322.             writeln('Podaj imie:');
  323.             readln(pocz^.imie);
  324.             writeln('Podaj wiek:');
  325.             readln(pocz^.wiek);
  326.             writeln('Podaj PESEL:');
  327.             readln(pocz^.PESEL);
  328.           end
  329.           else
  330.           begin
  331.             writeln('Podaj imie:');
  332.             readln(temp^.imie);
  333.             writeln('Podaj nazwisko:');
  334.             readln(temp^.nazwisko);
  335.             writeln('Podaj wiek:');
  336.             readln(temp^.wiek);
  337.             temp^.PESEL:=pocz^.PESEL;
  338.             usunZListy(poczatek,element);
  339.             wstawDoListy(poczatek,temp);
  340.           end;}
  341.          //if(pocz^.PESEL=element) or (pocz^.nazwisko=element) then
  342.           //begin
  343.           if((numer=1) and (pocz^.nazwisko=element)) then
  344.           begin
  345.             writeln('Podaj imie:');
  346.             readln(pocz^.imie);
  347.             writeln('Podaj wiek:');
  348.             readln(pocz^.wiek);
  349.             writeln('Podaj PESEL:');
  350.             readln(pocz^.PESEL);
  351.             writeln('Pomyslnie edytowano dane.');
  352.             inc(licznik);
  353.             break;
  354.           end;
  355.           if((numer=2) and ((pocz^.PESEL=element))) then
  356.           begin
  357.             writeln('Podaj imie:');
  358.             readln(temp^.imie);
  359.             writeln('Podaj nazwisko:');
  360.             readln(temp^.nazwisko);
  361.             writeln('Podaj wiek:');
  362.             readln(temp^.wiek);
  363.             temp^.PESEL:=pocz^.PESEL;
  364.             usunPoPeselu(poczatek,element);
  365.             wstawDoListy(poczatek,temp);
  366.             writeln('Pomyslnie edytowano dane.');
  367.             inc(licznik);
  368.             break;
  369.           end;
  370.           pocz:=pocz^.nast;
  371.         //else
  372.      end;
  373.      if licznik=0 then
  374.      begin
  375.        if(numer=1) then
  376.            writeln('Brak podanego NAZWISKA w liscie.')
  377.        else
  378.            writeln('Brak podanego numeru PESEL w liscie.');
  379.      end;
  380.   end;
  381.   pocz:=poczatek;
  382.   writeln('---------------------');
  383.   writeln('Nacisnij ENTER, aby kontynuowac...');
  384.   readln;
  385. end;
  386.  
  387. procedure zapiszDoPliku(pocz:plista_d);
  388. var
  389.   txtFile:textfile;
  390.   numer:integer;
  391.   nazwisko:string;
  392. begin
  393.   if pocz=nil then writeln('Nie mozesz nic zapisac do pliku, poniewaz lista jest pusta!')
  394.   else
  395.   begin
  396.      repeat
  397.         writeln('Wybierz jakie elementy mam umiescic w pliku:');
  398.         writeln('1) Wszystkie elementy listy');
  399.         writeln('2) Elementy o wybranym nazwisku');
  400.         writeln('3) Osoby pelnoletnie');
  401.         readln(numer);
  402.      until (numer=1) or (numer=2) or (numer=3);
  403.      if(numer=2) then
  404.      begin
  405.        writeln('Podaj nazwisko:');
  406.        readln(nazwisko);
  407.      end;
  408.      assignfile(txtFile, 'lista.txt');
  409.      rewrite(txtFile);
  410.      writeln('Zapisuje...');
  411.      repeat
  412.        begin
  413.          if(numer=1) then
  414.          begin
  415.           writeln(txtFile,'Imie: ',pocz^.imie);
  416.           writeln(txtFile,'Nazwisko: ',pocz^.nazwisko);
  417.           writeln(txtFile,'Wiek: ',pocz^.wiek);
  418.           writeln(txtFile,'PESEL: ',pocz^.PESEL);
  419.           writeln(txtFile,'---------------------');
  420.          end;
  421.          if(numer=2) and (pocz^.nazwisko=nazwisko) then
  422.          begin
  423.           writeln(txtFile,'Imie: ',pocz^.imie);
  424.           writeln(txtFile,'Nazwisko: ',pocz^.nazwisko);
  425.           writeln(txtFile,'Wiek: ',pocz^.wiek);
  426.           writeln(txtFile,'PESEL: ',pocz^.PESEL);
  427.           writeln(txtFile,'---------------------');
  428.          end;
  429.          if(numer=3) and (pocz^.wiek>=18) then
  430.          begin
  431.           writeln(txtFile,'Imie: ',pocz^.imie);
  432.           writeln(txtFile,'Nazwisko: ',pocz^.nazwisko);
  433.           writeln(txtFile,'Wiek: ',pocz^.wiek);
  434.           writeln(txtFile,'PESEL: ',pocz^.PESEL);
  435.           writeln(txtFile,'---------------------');
  436.          end;
  437.          pocz:=pocz^.nast;
  438.        end;
  439.      until pocz=nil;
  440.      writeln('Zapisano!');
  441.     closefile(txtFile);
  442.     end;
  443.   writeln('Nacisnij ENTER, aby kontynuowac...');
  444.   readln;
  445. end;
  446.  
  447. procedure wyswietl(pocz:plista_d);
  448. begin
  449.   if pocz=nil then writeln('Lista jest pusta.')
  450.   else
  451.   repeat
  452.     begin
  453.       writeln('Imie: ',pocz^.imie);
  454.       writeln('Nazwisko: ',pocz^.nazwisko);
  455.       writeln('Wiek: ',pocz^.wiek);
  456.       writeln('PESEL: ',pocz^.PESEL);
  457.       writeln('---------------------');
  458.       pocz:=pocz^.nast;
  459.     end;
  460.   until pocz=nil;
  461.   writeln('Nacisnij ENTER, aby kontynuowac...');
  462.   readln;
  463. end;
  464.  
  465. procedure wyswietlPlik();
  466. var
  467.   txtFile:textfile;
  468.   znak:char;
  469.   nameFile:string;
  470. begin
  471.   nameFile:='lista.txt';
  472.   if FileExists(nameFile) then
  473.   begin
  474.     assignfile(txtFile,nameFile);
  475.     reset(txtFile);
  476.     while not eof(txtFile) do
  477.     begin
  478.       read(txtFile,znak);
  479.       write(znak);
  480.     end;
  481.     closefile(txtFile);
  482.   end
  483.   else writeln('Brak podanego pliku! Uzyj jednego z punktow MENU aby go stworzyc.');
  484.   writeln('Nacisnij ENTER, aby kontynuowac...');
  485.   readln;
  486. end;
  487.  
  488. begin
  489.   pocz:=nil;
  490.   repeat
  491.     clrscr;
  492.     writeln('[1] Dodaj element do listy dwukierunkowej');
  493.     writeln('[2] Usun z listy pierwszy element o podanej wartosci klucza');
  494.     writeln('[3] Usun z listy wszystkie elementy o podanej wartosci klucza');
  495.     writeln('[4] Edytuj wybrany element listy dwukierunkowej');
  496.     writeln('[5] Zapisz do pliku tekstowego elementy listy dwukierunkowej');
  497.     writeln('[6] Wyswietl zawartosc listy dwukierunkowej na ekran');
  498.     writeln('[7] Wyswietl zawartosc wczesniej utworzonego pliku tekstowego na ekran');
  499.     writeln;
  500.     writeln('Wybierz co mam zrobic lub wpisz [0] aby wyjsc...');
  501.     readln(numer);
  502.     writeln('---------------------');
  503.     case numer of
  504.     1: dodaj(pocz);
  505.     2: usun(pocz);
  506.     3: usunWszystko(pocz);
  507.     4: edytuj(pocz);
  508.     5: zapiszDoPliku(pocz);
  509.     6: wyswietl(pocz);
  510.     7: wyswietlPlik();
  511.     end;
  512.   until (numer=0);
  513. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!