program Baza_prac; uses Crt, Dos; { doˆ¥czenie moduˆu Crt oraz Dos } const n_max = 1000; type jezyki = array[1..4] of string[15]; ident = record imiepier, imiedrug, nazwisko: string[20] end; data = record dzien, miesiac, rok: integer; miejsce: string[20] end; adresprac = record kod: string[8]; miejscowosc, ulica: string[30]; numer: integer; mieszkanie: string; { Nie ka¾dy mieszka w bloku, niekt¢rzy mieszkaj¥ w domach :). } telefon: string[11] { Uwzgl©dnia numery - 500 003 001, 500 000 700 - je˜li takie s¥ :). } end; poziomprac = record wyksztalcenie, stanowisko: string[30]; obce: jezyki end; pracownik = record nazw: ident; urodz: data; adres: adresprac; poziom: poziomprac end; wskprac = ^pracownik; tab_prac = array[1..n_max] of wskprac; var dane: tab_prac; baza: file of pracownik; tab_jez: jezyki; nowy: wskprac; koniec: boolean; n,srodek,min,max: integer; i: integer; klawisz: char; function Menu: integer; { Funkcja tworzenia menu systemu } begin ClrScr; Writeln; Writeln('Menu gˆ¢wne programu':50); Writeln('Instrukcja obsˆugi programu:':55); Writeln; Writeln('1 - wy˜wietlanie informacji o wszystkich pracownikach':66); Writeln('2 - wprowadzanie informacji o jednym pracowniku':60); Writeln('3 - znajdowanie pracownik¢w po nazwisku':52); Writeln('4 - ilo˜† znanych j©zyk¢w przez pracownik¢w':56); Writeln('0 lub ESC - Wyj˜cie z systemu':42); Writeln; Writeln('Podaj liczb© z zakresu od 0 do 4 lub naci˜nij klawisz ESC':70); end; function Wynik_Fun: integer; var znak: char; begin repeat znak := readkey; if znak = chr(27) then Wynik_Fun := 0 else if znak in ['0'..'4'] then Wynik_Fun := ord(znak) - 48 until znak in ['0'..'4',chr(27)] end; procedure Czytaj_liczbe(tekst: string; var liczba: integer); begin repeat writeln(tekst); readln(liczba); until IoResult = 0 end; procedure Czytaj(prac: wskprac); { Procedura wprowadzania informacji o jednym pracowniku} begin ClrScr; with prac^,nazw,urodz,adres,poziom do begin writeln('Podaj pierwsze imi©:'); readln(imiepier); imiepier[1] := UpCase(imiepier[1]); writeln('Podaj drugie imi©: '); readln(imiedrug); imiedrug[1] := UpCase(imiedrug[1]); writeln('Podaj nazwisko: '); readln(nazwisko); nazwisko[1] := UpCase(nazwisko[1]); Czytaj_liczbe('Podaj dzieä urodzenia',dzien); Czytaj_liczbe('Podaj miesi¥c urodzenia',miesiac); Czytaj_liczbe('Podaj rok urodzenia',rok); writeln('Podaj miejsce urodzenia: '); readln(miejsce); miejsce[1] := UpCase(miejsce[1]); writeln('Podaj kod w postaci "XX - XXX"'); readln(kod); writeln('Podaj miejscowo˜†: '); readln(miejscowosc); writeln('Podaj ulic©: '); readln(ulica); Czytaj_liczbe('Podaj numer',numer); writeln('Podaj numer mieszkania'); readln(mieszkanie); writeln('Podaj numer telefonu w postaci "XXX XXX XXX"'); readln(telefon); writeln('j©zyk pierwszy: '); readln(obce[1]); writeln('j©zyk drugi: '); readln(obce[2]); writeln('j©zyk trzeci: '); readln(obce[3]); writeln('j©zyk czwarty: '); readln(obce[4]); writeln('Podaj wyksztaˆcenie:'); readln(wyksztalcenie); writeln('Podaj stanowisko:'); readln(stanowisko) end; Menu end; procedure Wyswietl(prac: pracownik); { Procedura wyswietlania informacji o jednym pracowniku } begin with prac,nazw,urodz,adres,poziom do begin writeln('Pierwsze imi© :',imiepier); writeln('Drugie imi© :',imiedrug); writeln('Nazwisko :',nazwisko); writeln; writeln('Miejsce urodzenia: ',miejsce); writeln('Data urodzenia :',dzien,'/',miesiac,'/',rok); writeln; writeln('Miejscowo˜† zamieszkania: ',miejscowosc); writeln('Kod :',kod); writeln('Ulica :',ulica); writeln('Numer :',numer); writeln('Numer mieszkania : ',mieszkanie); writeln('Numer telefonu : ',telefon); writeln(' j©zyk 1 : ',obce[1]); writeln(' j©zyk 2 : ',obce[2]); writeln(' j©zyk 3 : ',obce[3]); writeln(' j©zyk 4 : ',obce[4]); writeln; writeln('Wyksztaˆcenie: ',wyksztalcenie); writeln('Stanowisko: ',stanowisko); writeln end end; procedure Przewijanie(pocz: integer; t: pracownik); var s: string[4]; begin with t, nazw, poziom do begin str(pocz,s); write(' ',pocz); write(imiepier:4-(length(s)-1)+length(imiepier)); write(imiedrug:16-(length(imiepier)+1)+length(imiedrug)); if length(imiepier) < length('Nazwisko') then write(nazwisko:25-abs(length('Nazwisko')-length(imiepier)) -(length(imiepier)+1+length(imiedrug)+1+2)+length(nazwisko)) else write(nazwisko:25+abs(length('Nazwisko')-length(imiepier)) -(length(imiepier)+1+length(imiedrug)+1+2)+ length(nazwisko)); if length(nazwisko) < length('Nazwisko') then begin if obce[1] <> chr(13) then begin s := obce[1]; write(s:10+abs(length('Nazwisko')-length(nazwisko))+length(s)) end end else if obce[1] <> '' then begin s := obce[1]; write(s:10-abs(length('Nazwisko')-length(nazwisko))+length(s)) end; if obce[2] <> '' then begin s := obce[2]; write(s:3+length(s)) end; if obce[3] <> '' then begin s := obce[3]; write(s:3+length(s)) end; if obce[4] <> '' then begin s := obce[4]; write(s:3+length(s)) end end; writeln end; procedure Napisy_Do_Jezykow(a,lp: integer); begin ClrScr; writeln('Strzaˆka w g¢r©, strzaˆka w d¢ˆ - przewijanie'); if lp > 5 then writeln('ESC - powr¢t do funkcji') else writeln('ESC - powr¢t do funkcji lub dowolny klawisz'); writeln('W - wyj˜cie z funkcji powr¢t do gˆ¢wnego Menu'); if a = 0 then begin writeln; writeln(' Pracownicy nieznaj¥cy j©zyk¢w obcych - Liczba pracownik¢w: ',lp); writeln; writeln(' Lp Pierwsze imi© Drugie imi© Nazwisko'); writeln end else if a > 0 then if a = 3 then begin writeln; writeln(' Pracownicy znaj¥cy trzy lub wi©cej j©zyk¢w obcych - Liczba pracownik¢w: ',lp); writeln; writeln(' Lp Pierwsze imi© Drugie imi© Nazwisko Lista j©zyk¢w obcych:'); writeln end else if a = 1 then begin writeln; writeln(' Pracownicy znaj¥cy jeden j©zyk obcy - Liczba pracownik¢w: ',lp); writeln; writeln(' Lp Pierwsze imi© Drugie imi© Nazwisko J©zyk obcy:'); writeln end else if a < 3 then begin writeln; writeln(' Pracownicy znaj¥cy dwa j©zyki obce - Liczba pracownik¢w: ',lp); writeln; writeln(' Lp Pierwsze imi© Drugie imi© Nazwisko Lista j©zyk¢w obcych:'); writeln end end; procedure Znajomosc_Jezykow; {Procedura wyszukiwania ilo˜ci jezyk¢w znanych przez pracownik¢w } var tab_rek: array[1..n_max] of integer; a,j,l,lp,numer,c: integer; znaleziono: boolean; s: string[4]; begin ClrScr; writeln('-1 - Wyj˜cie z funkcji, powr¢t do gˆ¢wnego menu'); writeln('0 - Pracownicy nieznaj¥cy j©zyk¢w obcych'); writeln('1 - Pracownicy znaj¥cy jeden j©zyk obcy'); writeln('2 - Pracownicy znaj¥cy dwa j©zyki obce'); writeln('3 - Pracownicy znaj¥cy trzy lub wi©cej j©zyk¢w obcych'); readln(a); if a = -1 then begin klawisz := chr(87); exit end; if (a < -1) or (a > 3) then begin writeln('Podana liczba jest poza zakresu -1 - 3'); writeln('Dowolny klawisz - Kontynuacja, W - Wyj˜cie z funkcji'); end; znaleziono := false; lp := 0; for j := 1 to n do begin l := 0; if dane[j]^.poziom.obce[1] <> '' then l := l + 1; if dane[j]^.poziom.obce[2] <> '' then l := l + 1; if dane[j]^.poziom.obce[3] <> '' then l := l + 1; if dane[j]^.poziom.obce[4] <> '' then l := l + 1; if a = 3 then begin if l >= a then begin znaleziono := true; lp := lp + 1; tab_rek[lp] := j; end end else if a < 3 then if a > 0 then begin if a = l then begin znaleziono := true; lp := lp + 1; tab_rek[lp] := j; end end else if a = l then begin znaleziono := true; lp := lp + 1; tab_rek[lp] := j; end end; if znaleziono then begin if lp <= 5 then c := lp else c := 5; j := 1; if lp > 5 then begin repeat Napisy_Do_Jezykow(a,lp); for numer := j to c do Przewijanie(numer,dane[tab_rek[numer]]^); klawisz := readkey; if (ord(klawisz) = 80) and (c < lp) then { klawisz strzaˆka w d¢ˆ } if lp div c = 1 then begin j := c + 1; c := c + (lp mod c) end else begin j := j + 5; c := c + 5 end else if (ord(klawisz) = 72) and (lp >= c) and (j > 5) then { klawisz strzaˆka w g¢r© } if c mod 5 <> 0 then begin j := j - 5; c := c - (c mod 5) end else begin j := j - 5; c := c - 5 end until (klawisz = chr(27)) or (klawisz = chr(87)); end else begin Napisy_Do_Jezykow(a,lp); for numer := 1 to lp do Przewijanie(numer,dane[tab_rek[numer]]^); end end else if not ((a < -1) or (a > 3)) then begin writeln('Brak takich pracownik¢w'); writeln('Kontynuacja dowolny klawisz, W - Wyj˜cie z funkcji'); end end; function Aktualizuj_Dane(nr: integer): boolean; { Procedura aktualizuj¥ca dane pracownika } var a: char; nowe_nazwisko: string[20]; begin ClrScr; Aktualizuj_Dane := false; with dane[nr]^,nazw,urodz,adres,poziom do begin writeln('Czy chcesz zaktualizowa† nazwisko pracownika ? Naci˜nij (T).'); writeln('Je˜li nie naci˜nij inny dowolny klawisz.'); a := readkey; if a = 'T' then begin writeln('Podaj nazwisko: '); readln(nowe_nazwisko); nowe_nazwisko[1] := UpCase(nowe_nazwisko[1]); if nazwisko <> nowe_nazwisko then begin nazwisko := nowe_nazwisko; Aktualizuj_Dane := true end end; writeln('Czy chcesz zaktualizowa† adres zamszkania pracownika ? Naci˜nij (T).'); writeln('Je˜li nie naci˜nij inny dowolny klawisz.'); a := readkey; if a = 'T' then begin writeln('Czy chcesz zaktualizowa† kod pracownika ? Naci˜nij (T).'); writeln('Je˜li nie naci˜nij inny dowolny klawisz.'); a := readkey; if a = 'T' then begin writeln('Podaj kod w postaci "XX - XXX"'); readln(kod) end; writeln('Czy chcesz zaktualizowa† miejscowo˜† pracownika ? Naci˜nij (T).'); writeln('Je˜li nie naci˜nij inny dowolny klawisz.'); a := readkey; if a = 'T' then begin writeln('Podaj miejscowo˜†: '); readln(miejscowosc) end; writeln('Czy chcesz zaktualizowa† ulic© pracownika ? Naci˜nij (T).'); writeln('Je˜li nie naci˜nij inny dowolny klawisz.'); a := readkey; if a = 'T' then begin writeln('Podaj ulic©: '); readln(ulica) end; writeln('Czy chcesz zaktualizowa† numer pracownika ? Naci˜nij (T).'); writeln('Je˜li nie naci˜nij inny dowolny klawisz.'); a := readkey; if a = 'T' then Czytaj_liczbe('Podaj numer',numer); writeln('Czy chcesz zaktualizowa† numer mieszkania pracownika ? Naci˜nij (T).'); writeln('Je˜li nie naci˜nij inny dowolny klawisz.'); a := readkey; if a = 'T' then begin writeln('Podaj numer mieszkania'); readln(mieszkanie) end end; writeln('Czy chcesz zaktualizowa† numer telefonu pracownika ? Naci˜nij (T).'); writeln('Je˜li nie naci˜nij inny dowolny klawisz.'); a := readkey; if a = 'T' then begin writeln('Podaj numer telefonu w postaci "XXX XXX XXX"'); readln(telefon) end; writeln('Czy chcesz zaktualizowa† znajomo˜† pierwszego j©zyka ? Naci˜nij (T).'); writeln('Je˜li nie naci˜nij inny dowolny klawisz.'); a := readkey; if a = 'T' then begin writeln('pierwszy j©zyk obcy'); readln(obce[1]) end; writeln('Czy chcesz zaktualizowa† znajomo˜† drugiego j©zyka ? Naci˜nij (T).'); writeln('Je˜li nie naci˜nij inny dowolny klawisz.'); a := readkey; if a = 'T' then begin writeln('drugi j©zyk obcy'); readln(obce[2]) end; writeln('Czy chcesz zaktualizowa† znajomo˜† trzeciego j©zyka ? Naci˜nij (T).'); writeln('Je˜li nie naci˜nij inny dowolny klawisz.'); a := readkey; if a = 'T' then begin writeln('trzeci j©zyk obcy'); readln(obce[3]) end; writeln('Czy chcesz zaktualizowa† znajomo˜† czwartego j©zyka ? Naci˜nij (T).'); writeln('Je˜li nie naci˜nij inny dowolny klawisz.'); a := readkey; if a = 'T' then begin writeln('czwarty j©zyk obcy'); readln(obce[4]) end; writeln('Czy chcesz zaktualizowa† wyksztaˆcenie ? Naci˜nij (T).'); writeln('Je˜li nie naci˜nij inny dowolny klawisz.'); a := readkey; if a = 'T' then begin writeln('Podaj wyksztaˆcenie:'); readln(wyksztalcenie) end; writeln('Czy chcesz zaktualizowa† stanowisko ? Naci˜nij (T).'); writeln('Je˜li nie naci˜nij inny dowolny klawisz.'); a := readkey; if a = 'T' then begin writeln('Podaj stanowisko:'); readln(stanowisko) end end; writeln('Naci˜nij klawisz "ENTER"'); readln; end; function WB(t: tab_prac; p,k: integer; nazw_pracownika: string; pi_pl,dr_pl: boolean): boolean; var j: integer; znaleziono: boolean; begin znaleziono := false; WB := znaleziono; repeat j := (p + k) div 2; if t[j]^.nazw.nazwisko = nazw_pracownika then znaleziono := true else if t[j]^.nazw.nazwisko < nazw_pracownika then p := j + 1 else k := j - 1 until znaleziono or (k < p); if znaleziono then begin WB := znaleziono; if (max = 0) and (min = n) then srodek := j; if min > j then min := j; if pi_pl then if 1 < j then znaleziono := WB(t,1,j-1,nazw_pracownika,pi_pl,dr_pl); if j >= srodek then begin dr_pl := true; pi_pl := false end; if max < j then max := j; if dr_pl then if j < n then znaleziono := WB(t,j+1,n,nazw_pracownika,pi_pl,dr_pl); end end; function Spraw_daty_urodzenia(data_urodz: tab_prac; var p,k: integer; d,m,y: integer): boolean; var j: integer; zgodnosc: boolean; begin zgodnosc := false; Spraw_daty_urodzenia := zgodnosc; for j := p to k do begin if data_urodz[j]^.urodz.dzien = d then if data_urodz[j]^.urodz.miesiac = m then if data_urodz[j]^.urodz.rok = y then begin if zgodnosc = false then p := j; k := j; zgodnosc := true end end; Spraw_daty_urodzenia := zgodnosc end; procedure Wstaw(obecna_liczba: integer; nowyprac: wskprac); var j: integer; begin if obecna_liczba >= 1 then while ((obecna_liczba>=1) and ((dane[obecna_liczba]^.nazw.nazwisko > nowyprac^.nazw.nazwisko) or ((dane[obecna_liczba]^.nazw.imiepier > nowyprac^.nazw.imiepier) and (dane[obecna_liczba]^.nazw.nazwisko = nowyprac^.nazw.nazwisko)) or ((dane[obecna_liczba]^.urodz.rok > nowyprac^.urodz.rok) and (dane[obecna_liczba]^.nazw.imiepier = nowyprac^.nazw.imiepier) and (dane[obecna_liczba]^.nazw.nazwisko = nowyprac^.nazw.nazwisko)) or ((dane[obecna_liczba]^.urodz.miesiac > nowyprac^.urodz.miesiac) and (dane[obecna_liczba]^.urodz.rok = nowyprac^.urodz.rok) and (dane[obecna_liczba]^.nazw.imiepier = nowyprac^.nazw.imiepier) and (dane[obecna_liczba]^.nazw.nazwisko = nowyprac^.nazw.nazwisko)) or ((dane[obecna_liczba]^.urodz.dzien > nowyprac^.urodz.dzien) and (dane[obecna_liczba]^.urodz.miesiac = nowyprac^.urodz.miesiac) and (dane[obecna_liczba]^.urodz.rok = nowyprac^.urodz.rok) and (dane[obecna_liczba]^.nazw.imiepier = nowyprac^.nazw.imiepier) and (dane[obecna_liczba]^.nazw.nazwisko = nowyprac^.nazw.nazwisko)) or ((dane[obecna_liczba]^.urodz.miejsce > nowyprac^.urodz.miejsce) and (dane[obecna_liczba]^.urodz.dzien = nowyprac^.urodz.dzien) and (dane[obecna_liczba]^.urodz.miesiac = nowyprac^.urodz.miesiac) and (dane[obecna_liczba]^.urodz.rok = nowyprac^.urodz.rok) and (dane[obecna_liczba]^.nazw.imiepier = nowyprac^.nazw.imiepier) and (dane[obecna_liczba]^.nazw.nazwisko = nowyprac^.nazw.nazwisko)))) do obecna_liczba := obecna_liczba - 1; obecna_liczba := obecna_liczba+1; j := n + 1; if (n >= 1) and (obecna_liczba <= n) then begin for j := n downto obecna_liczba do dane[j + 1] := dane[j]; dane[j] := nowyprac end else dane[j] := nowyprac end; procedure Zapisz(n: integer); { Procedura zapisywania zawarto˜ci tablicy na dysk } var i: integer; begin assign(baza,'bazadysk'); rewrite(baza); i := 1; repeat write(baza,dane[i]^); i := i + 1 until i > n; close(baza) end; procedure Usun(indeks: integer); { Procedura usuwania pracownika z bazy danych } var i: integer; begin for i := indeks to n - 1 do begin dispose(dane[i]); dane[i] := nil; New(dane[i]); dane[i]^ := dane[i + 1]^ end; dispose(dane[n]); dane[n] := nil; n := n - 1 end; procedure Wyszukaj_Po_Nazwisku; { Procedura wyszukiwania pracownika po nazwisku } var nazwisko_pracownika: string[20]; j,p,k,dzie,mies,ro: integer; a,u: char; znaleziono: boolean; begin p := 1; k := n; srodek := 0; min := n; max := 0; znaleziono := false; writeln('Podaj nazwisko pracownika, kt¢rego dane chcesz wyszuka†'); readln(nazwisko_pracownika); nazwisko_pracownika[1] := UpCase(nazwisko_pracownika[1]); if WB(dane,p,k,nazwisko_pracownika,true,false) then begin if min < max then begin writeln('Podaj jego imi©'); readln(nazwisko_pracownika); nazwisko_pracownika[1] := UpCase(nazwisko_pracownika[1]); for j := min to max do if dane[j]^.nazw.imiepier = nazwisko_pracownika then begin p := j; znaleziono := true; for j := p to max do if dane[j]^.nazw.imiepier = nazwisko_pracownika then k := j; end else if (j = max) and (znaleziono = false) then begin writeln('Nie ma takiego pracownika o takim imieniu'); readln; end end else begin p := min; k := max; znaleziono := true end end else begin writeln('Nie ma takiego pracownika - naci˜nij klawisz ENTER'); readln; end; if (znaleziono) and (p < k) then begin writeln('Podaj dat© urodzenia pracownika'); writeln('dzieä miesi¥c rok'); readln(dzie,mies,ro); writeln(dzie,' ',mies,' ',ro); if Spraw_daty_urodzenia(dane,p,k,dzie,mies,ro) then begin if p < k then begin writeln('Podaj miejscowo˜† urodzenia pracownika'); readln(nazwisko_pracownika); nazwisko_pracownika[1] := UpCase(nazwisko_pracownika[1]); znaleziono := false; for j := p to k do if dane[j]^.urodz.miejsce = nazwisko_pracownika then begin if znaleziono = false then p := j; k := j; znaleziono := true end else if (j = k) and (znaleziono = false) then begin writeln('Nie ma takiego pracownika'); readln end end end else begin writeln('Nie ma takiego pracownika lub bˆ©dna zostaˆa podana data urodzenia'); readln; znaleziono := false end end; if znaleziono = true then while p <= k do begin ClrScr; Wyswietl(dane[p]^); writeln('Czy chcesz zaktualizowa† jego dane ? Je˜li tak naci˜nij - "T"'); a := readkey; if a = 'T' then begin if Aktualizuj_Dane(p) then begin New(nowy); nowy^ := dane[p]^; Usun(p); Wstaw(n,nowy); n := n + 1 end; writeln('Dane pracownika zostaˆy zaktualizowane'); writeln('Naci˜nij klawisz "ENTER"'); readln end else begin writeln('Czy chcesz go usun¥† ? Je˜li tak naci˜nij - "T"'); u := readkey; if u = 'T' then begin Usun(p); writeln('Pracownik ten zostaˆ usuni©ty'); writeln('Naci˜nij klawisz "ENTER"'); readln end end; if (a = 'T') or (u = 'T') then Zapisz(n); if u <> 'T' then p := p + 1 else k := k - 1 end; Menu end; procedure Odczytaj(var n: integer); { Procedura odczytywania zawarto˜ci pliku do tablicy } var i: integer; begin assign(baza,'bazadysk'); reset(baza); i := 0; while not eof(baza) do begin i := i + 1; New(dane[i]); read(baza,dane[i]^) end; close(baza); n := i end; procedure Wszyscy; { Procedura wy˜wietlania informacji o wszystkich pracownikach } var i: integer; begin for i := 1 to n do begin ClrScr; writeln('Numer pracownika: ',i); Wyswietl(dane[i]^); writeln('Dowolny klawisz - przej˜cie do nast©pnego'); writeln('W - powr¢t do gˆ¢wnego Menu'); klawisz := readkey; if klawisz = chr(87) then break end; Menu end; var info: SearchRec; wynik: integer; begin { Pocz¥tek programu } FindFirst('bazadysk',Archive,info); if DosError <> 18 then { je˜li plik istnieje } Odczytaj(n); { odczytanie zawarto˜ci pliku } koniec := false; ClrScr; Writeln('Program bazodanowy pracownik¢w firmy X':59); Writeln('aby przej˜† dalej naci˜nij ENTER':56); readln; Menu; repeat case Wynik_Fun of 1: Wszyscy; 2: if n < n_max then begin New(nowy); Czytaj(nowy); Wstaw(n,nowy); n := n + 1; Zapisz(n) end; 3: Wyszukaj_Po_Nazwisku; 4: begin repeat klawisz := ' '; Znajomosc_Jezykow; if klawisz <> chr(87) then if klawisz <> chr(27) then klawisz := readkey until klawisz = chr(87); Menu end; 0: koniec := true end; until koniec end.