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.