Ver. 1.0 Beta, Don't have a compiler? Now you can write simple scripts ONLINE! This is a basic version -does not include all the Pascal statements. Only to learn basics

Pascal

Baza danych studentów



Poniżej przedstawiono prostą bazę danych studentów -gotowe rozwiązanie. Pooglądaj i naucz się zasady budowania baz danych w pascalu.


Poniższa baza studentów wykorzystuje zapis i odczyt do pliku o ustalonym typie. Nie jest to do końca plik tekstowy. Przedstawiona baza danych była rozwiązaniem zadania na zaliczenie w szkole średniej. Wyciągnij wnioski z takich programów.




program baza_danych_studentow;


const
   maxPrzedmiotow = 2;
   MaxStudentow = 100;

   Plik_Bazy_Danych = 'studenci.txt';

   Przedmioty : array[1..maxPrzedmiotow] of string[30]=
   ('matematyka', 'fizyka');


type
   TOcena = (niedostateczna, dopuszczajaca, dostateczna,
             dobra, bardzo_dobra, celujaca);


   TStudent = record
     Imie           : string[32];
     Nazwisko       : string[32];
     Rok            : Byte;
     OcenyKoncowe   : array[1..MaxPrzedmiotow] of TOcena;
   end;

var
   BazaStd     : array[0..MaxStudentow] of TStudent;
   Wczytanych  : Integer; {przechowuje liczbe wczytanych rekordow}



{FileName - nazwa pliku, baza - tablica z danymi zmienna wczytano przechowuje liczbe wczytanych rekordow}
procedure WczytajDane(const FileName : string; var baza : array of TStudent; var wczytano : Integer);

var F: File of TStudent;

begin
 Assign(F, FileName);
 {$I-}
 Reset(F);
 {$I+}
 wczytano := 0;
 {gdy nie ma pliku}
 if IOResult<>0 then exit;

 while not eof(F) do
 begin
   inc(wczytano);
   Read(F, baza[wczytano]);
 end;

 Close(F);
end;

procedure ZapiszDane(const FileName : string; var baza : array of TStudent; rekordow : Integer);

var F: File of TStudent;
   i : integer;

begin
 Assign(F, FileName);
 {$I-}
 Rewrite(F);
 {$I+}

 {gdy nie mozna utworzyc pliku}
 if IOResult<>0 then exit;

 for i:=1 to rekordow do
   Write(F, baza[i]);


 Close(F);
end;

procedure DodajStudenta(var student : TStudent);
var i:integer;
   oc : byte;
begin
 Write('Podaj imie: ');
 ReadLn(student.Imie);
 Write('Podaj nazwisko: ');
 ReadLn(student.Nazwisko);
 Write('Podaj rok studiow: ');
 ReadLn(student.Rok);

 WriteLn('Podaj oceny: ');
 for i:=1 to MaxPrzedmiotow do
 begin
   Write(Przedmioty[i], ': ');
   ReadLn(oc);
   student.OcenyKoncowe[i] := TOcena(oc-1);
 end;
end;

procedure WyswietlStudenta(const student : TStudent);
var i:integer;
begin
 Write('Imie: ');
 WriteLn(student.Imie);
 Write('Nazwisko: ');
 WriteLn(student.Nazwisko);
 Write('Rok studiow: ');
 WriteLn(student.Rok);

 WriteLn('Oceny:');
 for i:=1 to MaxPrzedmiotow do
 begin
   Write(Przedmioty[i], ': ');
   WriteLn(Byte(student.OcenyKoncowe[i])+1);

 end;
end;

procedure PokazWszystko(baza: array of TStudent; wpisanych : integer);
var i : integer;
begin
 for i:=1 to wpisanych do
   WyswietlStudenta(baza[i]);
end;

{Przydatne przy usuwaniu. Studenta usuwanego zamienia sie miejscem
z ostatnim w tablicy i usuwa ostatniego, przez zmiejszenie liczby wpisanych}
procedure PrzeniesStudenta(var baza: array of TStudent; k, l : Integer);
var Temp : TStudent;
begin
 Temp := baza[k];
 baza[k]:=baza[l];
 baza[l]:=Temp;
end;


procedure UsunStudenta(var baza: array of TStudent; Nr : Integer; var wpisanych : integer);
begin
 PrzeniesStudenta(baza, Nr, wpisanych);
 Dec(wpisanych);
end;

function ZnajdzStudenta(baza: array of TStudent; wpisanych : integer) : integer;
var s : string;
   i : Integer;
   w : Integer;
begin
 Write('Podaj nazwisko studenta: ');
 ReadLn(s);
 w:= 0;
 for i:=1 to wpisanych do
 if baza[i].Nazwisko = s then
 begin
   w := i;
   break;
 end;

 ZnajdzStudenta := w;
end;

procedure ZnajdzNajlepszych(baza: array of TStudent; wpisanych : integer);
var s : string;
   i, j : Integer;
   w : Integer;
begin
 Write('NAJLEPSI STUDENCI ');

 for i:=1 to wpisanych do
 begin
   w:=1;

   for j:=1 to maxPrzedmiotow do
     if baza[i].OcenyKoncowe[j] < bardzo_dobra then  w:=0;

   if w=1 then WyswietlStudenta(baza[i]);
 end;
end;

procedure ZnajdzNiezaliczonych(baza: array of TStudent; wpisanych : integer);
var s : string;
   i, j : Integer;

begin
 Write('STUDENCI Z NIEDOSTATECZNA');

 for i:=1 to wpisanych do
 begin

   for j:=1 to maxPrzedmiotow do
     if baza[i].OcenyKoncowe[j] = niedostateczna then
     begin
       WyswietlStudenta(baza[i]);
       break;
     end;


 end;

end;

procedure ZnajdzNajdluzejStd(baza: array of TStudent; wpisanych : integer);
var s : string;
   i, j : Integer;
   ile, nr : integer;

begin
 Write('STUDENCI NAJDLUZEJ STUDIUJACY');
 ile:=baza[1].Rok;
 nr:=1;

 for i:=1 to wpisanych do
 begin
     if baza[i].Rok>ile then
     begin
       ile:=baza[i].Rok;
       nr:=i;
     end;
 end;

 WyswietlStudenta(baza[nr]);

end;



procedure AutorProgramu;
begin
 WriteLn('AUTOR PROGRAMU');
 WriteLn('movax13h');
end;


var opcja : Byte;
   nr : byte;

begin
 WczytajDane(Plik_Bazy_Danych, BazaStd, Wczytanych);


 repeat

   WriteLn('Witaj w programie');
   WriteLn('MENU:');
   WriteLn('1. Wyswietlanie danych');
   WriteLn('2. Autor programu');
   WriteLn('3. Wyszukiwanie najlepszych uczniow (tylko b.dobre oceny)');
   WriteLn('4. Wyszukiwanie niezaliczonych');
   WriteLn('5. Wyszukiwanie najdluzej studiujacego');
   WriteLn('6. Odczyt z pliku');
   WriteLn('7. Zapis do pliku');
   WriteLn('8. Dodaj studenta');
   WriteLn('9. Usun studenta');
   WriteLn('10. Koniec programu');

   ReadLn(opcja);

   case opcja of
     1: PokazWszystko(BazaStd, Wczytanych);
     2: AutorProgramu;
     3: ZnajdzNajlepszych(BazaStd, Wczytanych);
     4: ZnajdzNiezaliczonych(BazaStd, Wczytanych);
     5: ZnajdzNajdluzejStd(BazaStd, Wczytanych);

     6: WczytajDane(Plik_Bazy_Danych, BazaStd, Wczytanych);
     7: ZapiszDane(Plik_Bazy_Danych, BazaStd, Wczytanych);
     8: begin
          inc(Wczytanych);
          DodajStudenta(BazaStd[Wczytanych]);
        end;

     9: begin
          nr := ZnajdzStudenta(BazaStd, Wczytanych);
          if nr>0 then UsunStudenta(BazaStd, nr, Wczytanych);
        end;


   end;

 until opcja = 10;



end.

Baza danych pracowników



{*******************************************}

USES Crt;

CONST MaxDanych=100;
     NaglowekPliku: ARRAY[0..11] OF CHAR ='KartaPracown';

     FileName:STRING='Karta.txt';

     MaxMenu=6;

     MenuTxt:ARRAY[0..MaxMenu] OF STRING[15]=
     ('Wczytaj baze','Dodaj dane','Wyswietl Dane','Wyszukaj',
      'Zapisz baze','Zmiana nazwy','Wylacz');


{*******************************************}
TYPE TPracownik    = RECORD
      imie        : STRING[40];
      nazwisko    : STRING[40];
      Data_ur     : STRING[12];
      Miejscowosc : STRING[30];
      PESEL       : STRING[11];
      tel         : STRING[15];
    END;

{*******************************************}
VAR  Dane          : ARRAY[1..MaxDanych] OF TPracownik;
    LiczbaZapisow : Byte;
    Modyfikowana  : Boolean;

{*******************************************}


PROCEDURE WczytajBazeDanych(Fn:STRING);
VAR f     : FILE;
   Bufor : ARRAY[0..11] OF CHAR;
   I:Byte;

BEGIN
 Assign(F, Fn);
 {$I-}
 Reset(F, 1);
 {$I+}
 IF IOResult<>0 THEN Exit;
 IF FileSize(F)<12 THEN
 BEGIN
   Close(F);
   Exit;
 END;

 BlockRead(F, Bufor, Length(NaglowekPliku));

 IF Bufor<>NaglowekPliku THEN
 BEGIN
   Close(F);
   Exit;
 END;

 BlockRead(F, LiczbaZapisow, SizeOf(Byte));

 FOR I:=1 TO LiczbaZapisow Do
 BEGIN
   BlockRead(F, Dane[I], SizeOf(TPracownik));
 END;
 Modyfikowana:=FALSE;
 Close(F);
END;

{*******************************************}

PROCEDURE ZapiszBazeDanych(Fn:STRING);
VAR f     : FILE;
   I:Byte;

BEGIN
 Assign(F, Fn);
 Rewrite(F, 1);

 BlockWrite(F, NaglowekPliku, Length(NaglowekPliku));
 BlockWrite(F, LiczbaZapisow, SizeOf(Byte));


 FOR I:=1 TO LiczbaZapisow Do
 BEGIN
   BlockWrite(F, Dane[I], SizeOf(TPracownik));
 END;
 Modyfikowana:=FALSE;
 Close(F);
END;

{*******************************************}
PROCEDURE DodajDane;
BEGIN
 Inc(LiczbaZapisow);
 ClrScr;

 Write('Podaj Nazwisko : ');
 ReadLn(Dane[LiczbaZapisow].Nazwisko);
 IF Dane[LiczbaZapisow].Nazwisko='' THEN
 BEGIN
   Dec(LiczbaZapisow);
   Exit;
 END;

 Write('Podaj Imie : ');
 ReadLn(Dane[LiczbaZapisow].Imie);

 Modyfikowana:=TRUE;

 Write('Data urodzenia : ');
 ReadLn(Dane[LiczbaZapisow].Data_ur);

 Write('Podaj PESEL : ');
 ReadLn(Dane[LiczbaZapisow].PESEL);

 Write('Podaj Miejscowosc : ');
 ReadLn(Dane[LiczbaZapisow].Miejscowosc);

 Write('Podaj telefon : ');
 ReadLn(Dane[LiczbaZapisow].tel);
END;

{*******************************************}
PROCEDURE Edycja(i:Byte);
BEGIN
 IF (i<1) OR (i>LiczbaZapisow) THEN Exit;
 ClrScr;

 Write('Podaj Nazwisko : ');
 ReadLn(Dane[LiczbaZapisow].Nazwisko);
 IF Dane[i].Nazwisko='' THEN
 BEGIN
   Dec(i);
   Exit;
 END;

 Write('Podaj Imie : ');
 ReadLn(Dane[i].Imie);

 Modyfikowana:=TRUE;

 Write('Data urodzenia : ');
 ReadLn(Dane[i].Data_ur);

 Write('Podaj PESEL : ');
 ReadLn(Dane[i].PESEL);

 Write('Podaj Miejscowosc : ');
 ReadLn(Dane[i].Miejscowosc);

 Write('Podaj telefon : ');
 ReadLn(Dane[i].tel);

 Modyfikowana:=TRUE;
END;

{*******************************************}
PROCEDURE Usun(i:Byte);
VAR j:Byte;

BEGIN
 FOR j:=i+1 TO LiczbaZapisow DO
     Dane[J-1]:=Dane[J];

 Dec(LiczbaZapisow);
 Modyfikowana:=TRUE;
END;

{*******************************************}
PROCEDURE WyswietlDane(I:Byte);
BEGIN

 WHILE TRUE DO
 BEGIN
   IF LiczbaZapisow<i THEN Exit;

   ClrScr;
   WriteLn('Pracownik nr : ', i,'/',LiczbaZapisow);
   WriteLn('Przegladanie: GORA, DOL, Edycja <e> Usuwanie <u>');
   WriteLn;

   Write('Nazwisko : ');
   WriteLn(Dane[i].Nazwisko);

   Write('Imie :');
   WriteLn(Dane[i].Imie);

   Write('Data UR. : ');
   WriteLn(Dane[i].Data_Ur);

   Write('PESEL : ');
   WriteLn(Dane[i].PESEL);

   Write('Miejscowosc : ');
   WriteLn(Dane[i].Miejscowosc);

   Write('Podaj telefon : ');
   WriteLn(Dane[LiczbaZapisow].tel);


   CASE ReadKey OF
     #27: Break;
     'e': Edycja(i);
     'u': BEGIN Usun(i);IF i>1 THEN Dec(i);END;
     #0 : CASE ReadKey OF
            #72:IF i>1 THEN DEC(i);
            #80:IF i<LiczbaZapisow THEN INC(i);
          END;
   END;


 END;
END;
{*******************************************}
PROCEDURE Pytanie;
VAR Ch:Char;
BEGIN
 IF NOT Modyfikowana THEN Exit;
 ClrScr;
 WriteLn;
 WriteLn('Baza danych zostala zmodyfikowana, czy chesz ja zapisac (t/n)?');

 REPEAT
   Ch:=UPCASE(ReadKey);
 UNTIL (Ch='T') OR (CH='N');

 IF Ch='T' THEN ZapiszBazeDanych(FileName);
END;
{*******************************************}
PROCEDURE Wyszukaj;
VAR Nazwa:STRING;
   i:Byte;
BEGIN
 Write('Napisz nazwisko : ');
 ReadLn(Nazwa);
 i:=0;

 REPEAT
   Inc(I);
 UNTIL (i>LiczbaZapisow) OR (Nazwa=Dane[i].Nazwisko);

 WyswietlDane(I);

END;

{*******************************************}
FUNCTION Menu:Byte;
VAR J    : Byte;
   Ch   : Char;
BEGIN
 ClrScr;

 GotoXY(25, 1);
 TextColor(White+Blink);

 WriteLn('KARTOTEKA PRACOWNIKOW: ');
 TextColor(LightGray);

 WriteLn;

 FOR J:=0 To MaxMenu DO
 BEGIN
   GotoXY(25, J*2+4);
   WriteLn('<',J+1,'> ',MenuTxt[J]);
 END;

 WHILE NOT (Ch IN [#49..#56]) DO Ch:=ReadKey;

 Menu:=Byte(Ch)-48;
END;
{*******************************************}
PROCEDURE ZmienNazwe;
BEGIN
 ClrScr;
 Write('Podaj nowa nazwe plku : ');
 ReadLn(FileName);
END;
{*******************************************}
BEGIN

 WHILE True DO
 CASE MENU OF
   1:WczytajBazeDanych(FileName);
   2:DodajDane;
   3:WyswietlDane(1);
   4:Wyszukaj;
   5:ZapiszBazeDanych(FileName);
   6:ZmienNazwe;
   MaxMenu+1:Break;
 END;

 Pytanie;
END.

 

ON-LINE scripts!

This website uses cookie files in order to provide Google services (advertisements, analitycs) and Facebook. If you want to block using cookies, turn them off in your browser settings. Need a help? Click me