Pascal (FPC), błąd w programie 'prosta baza danych'


(Mateusz61096) #1

Witam!

Napisałem program, który jest bardzo prostą bazą danych z dwiema możliwościami: dodaniem rekordu i odczytem wszystkich rekordów. Celem tego programu było przećwiczenie używania plików elementowych. Napotkałem na taki błąd: "Constant and CASE types do not match". Program wskazuje kursorem na błąd oczywiście w instrukcji CASE. Oto kod programu:

uses crt;


label kotwica1,kotwica2;


type

    proba= record

    tekst: string;

    liczba: integer;

    end;


const

lbpoz:integer=0;


var

a:char;

katalog: array[1..100] of proba;

F: file of proba;


procedure zapis(r:proba);

begin

    with r do

    begin

        writeln('Podaj imię');

        readln(tekst);

        writeln('Podaj wiek');

        readln(liczba);

    end;

end;


procedure zapisdopam;

begin

    inc(lbpoz);

    writeln('Nowa pozycja nr ',lbpoz);

    zapis(katalog[lbpoz]);

end;


procedure odczyt(r:proba);

begin

    with r do

    begin

        writeln('Imię: ',tekst);

        writeln('Wiek: ',liczba);

    end;

end;


procedure odczytzpam;

var i:integer;

begin

    for i:=1 to lbpoz do

    begin

        writeln('Pozycja katalogu nr ',i);

        odczyt(katalog[i]);

    end;

    readln;

end;


procedure menu;

begin

    writeln('Co chcesz zrobić? Wpisz:');

    writeln('1 :dla dodania nowej pozycji');

    writeln('2 :dla pokazania wszystkich pozycji');

    writeln('3 :wyjście');

    a:=readkey;

end;


procedure odczytzpliku;

var i:integer;

begin

    assign(F,'C:\Baza danych1\baza.dat');

    reset(F);

    i:=0;

    while not eof(F) do

    begin

        inc(i);

        read(F,katalog[i]);

    end;

    lbpoz:=i;

    close(F);

end;


procedure zapisdopliku;

var i:integer;

begin

    assign(F,'C:\Baza danych1\baza.dat');

    rewrite(F);

    for i:=1 to lbpoz do

        write(F,katalog[i]);

    close(F);

end;


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

{początek programu}


begin


    clrscr;

    odczytzpliku;

    kotwica2:

    clrscr;

    menu;

    kotwica1:

    case (a) of

        1: zapisdopam;

        2: odczytzpam;

        3: begin

                zapisdopliku;

                writeln('Miłego dnia');

                delay(1000);

                halt;

            end;

        else

        begin

            writeln('Błąd. Spróbuj jeszcze raz.');

            goto kotwica1;

        end;

    end;

    goto kotwica2;

end.

Gdzie tu jest błąd? Trochę to jest dla mnie dziwne, bo przecież zmienna "a" jest zmienną, a nie stałą.

Z góry dzięki za odpowiedź!


(klemensior15) #2

O ile dobrze widzę to a jest charem czyli powinno być

'1': zapisdopam;

        '2': odczytzpam;

        '3': begin[...]

No chyba że zmienisz a na byte czy cokolwiek liczbowego

Ps. goto ?!


(Mateusz61096) #3

Wielkie dzięki. Szukałem tam gdzie nie trzeba.

instrukcja goto (idź do) to to rodzaj pętli (kotwica), którą wcześniej trzeba zadeklarować (np. label kotwica1;), a potem w programie umieścić kotwica1: i gotowe :slight_smile:


(nnick) #4

Nie chodzi o to. Goto jest wręcz zakazane, nie wolno i już.


(Mateusz61096) #5

Program się skompilował, ale jest jeden problem w działaniu. Mianowice podczas zapisu nowego rekordu wszystko idzie dobrze, ale podczas ich odczytywania program pokazuje:

Imie:

Wiek: 0

I to samo jest dla każdego rekordu. Chyba musi być jakiś błąd podczas zapisywania danych, ale gdzie on jest?

PS A co z tym goto jest nie tak?


([alex]) #6

Jeżeli masz:

proba= record

tekst: string;

liczba: integer;

end;

katalog:array[1..100] of proba;

to nie możesz bezkarnie zrobić:

write(F,katalog_);_

ani też:

read(F,katalog__);

Właściwie to kompilator powinien krzyczeć już na:

F: file of proba;

Zamień string na araay [0..X]of Char lub na string[X]; czyli krótki string.

ponieważ string zajmuje w struk


(Mateusz61096) #7

czyli powinno być write(F,katalog_.tekst); i tak dalej czy jak powinno być?_

a dlaczego nie może być F: file of proba?

proszę o wytłumaczenie - dopiero się uczę i nie wiem czemu jest źle


([alex]) #8

Albo "sztywne" składowe struktury albo F:Text i zapisywać pole po polu.

Struktura proba zawiera string, czyli tak czy owak nie może zostać poprawnie zapisana do pliku.

Nie wiem czemu twój kompilator od razu nie zaczął się buntować na takie coś.


(Mateusz61096) #9

pomysł wzorowałem na: http://turbopascal.helion.pl/r-17.htm.

Oni zrobili to trochę inaczej,ale czy to oznacza, że jeśli stworze nowy typ string30=string[30] i użyje go zamiast tego 'normalnego' stringa do będzie dobrze? No bo jednak w jakiś sposób zapisali tekst do pliku elementowego.


([alex]) #10

Nie musisz tworzyć nowego typu, wystarczy że dasz, tekst: string[30];

Zaproponowałem to jakieś trzy posty wyżej.


(Mateusz61096) #11

niestety zamiana stringa na stringa[30] nic nie dała, ale udło mi się już rozwiązać ten problem. Zamiast robienia dwóch procedur i używania jednej w drugiej zrobiłem po prostu jedną procedurę:

procedure zapisdopam;

begin

    inc(lbpoz);

    writeln('Nowa pozycja nr ',lbpoz);

    with katalog[lbpoz] do

    begin

        writeln('Podaj imie');

        readln(tekst);

        writeln('Podaj wiek');

        readln(liczba);

    end;

end;

Nie wiem gdzie tam był błąd, ale działa.

Jeszcze jedno. Jak zrobić coś takiego, że przy pierwszym uruchomieniu albo gdy plik z bazą został usunięty program stworzy go samemu?

I dlaczego nie wolno używać goto?


([alex]) #12

FileExists(filename : string): boolean; w sysutils

goto zaciemnia kod tak że nie da się w nim połapać.

Owszem jak na razie dla ciebie czy z goto czy bez niego i tak nie da się połapać,

ale to się z czasem zmieni dla kodów bez goto, dla kodów z goto nigdy się nie zmieni.


(Mateusz61096) #13

już prawie koniec, ale... Coś źle zrobiłem z tym fileexists. Przy pierwszym uruchomieniu idzie bezproblemowo, ale potem gdy folder i plik już istnieje pojawia się exited with exit code = 217. Domyślam się, że próbuje na nowo tworzyć ten katalog i plik. Oto co wymyśliłem:

procedure pierwszeuruchomienie;

begin

    fileexists('C:\Baza_danych_1\baza.dat');

    if ioresult=0 then

    begin

        mkdir('C:\Baza_danych_1');

        assign(F,'C:\Baza_danych_1\baza.dat');

        rewrite(F);

        close(F);

    end;

end;

([alex]) #14

FileExists(filename : string): boolean ;


(Mateusz61096) #15

to jak powinno być bo nie działa także: :frowning:

procedure pierwszeuruchomienie;

begin

    fileexists('C:\Baza_danych_1\baza.dat');

    if not fileexists then

    begin

        mkdir('C:\Baza_danych_1');

        assign(F,'C:\Baza_danych_1\baza.dat');

        rewrite(F);

        close(F);

    end;

end;

oraz

procedure pierwszeuruchomienie;

begin

    fileexists('C:\Baza_danych_1\baza.dat');

    if fileexists=false then

    begin

        mkdir('C:\Baza_danych_1');

        assign(F,'C:\Baza_danych_1\baza.dat');

        rewrite(F);

        close(F);

    end;

end;

jak powinno być?


([alex]) #16
if not fileexists('C:\Baza_danych_1\baza.dat') then

    begin

        mkdir('C:\Baza_danych_1');

        assign(F,'C:\Baza_danych_1\baza.dat');

        rewrite(F);

        close(F);

    end;

//lub

    assign(F,'C:\Baza_danych_1\baza.dat');

    {$I-} reset(F); {$I+} 

    if ioresult<>0 then

    begin

        mkdir('C:\Baza_danych_1');

        rewrite(F);

    end;

    close(F);

(Mateusz61096) #17

Dzięki za cierpliwość! :slight_smile: Teraz już wszystko działa.