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łą.
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
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?
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.
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?
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;
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;
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);
