Pascal

W dzisiejszym odcinku zamiast C# porgram napisany w Pascalu. Co to za program sprawdz sam :)

program baza;
Uses CRT;
Const
maxwpis=1024;
type
tdane = Record
imie    :string[15];
nazwisko:string[15];
tytul   :string[20];
gatunek :string[10];
        end;
dane1= array[0..maxwpis-1] of tdane;
plik= File of tdane;
var
nazwa:String;
dane:dane1;
ilosc:Word;
klawisz:Char;
PROCEDURE Wczytaj(I: Word);
var
S:String;
begin
clrscr;
If(I<ilosc) Then
with dane[I] do
begin
        writeLn;
        writeLn('Film o numerze ', I, ' :');
        writeLn;
        write('Imie    :');
        If (imie<>'') Then
        Write('[', imie, ']');
        readLn(imie);
        write('Nazwisko:');
        If (nazwisko<>'') Then
        Write('[', nazwisko, ']');
        readLn(nazwisko);
        write('Tytul   :');
        If (tytul<>'') Then
        Write('[', tytul, ']');
        readLn(tytul);
        write('Gatunek :');
        If (gatunek<>'') Then
        Write('[', gatunek, ']');
        readLn(gatunek);
end;
end;
PROCEDURE Wypisz(I: Word);
begin
clrscr;
If (I<ilosc) Then
with dane[I] do
begin
writeLn;
        writeLn('Numer wpisu w katalogu filmow: ', I, '.');
        writeLn;
        writeLn('Rezyser :');
        writeLn;
        writeLn('Imie    :', imie);
        writeLn('Nazwisko:', nazwisko);
        writeLn('Tytul   :', tytul);
        writeLn('Gatunek :', gatunek);
end;
end;
PROCEDURE Pokaz;
var
I:Word;
begin
clrscr;
Write('Ilosc wpisow w pliku o nazwie', nazwa, ': ' );
writeLn(' ',ilosc);
writeLn;
writeLn('Podaj numer wpisu filmu:');
readLn(I);
writeLn;
I:=I;
Wypisz(I);
writeLn;
writeLn;
writeLn('Aby przejsc do menu nacisnij ENTER');
readln;
end;
PROCEDURE Edytuj;
var
I:Word;
begin
        clrscr;
Write('Ilosc wpisow w pliku o nazwie ', nazwa, ': ' );
writeLn(' ',ilosc-1);
writeLn;
writeLn('Podaj numer wpisu filmu, ktory chcesz zmienic:');
readLn(I);
writeLn;
Wczytaj(I);
If (I>=ilosc) then
writeLn('Nie ma takiego numeru filmu');
end;
PROCEDURE Dodaj;
begin
If(ilosc<maxwpis) then
begin
Inc(ilosc);
writeLn;
writeLn;
Wczytaj(ilosc-1);
end
Else WriteLn('W bazie danych jest 1024 wpisow, usun jakis by dodac nastepny.');
end;
PROCEDURE Usun;
var
I,a1,al:Word;
begin
clrscr;
writeLn;
writeLn('W ', nazwa, ' jest ', ilosc, ' wpisow filmow');
writeLn('Ktory wpis w katalowu filmu chcesz usunac?:');
readLn(a1);
        If (a1<ilosc) then
begin
al:=1;
for I:=a1+1 to ilosc-1 do
dane[I-al]:=dane[I];
for I:=ilosc-al to ilosc-1 do
with dane[I] do
begin
imie:='';
nazwisko:='';
tytul:='';
gatunek:='';
end;
Dec(ilosc,al);
end
Else writeLn('Nie ma takiego numeru wpisu, aby przejsc do menu nacisnij ENTER');
readln;
end;
PROCEDURE Szukaj;
var
p: file of tdane;
tdan1: tdane;
tytul1: string[20];
jest: boolean;
begin
clrscr;
jest:= False;
writeLn;
writeLn('Jakiego tytulu wyszukac?:');
readLn(tytul1);
assign(p, nazwa);
reset(p);
while not eof(p) do
begin
        read(p,tdan1);
        if (tdan1.tytul) = tytul1 then
begin
writeLn('Rezyser  :');
writeLn;
writeLn('Imie     :', tdan1.imie);
writeLn('Nazwisko :', tdan1.nazwisko);
writeLn('Tytul    :', tdan1.tytul);
writeLn('Gatunek  :', tdan1.gatunek);
jest:= True;
readln;
end
end;
if not jest then
writeLn('Nie ma takiego tytulu filmu w katalogu');
close(p);
readln;
end;
PROCEDURE Pokazwszystkie;
var
p: File of tdane;
tdan1:tdane;
indeks: LongInt;
al: char;
begin
clrscr;
writeLn('Wszystkie wpisy w katalogu filmow:');
indeks:=1;
assign(p, nazwa);
reset(p);
indeks:=-1;
repeat
indeks:=indeks+1;
seek(p,indeks);
read(p,tdan1);
        writeLn;
        writeLn;
        writeLn('Rezyser :');
        writeLn('Imie    :', tdan1.imie);
        writeLn('Nazwisko:', tdan1.nazwisko);
        writeLn('Tytul   :', tdan1.tytul);
        writeLn('Gatunek :', tdan1.gatunek);
readLn(al);
Until eof (p);
close(p);
end;
PROCEDURE Otworz;
var
        p:plik;
begin
writeLn;
writeLn;
writeLn('Witaj w katalogu filmow');
readln;
clrscr;
writeLn;
writeLn('Jezeli chcesz utworzyc nowa baze danych nacisnij ENTER,');
writeLn('jesli juz wczesniej zapisywales/as plik podaj nazwe: ');
readLn(nazwa);
 if (nazwa<>'') then
begin
assign(p, nazwa);
reset(p);
while (not EoF(p)) do
begin
read(p, dane[ilosc]);
Inc(ilosc);
end;
close(p);
end;
end;
PROCEDURE Zapisz;
var
p:plik;
I:Word;
begin
If (nazwa='') then
begin
writeLn('Nazwa katalogu filmow (wraz z rozszerzeniem):');
readLn(nazwa);
end;
assign(p, nazwa);
rewrite(p);
For I:=0 to ilosc-1 do
Write(p, dane[I]);
Close(p);
end;
begin
ilosc:=0;
Otworz;
repeat
clrscr;
WriteLn;
WriteLn;
WriteLn('Nowy wpis                                        [n]');
WriteLn('Wyswietlenie wpisow                         [w]');
WriteLn('Wyswietlenie wszystkich wpisow        [e]');
WriteLn('Szukaj nazwiska                                 [s]');
WriteLn('Edytuj wpis                                        [h]');
WriteLn('Usun wpis                                          [d]');
WriteLn('Zapisz i zamknij program                    [q]');
WriteLn;
WriteLn;
Write('Wybierz jakas opcje: ');
readLn(klawisz);
writeLn;
Case (klawisz) of
         'n' : Dodaj;
         'w' : Pokaz;
         'e' : Pokazwszystkie;
         's' : Szukaj;
         'h' : Edytuj;
         'd' : Usun;
         'q' : ;
Else WriteLn('Wybierz prawidlowa opcje!');
write('Aby wrocic do menu wyboru nacisnij ENTER');
readln;
end;
 Until (klawisz='q');
 Zapisz;
end.