program Baza_prac; uses Crt, Dos, Printer; const n_max = 1000; type jezyki = array[1..4] of string[15]; jedna_linia = string[80]; etykieta = string; numer_telefonu = string[11]; { numery telefon¢w s¥ dziewi©cio cyfrowe, ale cz©sto je si© podaje w sekwencji trzy cyfrowej np. nr 555666777 -> 555 666 777 } 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: numer_telefonu 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; i,n,srodek,min,max: integer; nazwy_kolumn: etykieta; 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; function Poprawny_numer(telef: numer_telefonu): boolean; var cyfra,ilosc: integer; begin ilosc := 0; Poprawny_numer := false; for cyfra := 1 to length(telef) do if (telef[cyfra] in ['0'..'9']) or (telef[cyfra] = ' ') then if telef[cyfra] <> ' ' then if telef[cyfra] in ['0'..'9'] then ilosc := ilosc + 1 else break; if ilosc = 9 then Poprawny_numer := true end; function Poprawna_data(d,m,r: integer): boolean; var skrocony_rok,wiek: integer; begin Poprawna_data := false; skrocony_rok := r mod 100; wiek := r div 100; if (d in [1..31]) and (m in [1..12]) and (((wiek = 19) and (skrocony_rok in [50..99])) or ((wiek = 20) and (skrocony_rok in [0,1]))) then if ((m = 1) and (d in [1..31])) or ((m = 2) and (d in [1..29])) or ((m = 3) and (d in [1..31])) or ((m = 5) and (d in [1..31])) or ((m = 7) and (d in [1..31])) or ((m = 8) and (d in [1..31])) or ((m = 10) and (d in [1..31])) or ((m = 12) and (d in [1..31])) or ((m <> 2) and (d in [1..30])) then Poprawna_data := true 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]); repeat Czytaj_liczbe('Podaj dzieä urodzenia',dzien); Czytaj_liczbe('Podaj miesi¥c urodzenia',miesiac); Czytaj_liczbe('Podaj rok urodzenia',rok) until Poprawna_data(dzien,miesiac,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); repeat writeln('Podaj numer telefonu w postaci "XXX XXX XXX","XXXXXXXXX" lub "XXX XXXXXX"'); { W przypadku je˜li nie posiadasz telefonu wpisz - 000 000 000. } readln(telefon) until Poprawny_numer(telefon); writeln('j©zyk pierwszy: '); readln(obce[1]); if obce[1] <> '' then begin writeln('j©zyk drugi: '); readln(obce[2]); if obce[2] <> '' then begin writeln('j©zyk trzeci: '); readln(obce[3]); if obce[3] <> '' then begin writeln('j©zyk czwarty: '); readln(obce[4]) end end end; writeln('Podaj wyksztaˆcenie:'); readln(wyksztalcenie); writeln('Podaj stanowisko:'); readln(stanowisko); end; Menu end; procedure Wyswietl(prac: pracownik); { Procedura wyswietlania informacji o jednym pracowniku } var j: integer; 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); write('Numer telefonu : '); if length(telefon) <= 10 then for j := 1 to length(telefon) do begin if length(telefon) = 9 then if ((j = 3) or (j = 6)) then write(telefon[j],' ') else write(telefon[j]) else if j = 7 then write(telefon[j],' ') else write(telefon[j]) end else write(telefon); writeln; 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; function Prac_Info(pocz: integer; t: pracownik): jedna_linia; var s: string[4]; str_prac: string[80]; j,j1: integer; begin str_prac := ''; with t, nazw, poziom do begin str(pocz,s); str_prac := ' '+s; for j := 1 to 5 - (length(s) - 1) do str_prac := str_prac + ' '; str_prac := str_prac + imiepier; for j := 1 to (length('Pierwsze imi©') + 2) - length(imiepier) do str_prac := str_prac + ' '; str_prac := str_prac + imiedrug; if imiedrug <> '' then begin for j := 1 to (length('Drugie imi©') + 2) - length(imiedrug) do str_prac := str_prac + ' '; str_prac := str_prac + nazwisko end else begin for j := 1 to length('Drugie imi©') + 2 do str_prac := str_prac + ' '; str_prac := str_prac + nazwisko end; if length(nazwisko) < length('Nazwisko') then begin if obce[1] <> '' then begin s := obce[1]; for j := 1 to (length('Nazwisko') - length(nazwisko)) + 9 do str_prac := str_prac + ' '; str_prac := str_prac + s end end else if obce[1] <> '' then begin s := obce[1]; for j := 1 to 9 - (length(nazwisko) - length('Nazwisko')) do str_prac := str_prac + ' '; str_prac := str_prac + s end; for j1 := 2 to 4 do if obce[j1] <> '' then begin s := obce[j1]; for j := 1 to length(s) - 1 do str_prac := str_prac + ' '; str_prac := str_prac + s end end; Prac_Info := str_prac end; procedure Napisy_Do_Jezykow(a,lp: integer; var ety: etykieta); begin ClrScr; writeln('Strzaˆka w g¢r©, strzaˆka w d¢ˆ - przewijanie'); writeln('ESC - powr¢t do funkcji'); 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; ety := ' 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; ety := ' Lp Pierwsze imi© Drugie imi© Nazwisko Lista j©zykow obcych:'; writeln end else if a = 1 then begin writeln; writeln(' Pracownicy znaj¥cy jeden j©zyk obcy - Liczba pracownik¢w: ',lp); writeln; ety := ' 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; ety := ' 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 nazwy_kolumn := ''; Napisy_Do_Jezykow(a,lp,nazwy_kolumn); writeln(nazwy_kolumn); writeln; for numer := j to c do writeln(Prac_Info(numer,dane[tab_rek[numer]]^)); writeln; writeln('D - drukowanie'); klawisz := readkey; if klawisz = 'D' then begin writeln(lst,nazwy_kolumn); writeln; for numer := j to c do writeln(lst,Prac_Info(numer,dane[tab_rek[numer]]^)) end; if (ord(klawisz) = 80) and (c < lp) then { klawisz strzaˆka w d¢ˆ } if c + 5 > lp then begin j := c + 1; c := c + (lp mod 5) end else begin j := j + 5; c := c + 5 end else if (ord(klawisz) = 72) and (j > 1) then { klawisz strzaˆka w g¢r© } if c mod 5 <> 0 then begin c := c - (c mod 5); j := c - 4 end else begin c := c - 5; j := c - 4 end until (klawisz = chr(27)) or (klawisz = chr(87)) end else begin repeat Napisy_Do_Jezykow(a,lp,nazwy_kolumn); writeln(nazwy_kolumn); writeln; for numer := 1 to lp do writeln(Prac_Info(numer,dane[tab_rek[numer]]^)); writeln; writeln('D - drukowanie'); writeln; klawisz := readkey; if klawisz = 'D' then begin writeln(lst,nazwy_kolumn); writeln; for numer := 1 to lp do writeln(lst,Prac_Info(numer,dane[tab_rek[numer]]^)) end until (klawisz = chr(27)) or (klawisz = chr(87)) 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 begin Czytaj_liczbe('Podaj numer',numer); end; 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 repeat writeln('Podaj numer telefonu w postaci "XXX XXX XXX","XXXXXXXXX" lub "XXX XXXXXX"'); { W przypadku je˜li nie posiadasz telefonu wpisz - 000 000 000. } readln(telefon) until Poprawny_numer(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; { Funkcja zawieraj¥ca algorytm wyszukwania binarnego, uwzgl©dniaj¥ca powtarzanie si© danych, bo przecie¾ mo¾e by† dw¢ch Kowalskich, lub Nowak¢w :). } 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; { W przypadku, gdy powtarza si© imie i nazwisko np. gdy jest dw¢ch Tomk¢w Kowalskich, to program prosi, o podanie daty urodzenia jednego z nich :). } 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); { Procedura wstawiania nowego pracownika we wˆa˜ciwe miejsce - po nazwisku, po imieniu gdy nazwiska si© powtarzaj¥, po roku urodzenia gdy imiona i nazwiska s¥ takie same, po miesi¥cu urodzenia, gdy powy¾sze dane si© powtarzaj¥ tak samo po dniu urodzenia jak i po miejscowo˜ci urodzenia. } 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 danych osobowych. } 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 { W przypadku zmiany nazwiska nast©puje przeniesienie tego pracownika we wˆa˜ciwe miejsce. } 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.