Baza Danych – Pascal (Gotowiec)

Program Baza Danych w Pascalu – Kryteria Programu:

• Wprowadzanie danych do pliku
• Wczytywanie danych z pliku
• Edycja danych
• Dopisywanie danych do pliku istniejącego
• Wyszukiwanie danych według różnych kryteriów (Jeśli wyszukiwanie nie spełnia kryteriów zostanie wyświetlony odpowiedni komunikat)
• Menu wyboru:

1. Podac dane do dziennika.
2. Wypisac dane z dziennika.
3. Dopisac osoby do dziennika.
4. Wyszukac osobe w dzienniku.
5. Edytowac osobe w dzienniku.
6. Wyczyscic ekran.
7. Zakonczyc program.

program Dziennik;
uses crt;
type Osoba= record
nr:string;
imie:string[20];
nazwisko:string[20];
ozp:string[20];
ozh:string[20];
ozm:string[20];
ozf:string[20];
ozb:string[20];
zach:string[20];
end;

var f:file of Osoba;
o,y: array [1..30] of Osoba;
s:Osoba;
a:byte;

procedure z;  {procedura wprowadzania danych}
var i,a:byte;
begin

begin
clrscr;
write('Podaj ilosc  osob ktore chcesz wpisac do dziennika:  ');    readln(a);
assign(f,'dziennik.dat');
rewrite(f);          {otwieram plik po raz 1 }
for i:=1 to a do       {a okresla ile ma zostac wprowadzonych osob}
begin
clrscr;
writeln;
write('Nr: ');      readln(o[i].nr);
write('Imie: ');      readln(o[i].imie);
write('Nazwisko: ');      readln(o[i].nazwisko);
write('Oena z Jezyka Polskiego: ');      readln(o[i].ozp);
write('Ocena z Historii: ');         readln(o[i].ozh);
write('Ocena z Matematyki: '); readln(o[i].ozm);
write('Ocena z Fizyki: '); readln(o[i].ozf);
write('Ocena z Biologi: '); readln(o[i].ozb);
write('ZACHOWANIE: '); readln(o[i].zach);
write(f,o[i]);{zpisanie w zmiennej "f" zawartosci tablicy "o[i]"}
clrscr;
end;

close(f); {zamkniecie pliku}
end;
end;

procedure w; {wczytywanie danych z pliku}
var i,a:byte;

begin
assign(f,'dziennik.dat');
reset(f);
while not eof(f) do  {dopóki nie jest koniec pliku wykonuj}
begin
read(f,o[i]); {do "f" wczytaj zawartosc "o[i]"}
with o[i] do   {z tablica "o[i]" wykonaj, u nas wczytaj z niej dana zawartosc}
begin
writeln;
write('Nr: '); writeln(o[i].nr);
write('Imie: ');    writeln(o[i].imie);
write('Nazwisko: ');writeln(o[i].nazwisko);
write('Oena z Jezyka Polskiego: ');     writeln(o[i].ozp);
write('Ocena z Historii: ');         writeln(o[i].ozh);
write('Ocena z Matematyki: '); writeln(o[i].ozm);
write('Ocena z Fizyki: '); writeln(o[i].ozf);
write('Ocena z Biologi: '); writeln(o[i].ozb);
write('ZACHOWANIE: '); writeln(o[i].zach);
end;
end;
end;

procedure dop; {dopisywanie danch od juz istniejacego pliku}
var i,a:byte;

begin
clrscr;
assign(f,'dziennik.dat');
reset(f);
write('Podaj liczbe osob do dopisania:  ');readln(a);
for i:=1 to a do
begin
clrscr;
Seek(f, FileSize(f)); {otwiera plik i ustawia sie w ostatniej linijce }
{tam zaczyna sie dopisywanie, od ostatniej lini zapisanego pliku}
writeln;writeln;
write('Nr: ');readln(o[i].nr);
write('Imie: ');readln(o[i].imie);
write('Nazwisko: '); readln(o[i].nazwisko);
write('Oena z Jezyka Polskiego: ');      readln(o[i].ozp);
write('Ocena z Historii: ');         readln(o[i].ozh);
write('Ocena z Matematyki: '); readln(o[i].ozm);
write('Ocena z Fizyki: '); readln(o[i].ozf);
write('Ocena z Biologi: '); readln(o[i].ozb);
write('Zachowanie: ');readln(o[i].zach);
write(f,o[i]);  {zapisujemy w pliku podane wczesniej dane}
clrscr;
end;
close(f);         {zamykamy plik}
end;
PROCEDURE szukI;
var i,pom:byte;
t:string[20];
begin
pom:=0; {zmienna pomocnicza - jesli nie bedzie osob spelniajacych warunku wyszukiwania}
assign(f,'dziennik.dat');
reset(f);            {otwieram plik, nie po raz pierwszy}

write('Podaj szukane imie: ');
read(t);   {podaje Imie które mam wyszukac}
while not eof(f) do
begin
read(f,o[i]); {wczytuje do "f" tablice "o[i]"}
with o[i] do   { wykonuje z tabl "o[i]"}
if t=(o[i].imie) then    {jezeli wczesniej podane "t"= Imienu wczytuje wszyskie dane szukanej osoby}
begin
pom:=1;
write('Nr: '); writeln(o[i].nr);
write('Imie: '); writeln(o[i].imie);
write('Nazwisko:   ');  writeln(o[i].nazwisko);
write('Oena z Jezyka Polskiego: ');     writeln(o[i].ozp);
write('Ocena z Historii: ');         writeln(o[i].ozh);
write('Ocena z Matematyki: '); writeln(o[i].ozm);
write('Ocena z Fizyki: '); writeln(o[i].ozf);
write('Ocena z Biologi: '); writeln(o[i].ozb);
write('ZACHOWANIE:  '); writeln(zach);
end;
end;
if pom=0 then writeln('Nie ma osob spelniajacych kryteria.');
end;

procedure szukN;
var i,pom:byte;
t:string[20];
begin
pom:=0; {zmienna pomocnicza - jesli nie bedzie osob spelniajacych warunku wyszukiwania}
assign(f,'dziennik.dat');
reset(f);            {otwieram plik, nie po raz pierwszy}

write('Podaj szukane nazwisko: ');
read(t);   {podaje Imie ktore mam wyszukac}
while not eof(f) do
begin
read(f,o[i]); {wczytuje do "f" tablice "o[i]"}
with o[i] do   { wykonuje z tabl "o[i]"}
if t=(o[i].nazwisko) then
begin
pom:=1;
write('Nr: '); writeln(nr);
write('Imie: '); writeln(imie);
write('Nazwisko:   ');  writeln(nazwisko);
write('Oena z Jezyka Polskiego: ');     writeln(o[i].ozp);
write('Ocena z Historii: ');         writeln(o[i].ozh);
write('Ocena z Matematyki: '); writeln(o[i].ozm);
write('Ocena z Fizyki: '); writeln(o[i].ozf);
write('Ocena z Biologi: '); writeln(o[i].ozb);
write('ZACHOWANIE:  '); writeln(zach);
end;
end;
if pom=0 then writeln('Nie ma osob spelniajacych kryteria.');
end;

procedure szukZ;
var i,pom:byte;
t:string[20];
begin
pom:=0; {zmienna pomocnicza - jesli nie bedzie osob spelniajacych warunku wyszukiwania}
assign(f,'dziennik.dat');
reset(f);            {otwieram plik, nie po raz pierwszy}

write('Podaj szukane zachowanie: ');
read(t);   {podaje Imie ktore mam wyszukac}
while not eof(f) do
begin
read(f,o[i]); {wczytuje do "f" tablice "o[i]"}
with o[i] do   { wykonuje z tabl "o[i]"}
if t=(o[i].zach) then    {jezeli wczesniej podane "t"= Imienu wczytuje wszystkie dane szukanej osoby}
begin
pom:=1;
write('Nr: '); writeln(nr);
write('Imie: '); writeln(imie);
write('Nazwisko:   ');  writeln(nazwisko);
write('Oena z Jezyka Polskiego: ');     writeln(o[i].ozp);
write('Ocena z Historii: ');         writeln(o[i].ozh);
write('Ocena z Matematyki: '); writeln(o[i].ozm);
write('Ocena z Fizyki: '); writeln(o[i].ozf);
write('Ocena z Biologi: '); writeln(o[i].ozb);
write('ZACHOWANIE:  '); writeln(zach);
end;
end;
if pom=0 then writeln('Nie ma osob spelniajacych kryteria.');
end;

procedure szuk;  {szukaj}
var t:byte;

begin
clrscr;
textcolor(4);
writeln('Witaj ponownie, wedlug czego zamierzasz szukac?');
writeln('1. Wedlug Imienia.');
writeln('2. Wedlug Nazwiska.');
writeln('3. Wedlug Zachowania.');
textcolor(15);
readln(t);
if t=1 then
begin
clrscr;
szukI;
end else

if t=2 then
begin
clrscr;
szukN;
end else

if t=3 then
begin
clrscr;
szukZ;
end;

end;

procedure edyt;  {edytuj }
var i,pom:byte;
t:string[20];
begin
pom:=0; {zmienna pomocnicza - jesli nie bedzie osob spelniajacych warunku wyszukiwania}
clrscr;
assign(f,'dziennik.dat');
reset(f);
write('Podaj nr osoby ktora chcesz edytowac: ');
readln(t);

begin
for i:=1 to 3 do
read(f,o[i]);  {wczytuje do f o[i]}
with o[i] do
if t=(o[i].nr) then      {patrz procedura powyzej}
begin
pom:=1;
write('Imie:  '); readln(o[i].imie);
write('Nazwisko:   ');  readln(o[i].nazwisko);
write('Oena z Jezyka Polskiego: ');      readln(o[i].ozp);
write('Ocena z Historii: ');         readln(o[i].ozh);
write('Ocena z Matematyki: '); readln(o[i].ozm);
write('Ocena z Fizyki: '); readln(o[i].ozf);
write('Ocena z Biologi: '); readln(o[i].ozb);
write('ZACHOWANIE:  '); readln(zach);
write(f,o[i]); {zapisuje dane}
end;
end;
if pom=0 then writeln('Nie ma osob spelniajacych kryteria.');
end;

procedure cys;   {procedura czysci ekran}
begin
clrscr;
end;

procedure menu;
var q:byte;
begin
textcolor(4);
writeln(' Witaj co zamierzasz robic?');
writeln('1. Podac dane do dziennika.');
writeln('2. Wypisac dane z dziennika.');
writeln('3. Dopisac osoby do dziennika.');
writeln('4. Wyszukac osobe w dzienniku.');
writeln('5. Edytowac osobe w dzienniku.');
writeln('6. Wyczyscic ekran.');
textcolor(4+128); {4 czyli kolor czerwony + 128 oznacza migotanie (red+blink)}
writeln('7. Zakonczyc program.');
textcolor(15);
readln(q);
begin  {cialo wyboru poszczegulnych opcji}
if q=1 then
begin
z;
menu;
end else
if q=2 then
begin
w;
menu;
end else
if q=3 then
begin
dop;
menu;
end else
if q=6 then
begin
cys;
menu;
end else
if q=4 then
begin
szuk;
menu;
end else
if q=5 then
begin
edyt;
menu;
end else
if q=7 then
begin
end;
end;
end;
begin
clrscr;menu;
end.

Publikacja owego programu bez zamieszczenia adresu strony zabroniona. ©

Tagi:

Pascal,

Baza danych pascal,

dziennik pascal, rekordy pascal, turbo pascal, baza danych turbo pascal, program baza danych, dziennik uczniów w pascalu, rekord pascal, zadania pascal, wstęp do programowania, Turbo Pascal, gotowe zadania w pascalu