Uchovávanie telefónych èísel v databáze, pascal

Delphi & Pascal (èeská wiki)
Pøejít na: navigace, hledání
Kategorija: Programy zos Pascalu
telefon.pngProgram: Telefon.pas
Subor exe: Telefon.exe
Subor ubuntu: Telefon

Jedno zo zaujímavých zadaní. Tvári sa veµmi dôle¾ito, ale je to pa¹kvil. Chybou programu je statické alokovanie pamäte. To sa v takomto programe nerobí, lebo kto to spraví ten si koleduje o problémy. Nepriehµadnite triedenie mien klasickou bublinkovou metódou. Ak nieèo potrebujete zotriedi» a nemusí to by» rýchle, tak pou¾ite Bubble sort.

Triedením som sa dlho zaoberal a nejaké nápady nájdete v C zdrojákoch.
{ TELEFON.PAS               Copyright (c) TrSek alias Zdeno Sekerak }
{ Program na uchovavanie telefonnych cisel a simulovanie funkcii    }
{ databazy. Obsahuje uzivatelske prostredie. Data vsak neuchovava   }
{ v ziadnom subore.                                                 }
{                                                                   }
{ Datum:02.06.1994                             http://www.trsek.com }
 
program zadanie_telefonny_zoznam;
uses crt,dos;
const poc=100;potel=6;
      text:array[1..5] of string=
      ('  Vstup udajov  ',
       '  Vyhladavanie  ',
       '  Zmena udajov  ',
       '  Vypis zoznamu ',
       '  Koniec (ESC)  ');
       text1:array[1..5] of string=
       ('  mena              ',
        '  priezviska        ',
        '  mena a priezviska ',
        '  adresy            ',
        '  Spat do menu      ');
 
 
type zaz=record
     meno      :string[10];
     priezvisko:string[20];
     adresa    :string[30];
     telefon   :string[potel];
     end;
 
var zoznam:array[1..poc] of zaz;
    pomocna:zaz;
    i,i2,zpoc,p,min,max:integer;
    s,meno,meno2:string;
    ok:boolean;
    ch:char;
 
function upcase_s(meno:string):string;
var     i:integer;
    pmeno:string;
begin
 pmeno:='';
 for i:=1 to length(meno) do pmeno:=pmeno+UpCase(meno[i]);
 upcase_s:=pmeno;
end;
 
procedure farba(x,y:byte);
 begin textbackground(x);
       textcolor(y);
 end;
 
procedure open_win(xl,yl,xp,yp:integer;text:string;color:integer);
 var i,xs,ys:integer;
    p:real;
 begin
  window(xl,yl,xp,yp);
  p:=(yp-yl)/(xp-xl);
  xs:=round((xp-xl)/2)+xl;
  ys:=round((yp-yl)/2)+yl-1;
  textbackground(color);
  for i:=1 to round((xp-xl)/2) do begin
   window(xs-i,ys-round(i*p-0.6),xs+i,ys+round(i*p));
   clrscr;
   delay(8);
   end;
  window(1,1,80,24);
  for i:=xl to xp do begin
   gotoxy(i,yl);write('Í');end;
  gotoxy(xp,yl);write('»');
  for i:=yl+1 to yp do begin
   gotoxy(xp,i);write('º');end;
  gotoxy(xp,yp);write('¼');
  for i:=xp-1 downto xl do begin
   gotoxy(i,yp);write('Í');end;
  gotoxy(xl,yp);write('È');
  for i:=yp-1 downto yl do begin
   gotoxy(xl,i);write('º');end;
  gotoxy(xl,yl);write('É');
  if text<>'' then begin
     gotoxy(xs-(length(text) div 2),yl);write(' ',text,' ');end;
  window(xl+1,yl+1,xp-1,yp-1);
end;
 
function tread(x,y:integer;d:byte;s:string):string;
  var s1,s2,sz:string;
     st:char;
     x1,i,ins:integer;
     label tam;
   begin
   x1:=x;farba(15,0);ins:=1;
   s:=copy(s,1,d);
   if length(s)<d then for i:=length(s) to d-1 do s:=s+' ';
   gotoxy(x,y);write(s);sz:=s;
   if (x>0) and (x<81) and (y>0) and (y<25) and(x+d<81) then
                              begin
                              gotoxy(x,y);
                              repeat
                              st:=readkey;
         if (st=#27) or (st=#8) or (st=#0) or (st=#13) then
                  begin if st=#0 then
                           begin st:=readkey;
                              if st=#75  then x1:=x1-1;
                              if st=#77  then x1:=x1+1;
                              if st=#71 then x1:=x;
                              if st=#79 then begin i:=d+1;x1:=x+d;
                                                        repeat
                                                          i:=i-1;
                                                          s1:=copy(s,i,1);
                                                          if (s1=' ') then x1:=x+i-1;
                                                        until  (i=0) or (not(s1=' '));
                                             end;
                            end;
                        if st=#27 then begin gotoxy(x,y);write(sz);tread:=sz;exit;end;
                        if st=#8  then begin s1:=copy(s,1,x1-x-1);
                                             s2:=copy(s,x1-x+1,d-x1+x);
                                             s:=s1+s2+' ';
                                             x1:=x1-1;
                                       end;
                        if st=#83 then begin s1:=copy(s,1,x1-x);
                                             s2:=copy(s,x1-x+2,d-x1+x);
                                             s:=s1+s2+' ';
                                       end;
                        if st=#82 then begin if ins=2 then ins:=1
                                                      else ins:=2;
                                       end;
                  end
                  else begin
                             s1:=copy(s,1,x1-x);
                             s2:=copy(s,x1+ins-x,d-x1+x);
                             s:=s1+copy(st,1,1)+s2;
                             s:=copy(s,1,d);
                             x1:=x1+1;if (x1>x+d) then x1:=x+d;
                      end;
        if x1<x then x1:=x;
        if x1>x+d then x1:=x+d;
        s:=copy(s,1,d);
        gotoxy(x,y);writeln(s);gotoxy(x1,y);
     until st=#13;
    while pos(' ',s)>0 do delete(s,pos(' ',s),1);
    tread:=s;farba(0,15);
    end;
    textbackground(blue);textcolor(yellow);writeln;
 end;
 
procedure zamen(x,y:integer);
begin
 pomocna.meno:=zoznam[x].meno;
 zoznam[x].meno:=zoznam[y].meno;
 zoznam[y].meno:=pomocna.meno;
 
 pomocna.priezvisko:=zoznam[x].priezvisko;
 zoznam[x].priezvisko:=zoznam[y].priezvisko;
 zoznam[y].priezvisko:=pomocna.priezvisko;
 
 pomocna.adresa:=zoznam[x].adresa;
 zoznam[x].adresa:=zoznam[y].adresa;
 zoznam[y].adresa:=pomocna.adresa;
 
 pomocna.telefon:=zoznam[x].telefon;
 zoznam[x].telefon:=zoznam[y].telefon;
 zoznam[y].telefon:=pomocna.telefon;
end;
 
procedure tclrscr;
var i:integer;
begin
 for i:=1 to 24 do writeln;
 gotoxy(1,1);
end;
 
begin
 s:=' ';zpoc:=0;
 repeat
  window(1,1,80,25);
  textbackground(black);
  textcolor(yellow);
  clrscr;
  open_win(15,5,65,18,'Hlavne menu',blue);
  textbackground(blue);
  clrscr;
  writeln;
  writeln('      T E L E F O N N Y     Z O Z N A M  ');
  writeln('      ----------------------------------');
  writeln('      Definovanych ',zpoc,' ucastnikov.');
  writeln('      ----------------------------------');
  for i:=1 to 5 do begin
      gotoxy(7,i+5);write(text[i]);end;
  writeln;
  writeln('      -----------------');
  i:=1;
  textbackground(7);gotoxy(7,i+5);write(text[i]);
  repeat
   ch:=readkey;
   if ch=#27 then begin i:=5;ch:=#13;end;
   if ch=#0 then begin
      ch:=readkey;
      if ch=#80 then begin
          textbackground(1);gotoxy(7,i+5);write(text[i]);
          i:=i+1;if i>5 then i:=1;
          textbackground(7);gotoxy(7,i+5);write(text[i]);
          end;
      if ch=#72 then begin
          textbackground(1);gotoxy(7,i+5);write(text[i]);
          i:=i-1;if i<1 then i:=5;
          textbackground(7);gotoxy(7,i+5);write(text[i]);
          end;
       end;
  until (ch=#13);
  if i=5 then begin
    textbackground(blue);open_win(1,2,80,23,'',blue);clrscr;
    gotoxy(19,10);
    write  (' Naozaj chces skoncit ??? [A/..]: ');ch:=readkey;
    if (ch in ['a','A']) then i:=5
                         else i:=0;
    end;
  case i of
   1:begin
       textbackground(blue);open_win(1,2,80,23,'',blue);clrscr;
       repeat
        clrscr;zpoc:=zpoc+1;
        if zpoc>poc then begin
           zpoc:=poc;
           writeln('Viac udajov uz nemozem natlacit do pamete, predefinuj konstantu poc.');
           readln;
           end
        else begin
         writeln;
         writeln('       1.Vstup udajov');
         writeln('       --------------');
         writeln('       Maximalny pocet je:',poc,' . Zatial je ',zpoc-1,' zadefinovanych.');
         writeln('       -----------------------------------------------------------');
         write  ('       Zadaj meno:');zoznam[zpoc].meno:=tread(wherex,wherey,10,'');
         write  ('       priezvisko:');zoznam[zpoc].priezvisko:=tread(wherex,wherey,20,'');
         write  ('           adresu:');zoznam[zpoc].adresa:=tread(wherex,wherey,30,'');
         repeat
          ok:=true;
          for i:=1 to potel do zoznam[zpoc].telefon[i]:=' ';
          write  ('          telefon:');readln(zoznam[zpoc].telefon);
          for i:=1 to potel do
            if not(zoznam[zpoc].telefon[i] in ['0'..'9',' ','/']) then ok:=false;
          if not(ok) then writeln('       Zle zadanne telefonne cislo.');
         until ok;
        end;
       writeln;
       writeln('        Definovat dalsieho.  [../N]:');
       ch:=readkey;
       until (ch in ['n','N']);
       end;
   2:begin
       repeat
        window(1,1,80,25);
        textbackground(black);
        clrscr;
        open_win(15,5,65,18,'Menu hladaj',blue);
        textbackground(blue);
        clrscr;
        writeln;
        writeln('      Vyhladavanie podla');
        writeln('      ------------------');
        for i2:=1 to 5 do begin
           gotoxy(7,i2+3);write(text1[i2]);end;
        writeln;
        writeln('      ------------------');
           i2:=1;
           textbackground(7);gotoxy(7,i2+3);write(text1[i2]);
           repeat
            ch:=readkey;
            if ch=#0 then begin
               ch:=readkey;
               if ch=#80 then begin
                  textbackground(1);gotoxy(7,i2+3);write(text1[i2]);
                  i2:=i2+1;if i2>5 then i2:=1;
                  textbackground(7);gotoxy(7,i2+3);write(text1[i2]);
               end;
               if ch=#72 then begin
                  textbackground(1);gotoxy(7,i2+3);write(text1[i2]);
                  i2:=i2-1;if i2<1 then i2:=5;
                  textbackground(7);gotoxy(7,i2+3);write(text1[i2]);
                  end;
               end;
            until (ch=#13);
        if i2<>5 then begin
        textbackground(blue);open_win(1,3,80,22,'',blue);clrscr;end;
        case i2 of
         1:begin
           write('       Zadaj meno:');meno:=tread(wherex,wherey,10,'');
           write('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
           write('³ Meno     ³ Priezvisko         ³ Adresa                       ³ Tel. cislo  ³');
           write('ÃÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
           for i:=1 to zpoc do
             if upcase_s(meno)=upcase_s(zoznam[i].meno) then
               write('³',zoznam[i].meno:10,'³',zoznam[i].priezvisko:20,'³',zoznam[i].adresa:30,'³',zoznam[i].telefon:13,'³');
           write('ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
           readln;
           end;
         2:begin
           write('       Zadaj priezvisko:');meno:=tread(wherex,wherey,20,'');
           write('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
           write('³ Meno     ³ Priezvisko         ³ Adresa                       ³ Tel. cislo  ³');
           write('ÃÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
           for i:=1 to zpoc do
             if upcase_s(meno)=upcase_s(zoznam[i].priezvisko) then
               write('³',zoznam[i].meno:10,'³',zoznam[i].priezvisko:20,'³',zoznam[i].adresa:30,'³',zoznam[i].telefon:13,'³');
           write('ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
           readln;
           end;
         3:begin
           write('       Zadaj meno:');meno:=tread(wherex,wherey,10,'');
           write('       priezvisko:');meno2:=tread(wherex,wherey,20,'');
           write('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
           write('³ Meno     ³ Priezvisko         ³ Adresa                       ³ Tel. cislo  ³');
           write('ÃÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
           for i:=1 to zpoc do
             if (upcase_s(meno)=upcase_s(zoznam[i].meno)) and
                (upcase_s(meno2)=upcase_s(zoznam[i].priezvisko)) then
               write('³',zoznam[i].meno:10,'³',zoznam[i].priezvisko:20,'³',zoznam[i].adresa:30,'³',zoznam[i].telefon:13,'³');
           write('ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
           readln;
           end;
         4:begin
           write('       Zadaj adresu:');meno:=tread(wherex,wherey,30,'');
           write('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
           write('³ Meno     ³ Priezvisko         ³ Adresa                       ³ Tel. cislo  ³');
           write('ÃÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
           for i:=1 to zpoc do
             if upcase_s(meno)=upcase_s(zoznam[i].adresa) then
               write('³',zoznam[i].meno:10,'³',zoznam[i].priezvisko:20,'³',zoznam[i].adresa:30,'³',zoznam[i].telefon:13,'³');
           write('ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
           readln;
           end;
         end;
       until (i2=5);
       end;
   3:begin
       textbackground(blue);open_win(1,2,80,23,'Zmena',blue);clrscr;
       repeat
         clrscr;
         writeln;
         writeln('       Zmena udajov');
         writeln('       ------------');
         write  ('       Zadaj meno:');pomocna.meno:=tread(wherex,wherey,10,'');
         write  ('       priezvisko:');pomocna.priezvisko:=tread(wherex,wherey,20,'');
         write  ('           adresu:');pomocna.adresa:=tread(wherex,wherey,30,'');
         repeat
          ok:=true;
          for i:=1 to potel do pomocna.telefon[i]:=' ';
          write  ('          telefon:');readln(pomocna.telefon);
          for i:=1 to potel do
            if not(pomocna.telefon[i] in ['0'..'9',' ','/']) then ok:=false;
          if not(ok) then writeln('       Zle zadanne telefonne cislo.');
         until ok;
         ok:=false;
         for i:=1 to zpoc do
           if (upcase_s(pomocna.meno)=upcase_s(zoznam[i].meno)) and
              (upcase_s(pomocna.priezvisko)=upcase_s(zoznam[i].priezvisko)) then begin
              write('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
              write('³',zoznam[i].meno:10,'³',zoznam[i].priezvisko:20,'³',zoznam[i].adresa:30,'³',zoznam[i].telefon:13,'³');
              write('ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
              writeln('       Zmenit tohto ucastnika ???  [A/..]:');ch:=readkey;
              if (ch in ['a','A']) then begin
                 ok:=true;
                 zoznam[i].adresa :=pomocna.adresa;
                 zoznam[i].telefon:=pomocna.telefon;end;
              end;
          if (not(ok) and (zpoc<poc)) then begin
              writeln('       Takyto ucastnik neexistuje. Mam ho zaradit ???  ../N:');
              ch:=readkey;;
              if not(ch in ['n','N']) then begin
                 zpoc:=zpoc+1;
                 zoznam[zpoc].meno      :=pomocna.meno;
                 zoznam[zpoc].priezvisko:=pomocna.priezvisko;
                 zoznam[zpoc].adresa    :=pomocna.adresa;
                 zoznam[zpoc].telefon   :=pomocna.telefon;end;
              end;
        writeln('       Chces previest dalsiu zmenu [../N]:');ch:=readkey;
       until (ch in ['n','N']);
       end;
   4:begin
        textbackground(blue);window(1,1,80,25);clrscr;
        if zpoc>0 then begin
        writeln('Prebieha triedenie zoznamu udajov.');
        write  ('Prechod zoznamom:   0');
        p:=0;      {*** Usporiadava podla mena a priezviska ***}
        repeat
         ok:=true;
         for i:=1 to zpoc-1 do
          if (zoznam[i].priezvisko>zoznam[i+1].priezvisko) then begin
             zamen(i,i+1);
             ok:=false;end;
         for i:=zpoc downto 2 do
          if (zoznam[i].priezvisko<zoznam[i-1].priezvisko) then begin
             zamen(i-1,i);
             ok:=false;end;
         p:=p+1;write(chr(8)+chr(8)+chr(8),p:3);
        until ok;
        window(1,1,80,25);clrscr;
        writeln;
        writeln('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
        writeln('³ Meno     ³ Priezvisko         ³ Adresa                       ³ Telefonne cis³');
        writeln('ÃÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
        for i:=1 to zpoc do begin
         writeln('³',zoznam[i].meno:10,'³',zoznam[i].priezvisko:20,'³',zoznam[i].adresa:30,'³',zoznam[i].telefon:14,'³');
         if (i mod 20)=0 then begin
            write('Stlac Enter pre dalsi vypis ....');readln;
            gotoxy(1,wherey-1);delline;end;
         end;
        writeln('ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
        write('Stlac Enter ....');readln;
       end;
      end;
   end;
 until (i=5);
 window(1,1,80,25);
 textbackground(black);
 textcolor(white);
 clrscr;
end.