![]() |
pomocy baza danych w pascalu
Witam..
Prosze o pomoc w napisani bazy danych w pascalu prawie cala mam napisana lecz jest problem przy procedurze usun gdyz nie usuwa ostatniego rekordu i w programi jest kilka bledow bardzo bym prosil o poprawienie mojego programiku jest to bardzo pilne. Z gory dziekuje bardzo za pomoc:):) a to kod zrodlowy: program baza_dan; uses dos,crt; type tdane = record tytulfilmu:string[30]; rokprodukcji:string[30]; czastrwania: 1..100; end; const plik : string = 'baza.bin'; var opcja : 1..5; dane : tdane; baza : file of tdane; procedure menu; begin writeln; writeln('1 - dodaj wpis do filmoteki'); writeln('2 - popraw wpis w filmotece'); writeln('3 - usun wpis z filmoteki'); writeln('4 - wyswietl zawartosc filmoteki'); writeln('5 - zakoncz program'); writeln; writeln('Wybierz opcje 1-5'); end; {******************************************} procedure dodaj(rozmiar:byte); var osoba:tdane; begin writeln; write('Podaj tytul filmu: '); readln(osoba.tytulfilmu); write('Podaj rok produkcji: '); readln(osoba.rokprodukcji); write('Podaj czas trwania: '); readln(osoba.czastrwania); seek(baza,rozmiar); write(baza,osoba); end; {******************************************} procedure popraw; var numer:byte; osoba:tdane; begin write('Podaj numer filmu poprawy: '); readln(numer); dodaj(numer-1); end; {******************************************} procedure usun; var numer:byte; temp: file of tdane; dane:tdane; begin write('Podaj numer rekordu do usuniecia: '); readln(numer); assign(temp,'d:\temp.bin'); rewrite(temp); seek(baza,numer); repeat read(baza,dane); write(temp,dane); until eof(baza); seek(baza,numer-1); truncate(baza); seek(baza,filesize(baza)); seek(temp,0); repeat read(temp,dane); write(baza,dane); until eof(temp); close(temp); erase(temp); end; {******************************************} procedure spacja(ile:byte;znak:char); var i:byte; begin for i:=1 to ile do write(znak); end; {******************************************} procedure kreska(ile:byte;znak:char); var i:byte; begin for i:=1 to ile do write(znak); writeln; end; {******************************************} procedure pokaz; var osoba:tdane; lp:byte; begin clrscr; if filesize(baza) = 0 then begin writeln; writeln('************************************'); writeln('* Brak filmow w bazie danych !!! *'); writeln('************************************'); writeln; end else begin lp:=1; seek(baza,0); kreska(73,'-'); write('| Lp. |tytu lfilmu |'); write(' rok produkcji |'); writeln(' czas trwania |'); kreska(73,'-'); repeat read(baza,osoba); write('| ',lp,'|'); write(' ',osoba.tytulfilmu); spacja(20-length(osoba.tytulfilmu)-1,' '); write('| ',osoba.rokprodukcji ); spacja(25-length(osoba.tytulfilmu)-1,' '); write( '| ',osoba.czastrwania,' |'); writeln; kreska(73,'-'); inc(lp); until eof(baza); end; end; procedure inicjalizacja; begin assign(baza,plik); if fsearch(plik,'') = '' then rewrite(baza) else reset(baza); end; begin inicjalizacja; repeat menu; readln(opcja); case opcja of 1: dodaj(filesize(baza)); 2: popraw; 3: usun; 4: pokaz; end; until opcja = 5; close(baza); end. |
| Wszystkie czasy w strefie CET. Aktualna godzina: 15:29. |
Powered by vBulletin® Version 3.9.0 LTS
Copyright ©2000 - 2026, vBulletin Solutions Inc.