program Baza_prac; uses Crt, Dos; const n_max = 1000; stala = 7; { Maksymalna liczba pracownik¢w wy˜wietlana na ekranie monitora. } type jezyki = array[1..4] of string[15]; jedna_linia = string[80]; etykieta = string; ident = record imiepier, imiedrug, nazwisko: string end; data = record dzien, miesiac, rok: integer; miejsce: string end; adresprac = record kod: string; miejscowosc, ulica: string; numer: integer; mieszkanie, { Nie ka¾dy mieszka w bloku, niekt¢rzy mieszkaj¥ w domach :). } telefon: string; { W numrach telefn¢w wyst©puj¥ trzy zera jako sekwencja cyfr. } end; poziomprac = record wyksztalcenie, stanowisko: string; 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; podglad: text; 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: string): boolean; var cyfra,ilosc: integer; begin ilosc := 0; Poprawny_numer := false; for cyfra := 1 to length(telef) - 1 do if ((telef[1] in ['0'..'9']) or (telef[1] in ['*','+'])) and ((telef[cyfra + 1] in ['0'..'9']) and (cyfra >= 1)) then ilosc := ilosc + 1 else exit; if telef[length(telef)] in ['0'..'9'] then ilosc := ilosc + 1 else exit; if ((telef[1] in ['0'..'9']) and (ilosc >= 9)) or ((telef[1] in ['*'..'+']) and (ilosc > 1)) 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: XXXXXXXXX. Je˜li nie posiadasz naci˜nij klawisz ENTER.'); readln(telefon); if telefon = '' then telefon := 'Brak telefonu' until Poprawny_numer(telefon) or (telefon = 'Brak telefonu'); writeln('j©zyk pierwszy: '); obce[1] := ''; readln(obce[1]); if obce[1] <> '' then begin writeln('j©zyk drugi: '); obce[2] := ''; readln(obce[2]); if obce[2] <> '' then begin writeln('j©zyk trzeci: '); obce[3] := ''; readln(obce[3]); if obce[3] <> '' then begin writeln('j©zyk czwarty: '); obce[4] := ''; readln(obce[4]) end end end; writeln('Podaj wyksztaˆcenie:'); readln(wyksztalcenie); writeln('Podaj stanowisko:'); readln(stanowisko); end; Menu end; procedure Format_numeru_telefonu(var tele: string); var ilosc_przesuniec,i,spacja: integer; begin if tele[1] in ['0'..'9'] then begin Byte(tele[0]) := length(tele) + 1; for i := length(tele) downto 2 do tele[i] := tele[i - 1]; tele[1] := ' ' end; if (length(tele) - 1) mod 3 <> 0 then ilosc_przesuniec := ((length(tele) - 1) div 3) else ilosc_przesuniec := ((length(tele) - 1) div 3) - 1; Byte(tele[0]) := length(tele) + ilosc_przesuniec; spacja := length(tele) - 3; for i := length(tele) downto 3 do if i = spacja then begin tele[i] := ' '; ilosc_przesuniec := ilosc_przesuniec - 1; spacja := spacja - 4 end else tele[i] := tele[i-ilosc_przesuniec]; if tele[1] = ' ' then begin for i := 1 to length(tele) - 1 do tele[i] := tele[i + 1]; Byte(tele[0]) := length(tele) - 1 end 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); if telefon <> 'Brak telefonu' then Format_numeru_telefonu(telefon); 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; 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 3 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('Pod˜wietlenie danej opcji - [D]¢ˆ, [G]¢ra'); 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©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; 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; function Podswietlenie(ilosc_opcji,nr_opcji: integer): integer; begin if klawisz = 'D' then if (ilosc_opcji + 1) mod stala = 0 then if nr_opcji < ilosc_opcji then nr_opcji := nr_opcji + 1 else nr_opcji := 0 else if nr_opcji < ilosc_opcji + 1 then nr_opcji := nr_opcji + 1 else nr_opcji := 1; if klawisz = 'G' then if (ilosc_opcji + 1) mod stala = 0 then if nr_opcji > 0 then nr_opcji := nr_opcji - 1 else nr_opcji := ilosc_opcji else if nr_opcji > 1 then nr_opcji := nr_opcji - 1 else nr_opcji := ilosc_opcji + 1; Podswietlenie := nr_opcji 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,j1,l,lp,numer,c,nr_opc: 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; assign(podglad,'wydruk.txt'); rewrite(podglad); for j := 1 to n do begin l := 0; for j1 := 1 to 4 do if dane[j]^.poziom.obce[j1] <> '' 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 <= stala then c := lp else c := stala; j := 1; j1 := 1; if lp > stala then begin repeat Napisy_Do_Jezykow(a,lp,nazwy_kolumn); writeln(nazwy_kolumn); writeln; for numer := j to c do if j1 = numer mod stala then begin textcolor(black); textbackground(white); writeln(Prac_Info(numer,dane[tab_rek[numer]]^)) end else begin textcolor(lightgray); textbackground(black); writeln(Prac_Info(numer,dane[tab_rek[numer]]^)) end; textcolor(lightgray); textbackground(black); writeln; writeln('Z - zapis do pliku wydruk.txt'); klawisz := readkey; if (klawisz = 'G') or (klawisz = 'D') then j1 := Podswietlenie(c - j,j1); if klawisz = 'Z' then begin writeln(podglad); writeln(podglad,nazwy_kolumn); writeln(podglad); for numer := j to c do writeln(podglad,Prac_Info(numer,dane[tab_rek[numer]]^)) end; if (ord(klawisz) = 80) and (c < lp) then { klawisz strzaˆka w d¢ˆ } if c + stala > lp then begin j := c + 1; c := c + (lp mod stala); j1 := 1 end else begin j := j + stala; c := c + stala; j1 := 1 end else if (ord(klawisz) = 72) and (j > 1) then { klawisz strzaˆka w g¢r© } if c mod stala <> 0 then begin c := c - (c mod stala); j := c - (stala - 1); j1 := 1 end else begin c := c - stala; j := c - (stala - 1); j1 := 1 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 if j1 = numer mod stala then begin textcolor(black); textbackground(white); writeln(Prac_Info(numer,dane[tab_rek[numer]]^)) end else begin textcolor(lightgray); textbackground(black); writeln(Prac_Info(numer,dane[tab_rek[numer]]^)) end; textcolor(lightgray); textbackground(black); writeln; writeln('Z - zapis do pliku wydruk.txt'); writeln; klawisz := readkey; if (klawisz = 'G') or (klawisz = 'D') then j1 := Podswietlenie(c - j,j1); if klawisz = 'Z' then begin writeln(podglad); writeln(podglad,nazwy_kolumn); writeln(podglad); for numer := 1 to lp do writeln(podglad,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; close(podglad) end; function Aktualizuj_Dane(nr: integer): boolean; { Procedura aktualizuj¥ca dane pracownika } var a: char; nowe_nazwisko: string; 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: XXXXXXXXX. Je˜li nie posiadasz naci˜nij klawisz ENTER.'); readln(telefon); if telefon = '' then telefon := 'Brak telefonu' until Poprawny_numer(telefon) or (telefon = 'Brak telefonu') 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.