Works with telephone numbers in database, pascal
Category: Source in Pascal
Program: Telefon.pasFile exe: Telefon.exe
File ubuntu: Telefon
It's a homework. The homework itself isn't so complicated as it looks like. Static allocation of the memory is what irritates me most. Nobody does it today, otherwise one could get into big troubles. I like the classification of the names using a typical "bubble" method. So if you need to have something sorted out and reliability and exactness, instead of rapidity, are the qualities you are looking for, this might be the program you need. Just have a look. I was engaged by the matter of classification for a longer time and some suggestions can be found in C source codes.
{ 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.