Uchovávanie telefónych èísel v databáze, pascal
Delphi & Pascal (èeská wiki)
Kategorija: Programy zos Pascalu
Program: Telefon.pas
Subor exe: Telefon.exe
Subor ubuntu: Telefon
Program: Telefon.pasSubor 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.
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.