[PASCAL] program baza danych

system · 28 Kwiecień 2010 04:42

program BazaKonkursow;



uses crt;



type

TKonkurs=record


   nazwa:string[60];

   data:string[20];

   tematyka:string[20];

   uczestnicy:byte;

   nagroda_pieniezna:real;

   strona:string[50];


end;


procedure info;

begin

  clrscr;

  writeln('Program tworzy plik bazy danych o konkursach informatycznych');

  writeln('wcisnij ');

  readln;

  clrscr;

  writeln;

  writeln(' | / -- |\ | | / | | -- __');

  writeln(' |/ | | | \ | |/ | | |__| | ');

  writeln(' |\ | | | \ | |\ | | | \ -- ');

  writeln(' | \ | __| | \| | \ |__ | | \ __|');

end;


procedure tworz(var nazwa:string; Konkurs:TKonkurs);


var

  plik:file of TKonkurs;

  wyb:byte;



begin

  clrscr;

  writeln('tworze plik bazy danych');

  writeln('Chcesz uzyc domyslnej sciezki dostepu? "d:\baza.dat" ? ');

  writeln('Tak<1>/Nie<2>');

  readln(wyb);



IF wyb = 2 then

begin


  write('podaj nazwe ze sciezka dostepu: ');readln(nazwa);


  assign(plik,nazwa);

  rewrite(plik);

  close(plik);

  end;

IF wyb = 1 then

begin

  nazwa:='d:\baza.dat';

end;



end;


procedure dodaj(sciezka:string; var Konkurs:TKonkurs);

var

  plik:file of TKonkurs;

  a,i:word;

  znak:char;


begin

  assign(plik,sciezka);

  reset(plik);

  a:=filesize(plik);

  close(plik);

  assign(plik,sciezka);

  reset(plik);

  seek(plik,a);

  a:=filesize(plik);

  i:=a;


    repeat

      clrscr;

      writeln('wstawiam rekordy');

      writeln('Wstawiam rekord numer: ',i);

      write('Podaj nazwe konkursu: ');readln(Konkurs.nazwa);

      write('Podaj date przeprowadzenia konkursu ');readln(Konkurs.data);

      write('Podaj tematyke konkursu ');readln(Konkurs.tematyka);

      write('Podaj ilosc uczestnikow konkursu: ');readln(Konkurs.uczestnicy);

      write('Czy nagroda pieniezna? Jesli tak to ile: ');readln(Konkurs.nagroda_pieniezna);

      write('Podaj strone internetowa konkursu: ');readln(Konkurs.strona);

      write(plik,Konkurs);

      i:=i+1;

      write('Czy nastepna T/N?');readln(znak);

      znak:=upcase(znak);

    until znak='N';

end;


procedure wyswietl(nazwa:string; Konkurs:TKonkurs);

var

  plik:file of TKonkurs;


begin

clrscr;

writeln('Wyswietlam zawartosc bazy danych');

assign(plik,nazwa);

reset(plik);

read(plik,Konkurs);

while not eof do

begin

writeln('Nazwa konkursu: ',Konkurs.nazwa);

writeln('Data przeprowadzenia konkursu: ',Konkurs.data);

writeln('Temat: ',Konkurs.tematyka);

writeln('Liczba uczestnikow: ',Konkurs.uczestnicy);

writeln('Nagroda pieniezna: ',Konkurs.nagroda_pieniezna);

writeln('Strona internetowa konkursu: ',Konkurs.strona);

end;

close(plik);


end;




procedure menu(var Konkurs:TKonkurs; nazwa:string);

var

  znak:char;


begin


  repeat

    clrscr;

    writeln('opcje programu');

    writeln;

    writeln('A - zaloz plik bazy danych');

    writeln('B - wstaw rekord do pliku bazy danych');

    writeln('C - wyswietl zawartosc pliku bazy danych');

    writeln('D - szukaj rekordow wg nazwiska');

    writeln('K - koniec pracy');

    write('wybieram: ');readln(znak);

    znak:=upcase(znak);

      case znak of

      'A':tworz(nazwa,Konkurs);

      'B':dodaj(nazwa,Konkurs);

      'C':wyswietl(nazwa,Konkurs);

  { 'K':koniec; }

      end;

  until znak='K'

end;





var

  Konkurs:TKonkurs;

  plik:file of TKonkurs;

  znak:char;

  nazwa:string;




begin

  info;

  menu(Konkurs,nazwa);

  readln;

end.

Program powyżej służy do wpisywania do bazy różnych rekordów. Napisałem więc testuje:

Wpisuje dane do rekordu. potwierdzam i gdy chcę wyświetlić zawartość ta wyświetla się w nieskończoność ten sam rekord, proszę o pomoc ;|

M11 · 28 Kwiecień 2010 05:27

read(plik,Konkurs);

Włącz do pętli czytania pliku a nie przed nią.

while not eof do

read(plik,Konkurs);

...

system · 28 Kwiecień 2010 13:18

program BazaKonkursow;



uses crt;



type

TKonkurs=record


   nazwa:string[60];

   data:string[20];

   tematyka:string[20];

   uczestnicy:byte;

   nagroda_pieniezna:real;

   strona:string[50];


end;


procedure info;

begin

  clrscr;

  writeln('Program tworzy plik bazy danych o konkursach informatycznych');

  writeln('wcisnij ');

  readln;

  clrscr;

  writeln;

  writeln(' | / -- |\ | | / | | -- __');

  writeln(' |/ | | | \ | |/ | | |__| | ');

  writeln(' |\ | | | \ | |\ | | | \ -- ');

  writeln(' | \ | __| | \| | \ |__ | | \ __|');

end;


procedure tworz(var nazwa:string; Konkurs:TKonkurs);


var

  plik:file of TKonkurs;

  wyb:byte;



begin

  clrscr;

  writeln('tworze plik bazy danych');

  writeln('Chcesz uzyc domyslnej sciezki dostepu? "d:\baza.dat" ? ');

  writeln('Tak<1>/Nie<2>');

  readln(wyb);



IF wyb = 2 then

begin


 write('podaj nazwe ze sciezka dostepu: ');readln(nazwa);


 assign(plik,nazwa);

 rewrite(plik);

 close(plik);

 end;

IF wyb = 1 then

begin

 nazwa:='d:\baza.dat';

assign (plik,nazwa);

rewrite(plik);

close(plik);

end;


end;


procedure dodaj(sciezka:string; var Konkurs:TKonkurs);

var

  plik:file of TKonkurs;

  a,i:word;

  znak:char;


begin

  assign(plik,sciezka);

  reset(plik);

  a:=filesize(plik);

  close(plik);

  assign(plik,sciezka);

  reset(plik);

  seek(plik,a);

  a:=filesize(plik);

  i:=a;


    repeat

      clrscr;

      writeln('wstawiam rekordy');

      writeln('Wstawiam rekord numer: ',i);

      write('Podaj nazwe konkursu: ');readln(Konkurs.nazwa);

      write('Podaj date przeprowadzenia konkursu ');readln(Konkurs.data);

      write('Podaj tematyke konkursu ');readln(Konkurs.tematyka);

      write('Podaj ilosc uczestnikow konkursu: ');readln(Konkurs.uczestnicy);

      write('Czy nagroda pieniezna? Jesli tak to ile: ');readln(Konkurs.nagroda_pieniezna);

      write('Podaj strone internetowa konkursu: ');readln(Konkurs.strona);

      write(plik,Konkurs);

      i:=i+1;

      write('Czy nastepna T/N?');readln(znak);

      znak:=upcase(znak);

    until znak='N';

end;


procedure wyswietl(nazwa:string; Konkurs:TKonkurs);

var

  plik:file of TKonkurs;


begin

clrscr;

writeln('Wyswietlam zawartosc bazy danych');

assign(plik,nazwa);

reset(plik);


while not eof do


read(plik,Konkurs);

begin

writeln('Nazwa konkursu: ',Konkurs.nazwa);

writeln('Data przeprowadzenia konkursu: ',Konkurs.data);

writeln('Temat: ',Konkurs.tematyka);

writeln('Liczba uczestnikow: ',Konkurs.uczestnicy);

writeln('Nagroda pieniezna: ',Konkurs.nagroda_pieniezna);

writeln('Strona internetowa konkursu: ',Konkurs.strona);

readln;

end;

close(plik);


end;




procedure menu(var Konkurs:TKonkurs; nazwa:string);

var

  znak:char;


begin


  repeat

    clrscr;

    writeln('opcje programu');

    writeln;

    writeln('A - zaloz plik bazy danych');

    writeln('B - wstaw rekord do pliku bazy danych');

    writeln('C - wyswietl zawartosc pliku bazy danych');

    writeln('D - szukaj rekordow wg nazwiska');

    writeln('K - koniec pracy');

    write('wybieram: ');readln(znak);

    znak:=upcase(znak);

      case znak of

      'A':tworz(nazwa,Konkurs);

      'B':dodaj(nazwa,Konkurs);

      'C':wyswietl(nazwa,Konkurs);

  { 'K':koniec; }

      end;

  until znak='K'

end;





var

  Konkurs:TKonkurs;

  plik:file of TKonkurs;

  znak:char;

  nazwa:string;




begin

  info;

  menu(Konkurs,nazwa);

  readln;

end.

dalej nie działa ;|,lekko zmieniony bo domyslna scieżka nie działała

M11 · 28 Kwiecień 2010 14:52

OMG, Ty pisałeś ten program? Strzelam że nie bo sposób w jaki to poprawiłeś woła o pomstę do nieba.

_alex · 28 Kwiecień 2010 14:54

while not eof do

begin

read(plik,Konkurs);

system · 28 Kwiecień 2010 15:12

program BazaKonkursow;



uses crt;



type

TKonkurs=record


   nazwa:string[60];

   data:string[20];

   tematyka:string[20];

   uczestnicy:byte;

   nagroda_pieniezna:real;

   strona:string[50];


end;


procedure info;

begin

  clrscr;

  writeln('Program tworzy plik bazy danych o konkursach informatycznych');

  writeln('wcisnij ');

  readln;

  clrscr;

  writeln;

  writeln(' | / -- |\ | | / | | -- __');

  writeln(' |/ | | | \ | |/ | | |__| | ');

  writeln(' |\ | | | \ | |\ | | | \ -- ');

  writeln(' | \ | __| | \| | \ |__ | | \ __|');

end;


procedure tworz(var nazwa:string; Konkurs:TKonkurs);


var

  plik:file of TKonkurs;

  wyb:byte;



begin

  clrscr;

  writeln('tworze plik bazy danych');

  writeln('Chcesz uzyc domyslnej sciezki dostepu? "d:\baza.dat" ? ');

  writeln('Tak<1>/Nie<2>');

  readln(wyb);



IF wyb = 2 then

begin


 write('podaj nazwe ze sciezka dostepu: ');readln(nazwa);


 assign(plik,nazwa);

 rewrite(plik);

 close(plik);

 end;

IF wyb = 1 then

begin

  nazwa:='d:\baza.dat';

  assign (plik,nazwa);

  rewrite(plik);

  close(plik);

end;


end;


procedure dodaj(sciezka:string; var Konkurs:TKonkurs);

var

  plik:file of TKonkurs;

  a,i:word;

  znak:char;


begin

  assign(plik,sciezka);

  reset(plik);

  a:=filesize(plik);

  close(plik);

  assign(plik,sciezka);

  reset(plik);

  seek(plik,a);

  a:=filesize(plik);

  i:=a;


    repeat

      clrscr;

      writeln('wstawiam rekordy');

      writeln('Wstawiam rekord numer: ',i);

      write('Podaj nazwe konkursu: ');readln(Konkurs.nazwa);

      write('Podaj date przeprowadzenia konkursu ');readln(Konkurs.data);

      write('Podaj tematyke konkursu ');readln(Konkurs.tematyka);

      write('Podaj ilosc uczestnikow konkursu: ');readln(Konkurs.uczestnicy);

      write('Czy nagroda pieniezna? Jesli tak to ile: ');readln(Konkurs.nagroda_pieniezna);

      write('Podaj strone internetowa konkursu: ');readln(Konkurs.strona);

      write(plik,Konkurs);

      i:=i+1;

      write('Czy nastepna T/N?');readln(znak);

      znak:=upcase(znak);

    until znak='N';

end;


procedure wyswietl(nazwa:string; Konkurs:TKonkurs);

var

  plik:file of TKonkurs;


begin

clrscr;

writeln('Wyswietlam zawartosc bazy danych');

assign(plik,nazwa);

reset(plik);


while not eof do

begin

read(plik,Konkurs);

writeln('Nazwa konkursu: ',Konkurs.nazwa);

writeln('Data przeprowadzenia konkursu: ',Konkurs.data);

writeln('Temat: ',Konkurs.tematyka);

writeln('Liczba uczestnikow: ',Konkurs.uczestnicy);

writeln('Nagroda pieniezna: ',Konkurs.nagroda_pieniezna);

writeln('Strona internetowa konkursu: ',Konkurs.strona);

readln;

end;

close(plik);


end;




procedure menu(var Konkurs:TKonkurs; nazwa:string);

var

  znak:char;


begin


  repeat

    clrscr;

    writeln('opcje programu');

    writeln;

    writeln('A - zaloz plik bazy danych');

    writeln('B - wstaw rekord do pliku bazy danych');

    writeln('C - wyswietl zawartosc pliku bazy danych');

    writeln('D - szukaj rekordow wg nazwiska');

    writeln('K - koniec pracy');

    write('wybieram: ');readln(znak);

    znak:=upcase(znak);

      case znak of

      'A':tworz(nazwa,Konkurs);

      'B':dodaj(nazwa,Konkurs);

      'C':wyswietl(nazwa,Konkurs);

  { 'K':koniec; }

      end;

  until znak='K'

end;





var

  Konkurs:TKonkurs;

  plik:file of TKonkurs;

  znak:char;

  nazwa:string;




begin

  info;

  menu(Konkurs,nazwa);

  readln;

end.

Muszę Cię zmartwić. Pisałem sam.

btw dalej nie działa. wyskakuje tylko “Wyswietlam zawartosc bazy danych”

_alex · 28 Kwiecień 2010 15:38

while not eof(plik) do

system · 28 Kwiecień 2010 15:40

Ok działa, dzięki śliczne.