rekordyBazaPowtorzenie

{
Napisz program, ktory bedzie baza danych oparta na rekordach.
Baza ma zawierac:
stringi: Imie, Nazwisko, Adres, pesel
integer: rok ur, dzien, miesiac
bool: kobieta

Baza ma zawierac 5 rekordow
Baza ma miec menu:
1. Wypelnij (uruchomienie procedury uzupelniajacej baze)
2. Wyswietl rekord (user podaje nr)
3. Wyswietl wszystkie rekordy
4. Uzupelnij (edytuj) wybrany rekord
5. Wyzeruj rekord
6. Sprawdz poprawnosc rekordu (czy poczatek peselu to rok miesiac dzien)
7. puste
8. puste
9. puste
0. exit
}
program rekordy;
uses crt;
type
baza=record
imie,nazwisko,adres,pesel : string;
rokUr,dzien,miesiac : integer;
kobieta : boolean;
end;
var osoba:array [1..5] of baza;
idWyb : integer;
wybor : char;
t     : text;
sciezka : string;

procedure menu;
begin
    writeln('1 - wypelnij (automat)');
    writeln('2 - wyswietl rekord (user podaj nr)');
    writeln('3 - wyswietl wszystkie rekordy');
    writeln('4 - edytuj wybrany rekord');
    writeln('5 - wyzeruj rekord');
    writeln('6 - sprawdz poprawnosc peselu');
    writeln('7 - ustaw uchwyt do pliku tekstowego');
    writeln('8 - zapisz dane do pliku');
    writeln('9 - zczytaj dane z pliku');
    writeln('0 - exit');
    write('Wybierz: ');
end;
procedure wypelnij;
begin
     with(osoba[1]) do begin
        imie:='Radoslaw';
        nazwisko:='Adamowicz';
        adres:='Robotniczna 25/1 Police';
        pesel:='94080202317';
        rokUr:=1994;
        miesiac:=8;
        dzien:=2;
        kobieta:=false;
     end;
     with(osoba[2]) do begin
        imie:='Ryszard';
        nazwisko:='Niedostatkiewicz';
        adres:='Grunwaldzka 23/15 Szczecin';
        pesel:='94051402457';
        rokUr:=1994;
        miesiac:=5;
        dzien:=14;
        kobieta:=false;
     end;
     with(osoba[3]) do begin
        imie:='Kamil';
        nazwisko:='Andrusiewicz';
        adres:='Hutnicza 14/4 Szczecin';
        pesel:='94070502317';
        rokUr:=1994;
        miesiac:=7;
        dzien:=5;
        kobieta:=false;
     end;
     with(osoba[4]) do begin
        imie:='Piotr';
        nazwisko:='Szefler';
        adres:='Robotniczna 29/1 ';
        pesel:='94121402317';
        rokUr:=1994;
        miesiac:=12;
        dzien:=14;
        kobieta:=false;
     end;
     with(osoba[5]) do begin
        imie:='Jacek';
        nazwisko:='Wolny';
        adres:='Niemcewicza 13/4 Szczecin';
        pesel:='94110102317';
        rokUr:=1994;
        miesiac:=11;
        dzien:=1;
        kobieta:=true;
     end;
end;
procedure wyswietlWszystko;
var i,bylo:byte;
begin
    bylo:=0;
    for i:=1 to 5 do begin
        with(osoba[i]) do begin
            if (imie<>'')AND(nazwisko<>'') then begin
                writeln('Imie i nazwisko: ',imie,' ',nazwisko);
                writeln('Adres: ',adres);
                writeln('Nr pesel: ',pesel);
                writeln('Rok urodzenia: ',rokUr,'-',miesiac,'-',dzien);
                write('Plec: ');if kobieta=false then writeln('Mezczyzna') ELSE
                writeln('Kobieta');
                bylo:=bylo+1;
            end;
        end;
    end;
    if bylo=0 then write('Wszystkie rekordy sa puste');
end;
procedure wyswietlWybranego(var idWyb:integer);
begin
    with(osoba[idWyb]) do begin
    if (imie<>'')AND(nazwisko<>'') then begin
    writeln('Imie i nazwisko: ',imie,' ',nazwisko);
    writeln('Adres: ',adres);
    writeln('Nr pesel: ',pesel);
    writeln('Rok urodzenia: ',rokUr,'-',miesiac,'-',dzien);
    write('Plec: ');if kobieta=false then writeln('Mezczyzna') ELSE
writeln('Kobieta');writeln;
    end;
end;
procedure edytujWybranego(var idWyb : integer);
var kobietaCzy:integer;
begin
     clrscr;writeln('Edytujesz rekord o id ',idWyb);
     with(osoba[idWyb]) do begin
          write('Podaj imie: ');readln(imie);
          write('Podaj nazwisko: ');readln(nazwisko);
          write('Podaj adres: ');readln(adres);
          write('Podaj nr PESEL: ');readln(pesel);
          write('Podaj dzien urodzenia: ');readln(dzien);
          write('Podaj miesiac urodzenia: ');readln(miesiac);
          write('Podaj rok urodzenia: ');readln(rokUr);
          write('Mezczyzna, czy kobieta (0-mezczyzna,1-kobieta): ');readln(kobietaCzy);
          if(kobietaCzy=1) then kobieta:=true ELSE kobieta:=false;
     end;
     write('Rekord edytowano pomyslnie!');
end;
procedure zerujRekord(var idWyb : integer);
begin
     with(osoba[idWyb]) do begin
          imie:='';
          nazwisko:='';
          adres:='';
          pesel:='';
          dzien:=0;
          miesiac:=0;
          rokUr:=0;
          kobieta:=false;
     end;
     write('Rekord o nr ',idWyb,' zostal wyzerowany pomyslnie!');
end;
function IntToStr (I : integer) : String;
var S : String;
begin
    Str(I,S);
    IntToStr:=S;
end;
procedure sprawdzPoprawnoscPeselu(var idWyb : integer);
var pom,pom2,pom3 : string;
pom1 : extended;
code : integer;
rokZle,miesiacZle,dzienZle,dlPes : byte;
begin
     rokZle:=0;miesiacZle:=0;dzienZle:=0;dlPes:=0;
     pom:=Copy(osoba[idWyb].pesel,1,2);
     pom2:=intToStr(osoba[idWyb].rokUr);
     pom3:=Copy(pom2,3,2);
     if(pom<>pom3) then rokZle:=1;
     if Length(osoba[idWyb].pesel)<>11 then dlPes:=1;
     pom:=Copy(osoba[idWyb].pesel,3,2);
     Val(pom,pom1,code);
     if(pom1<1)OR(12<pom1)OR(pom1<>osoba[idWyb].miesiac) then miesiacZle:=1;

     pom:=Copy(osoba[idWyb].pesel,5,2);
     Val(pom,pom1,code);
     if(pom1<1)OR(31<pom1)OR(pom1<>osoba[idWyb].dzien) then dzienZle:=1;
     if(rokZle=0)AND(miesiacZle=0)AND(dzienZle=0)AND(dlPes=0) then
     write('Pesel ',osoba[idWyb].imie,' ',osoba[idWyb].nazwisko,' jest poprawny')
     ELSE begin
        if rokZle=1 then writeln('Podany rok w numerze pesel jest nieprawidlowy');
        if miesiacZle=1 then writeln('Podany miesiac w numerze pesel jest nieprawidlowy');
        if dzienZle=1 then writeln('Podany dzien w numerze pesel jest nieprawidlowy');
        if dlPes=1 then writeln('Podany pesel nie ma 11 znakow');
     end;
end;
procedure ustawUchwyt;
begin
     write('Podaj sciezke do pliku: ');readln(sciezka);
     if sciezka<>'' then
     write('Ustawiono uchwyt do pliku; sciezka: ',sciezka)
     ELSE write('Nic nie napisales');
end;
procedure zapiszDoBazy;
var i : byte;
begin
     assign(t,sciezka);
     rewrite(t);
     for i:=1 to 5 do begin
          writeln(t,osoba[i].imie);
          writeln(t,osoba[i].nazwisko);
          writeln(t,osoba[i].adres);
          writeln(t,osoba[i].pesel);
          writeln(t,osoba[i].rokUr);
          writeln(t,osoba[i].miesiac);
          writeln(t,osoba[i].dzien);
          writeln(t,osoba[i].kobieta);
     end;
     close(t);
end;
procedure wczytajZBazy;
var i : byte;
kobSpr : string;
begin
     i:=0;
     assign(t,sciezka);
     reset(t);
     while not eof(t) do begin
          i:=i+1;
          readln(t,osoba[i].imie);
          readln(t,osoba[i].nazwisko);
          readln(t,osoba[i].adres);
          readln(t,osoba[i].pesel);
          readln(t,osoba[i].rokUr);
          readln(t,osoba[i].miesiac);
          readln(t,osoba[i].dzien);
          readln(t,kobSpr);
          if kobSpr = 'FALSE' then osoba[i].kobieta:=false;
          if kobSpr = 'TRUE' then osoba[i].kobieta:=true;
     end;
     close(t);
end;
begin
    REPEAT
        clrscr;
        menu;readln(wybor);
        case wybor of
             '1':begin
                      wypelnij;
             end;
             '2':begin
                      REPEAT write('Podaj nr porzadkowy osoby (1-5): ');readln(idWyb);clrscr;UNTIL (idWyb>=1) AND (idWyb<=5);
                      wyswietlWybranego(idWyb);
                      readkey;
             end;
             '3':begin
                      wyswietlWszystko;
                      readkey;
             end;
             '4':begin
                      REPEAT write('Podaj nr porzadkowy osoby (1-5): ');readln(idWyb);clrscr;UNTIL (idWyb>=1) AND (idWyb<=5);
                      edytujWybranego(idWyb);readkey;
             end;
             '5':begin
                      REPEAT write('Podaj nr porzadkowy osoby (1-5): ');readln(idWyb);clrscr;UNTIL (idWyb>=1) AND (idWyb<=5);
                      zerujRekord(idWyb);readkey;
             end;
             '6':begin
                      REPEAT write('Podaj nr porzadkowy osoby (1-5): ');readln(idWyb);clrscr;UNTIL (idWyb>=1) AND (idWyb<=5);
                      sprawdzPoprawnoscPeselu(idWyb);
                      readkey;
             end;
             '7':begin
                      ustawUchwyt;
                      write('Sciezka zostala ustawiona na: ',sciezka);
                      readkey;
             end;
             '8':begin
                      zapiszDoBazy;write('Dane zostaly zapisane do pliku!');readkey;
             end;
             '9':begin
                      wczytajZBazy;write('Dane zostaly wczytane z pliku');readkey;
             end;

        end;
    UNTIL wybor='0';
end.