Kurs Turbo Pascala

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.

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

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.