Pascal- mala baza danych

0

Witam. Proszę o pomoc w napisaniu programu.
Program, który w katalogu głównym na dysku A: utworzy pliki rekordów składający się z danych:
-imię i nazwisko
-płeć
-średnia ocen
W programie mają znaleźć się procedury które będą odpowiedzialne za : Dopisywanie, wyświetlanie usuwanie, szukanie i zmianę. Dopisywanie, wyświetlanie i szukanie mam zrobione. Problem pojawia się w usuwaniu i zmianie.
Problem w usuwaniu polega na tym, że nie wiem jak zrobić, aby program usuwał jeden rekord a nie cała bazę danych. Procedurę zmiana zostawiam na koniec, bo mam fajny pomysł na nią i sam coś się pomęczę.
Proszę o pomoc w Procedurze usuwanie.

Program grupa14;
 Uses CRT;
 type rec=record
       imie: string;
       nazwisko:string;
       plec:string;
       srednia:real;
      end;
      plik = file of rec;
       var r:rec;
           p1,p2:plik;
           wybor:char;

 Procedure DOPISZ;
  begin
   reset(p1);
   seek(p1,filesize(p1));
   write('Podaj imie... ');
   readln(R.imie);
   write('Podaj nazwisko... ');
   readln(R.nazwisko);
   write('Podaj plec... ');
   readln(R.plec);
   write('Podaj srednia ocen... ');
   readln(R.srednia);
   write(p1,R);
   close(p1);
  end;

 Procedure SPIS;
  begin
   reset(p1);
   while not eof(p1) do begin
                         read(p1,R);
                         writeln('Imie : ',R.imie);
                         writeln('Nazwisko :  ', R.nazwisko);
                         writeln('Plec : ',R.plec);
                         writeln('Srednia ocen : ',R.srednia:4:2);
                         writeln;
                        end;
   close(p1);
   readln;
  end;

 Procedure ZMIEN;
      var numer:byte;
      naz:string;
  begin
   reset(p1);
   write('podaj nazwisko ');
   readln(naz);
   while not eof(p1) do begin
                         read(p1,R);
                         if R.nazwisko=naz then begin
                                                 if R.plec='kobieta' then begin
                                                                         R.plec:='mezczyzna';
                                                                         seek(p1,filepos(p1)-1);
                                                                         write(p1,R);
                                            end;                   end;
                        end;
   close(p1);
   readln;
  end;

 PROCEDURE USUN;
 var a:integer;
     naz,wybor:string;
 Begin;
 assign(p2,'a:\usun2.dan');
 reset(p1);
 rewrite(p2);
 gotoxy(20,20);
 Write('Podaj nazwisko... ');
 readln(naz);
 clrscr;
 while not eof(p1) do begin
                        read(p1,R);
                        if R.nazwisko=naz then begin
                                                writeln('Imie: ',R.imie);
                                                writeln('Nazwisko: ',R.nazwisko);
                                                writeln('Plec: ',R.plec);
                                                writeln('Srednia: ',R.srednia:4:2);
                                               end;
                       end;

 Write('Czy jestes pewny ze chcesz usunac? (T/N) ');
 read(wybor);
 if wybor='T' then begin
                    while not eof(p1) do begin
                                          read(p1,R);
                                          if R.nazwisko<>naz then write(p2,R);
                                         end;
                    reset(p2);
                    rewrite(p1);
                    while not eof(p2) do begin
                                          read(p2,R);
                                          write(p1,R);
                                        end;
                   end;
 close(p1);
 close(p2);
 readln;
 end;

 Procedure SZUKAJ;
 var naz:string;
 begin
  reset(p1);
  write('Podaj nazwisko... ');
  readln(naz);
  while not eof(p1) do begin
                        read(p1,R);
                        if R.nazwisko=naz then begin
                                                writeln('Imie: ',R.imie);
                                                writeln('Nazwisko: ',R.nazwisko);
                                                writeln('Plec: ',R.plec);
                                                writeln('Srednia: ',R.srednia:4:2);
                                               end;
                       end;
  close(p1);
  readln;
 end;

 Procedure RAPORTY;
  var p2,p3:text;
  var lancuch,ll:string;
 begin
  reset(p1);
  assign(p2,'a:\kobiety.txt');
  assign(p3,'a:\mezczyzni.txt');
  rewrite(p2);
  rewrite(p3);
  writeln(p2,'Kobiety');
  writeln(p3,'Mezczyzni');
  while not eof(p1) do begin
                        read(p1,R);
                        lancuch:=R.nazwisko+' '+R.imie+' '+ll;
                        if R.plec='mezczyzna' then begin
                                             writeln(p3,lancuch);
                                            end
                                       else begin
                                             writeln(p2,lancuch);
                                            end;
                       end;
  close(p1);
  close(p2);
  close(p3);
 end;

 BEGIN
 assign(p1,'a:\baza2.dan');
 repeat
 clrscr;
 textcolor(white);
 gotoxy(20,4);
 writeln('SPIS - 1');
 gotoxy(20,6);
 writeln('DOPISZ - 2');
 gotoxy(20,8);
 writeln('USUN - 3');
 gotoxy(20,10);
 writeln('SZUKAJ - 4');
 gotoxy(20,12);
 writeln('ZMIEN - 5');
 Gotoxy(20,14);
 writeln('STWORZ RAPORTY - 6');
 gotoxy(20,16);
 textcolor(13);
 writeln('KONIEC - 7');
 gotoxy(30,24);
 textcolor(1);
 write('Wybierz dowolna opcje ');
 textcolor(white);
 readln(wybor);
 case wybor of
 '1':begin
      clrscr;
      SPIS;
     end;
 '2':begin
      clrscr;
      DOPISZ;
     end;
 '3':begin
      clrscr;
      USUN;
     end;
 '4':begin
      clrscr;
      SZUKAJ;
     end;
 '5':begin
      clrscr;
      ZMIEN;
     end;
 '6':begin
      clrscr;
      RAPORTY;
     end;
 end;
 until wybor='7'
 END.
0
 PROCEDURE USUN;
 var a:integer;
     naz,wybor:string;
 Begin;
 assign(p2,'a:\usun2.dan');
 reset(p1);
 rewrite(p2);
 gotoxy(20,20);
 Write('Podaj nazwisko... ');
 readln(naz);
 clrscr;
 while not eof(p1) do begin
                        read(p1,R);
                        if R.nazwisko=naz then begin
                                                writeln('Imie: ',R.imie);
                                                writeln('Nazwisko: ',R.nazwisko);
                                                writeln('Plec: ',R.plec);
                                                writeln('Srednia: ',R.srednia:4:2);
                                                Write('Czy jestes pewny ze chcesz usunac? (T/N) ');
                                                read(wybor);
                                                if wybor <>'T' then Break;
                                               end else write(p2,R);
                       end;
 if wybor='T' then begin
                    reset(p2);
                    rewrite(p1);
                    while not eof(p2) do begin
                                          read(p2,R);
                                          write(p1,R);
                                        end;
                   end;
 close(p1);
 close(p2);
 readln;
 end;

Tyle chyba wystarczy, by działało co? ;)
W twoim programie kopiowałeś tylko rekordy znajdujące się za rekordem usuwanym.

Pozdrawiam.

1 użytkowników online, w tym zalogowanych: 0, gości: 1