Forum Klix.ba

pozdrav svima!!!
nadam se da ce mi ko od vas moci pomoci. treba mi ovaj
zadatak za kolokvij sutra (utorak, 31.05.2005. u 17
sati). radi se o zadatku u pascal-u s datotekama -
vodjenje videoteke. nadam se da je bar neo nekad u
njemu programirao. izgleda da je problem u case
naredbi na dnu programa. a moze biti i da je do mog
kompajlera ili operativnog sistema (xp). uglavnom,
pregled baze clanova i kaseta ne radi. ako ko zna,
pliiiiz, pomozite, da se rijesim ovog kamena oko
vrata. treba mi za paraf iz struktura i baza podataka,
iz kojih i jest kolokvij. trebaju mi izvorni i izvrsni
kod.
UNAPRIJED HVALA!!!
nikola


program Unit1(input,output);

uses crt,windos;

type tapeS= RECORD
sifraK:string[6];
nazivK:string[30];
reziserK:string[20];
stanjeK: boolean;
end;
clanS= RECORD
clanskaK:string[6];
ime:string[15];
prezime:string[20];
adresa: string[20];
brKas:integer;
end;
zaduzS= RECORD
sifraK:string[6];
clanskaK:string[6];
datumI: string[10];
datumU: string[10];
end;
var k:file of tapeS;
c: file of clanS;
z:file of zaduzS;
ktxt,ctxt,ztxt:text;
izbor:integer;
SlogK:tapeS;
SlogC:ClanS;
SlogZ:ZaduzS;
{**********************************************************}
function traziC(x:string):integer; {trazi clana po broju}
begin
seek(c,0);
while not(eof(c)) do begin
read (c,slogc);
if slogc.clanskaK=x then begin
traziC:=filepos(c)-1;
exit;
end;
end;
trazic:=-1;
end;
{**********************************************************}
Procedure upisiC(x:clanS); {azurira clana}
begin
seek(c,(filepos(c)-1));
write(C,x);
end;
{**********************************************************}
Procedure dodajC(x:clanS); {dodaje clana}
begin
seek(c,filesize(c));
write(c,x);
end;
{**********************************************************}
Procedure brisiC; {brisanje clana}
var x:clanS;
pom1:integer;
begin
pom1:=filepos(c)-1;
seek(c,filesize(c)-1);
if pom1<>filesize(c)-1 then
begin
read(c,x);
seek(c,filesize(c)-1);
truncate(c);
seek(c,pom1);
write(c,x);
end
else truncate(c);
end;
{**********************************************************}
{**********************************************************}
function traziK(x:string):integer; {trazi kasetu po sifri}
begin
seek(k,0);
while not(eof(k)) do begin
read (k,slogk);
if slogk.sifraK=x then begin
traziK:=filepos(k)-1;
exit;
end;
end;
trazik:=-1;
end;
{**********************************************************}
procedure upisik(x:tapeS); {azurira kasetu}
begin
seek(k,(filepos(k)-1));
write(k,x);
end;
{**********************************************************}
procedure dodajk(x:tapeS); {dodaje kasetu}
begin
seek(k,filesize(k));
write(k,x);
end;
{**********************************************************}
Procedure brisit; {brise kasetu}
var x:tapeS;
pom1:integer;
begin
pom1:=filepos(k)-1;
seek(c,filesize(k)-1);
if pom1<> filesize(k)-1 then
begin
read(k,x);
seek(k,filesize(k)-1);
truncate(k);
seek(k,filepos(k)-1);
write(k,x);
end
else truncate(k);
end;
{**********************************************************}
procedure UnAzCl; { UNOS, PROMJENA I BRISAMJE CLANA - meni i ostalo}
var broj:integer;
postoji:boolean;
pomocni:ClanS;
brojs:string;
potvrda:char;
begin
clrscr;
gotoXY(5,24);
writeln('ako broj clanske karte ne postoji u bazi, novi slog ce
biti kreiran');
writeln(' ako broj postoji u bazi bice vam omogucena izmjena
i brisanje ');
gotoXY(1,1);
writeln(' UNOS, PROMJENA I BRISAMJE
CLANA');
writeln('');
writeln('');
write('Unesite broj clanske karte:99');
readln(broj);
gotoXY(5,23);
writeln('
');
writeln('
');
gotoXY(1,6);
str(broj,brojs);
brojs:='99'+ brojs;
postoji:=(traziC(brojs)<>-1);
pomocni.clanskak:=(brojs);
if (postoji) then
begin
pomocni.ime:=slogC.ime;
pomocni.prezime:=slogC.prezime;
pomocni.adresa:=slogC.adresa;
pomocni.brKas:=slogC.brKas;
writeln('');
writeln('broj clanske karte:',pomocni.clanskaK);
writeln('ime:', pomocni.ime);
writeln('prezime:',pomocni.prezime);
writeln('adresa:',pomocni.adresa);
writeln('broj zaduzanih kaseta:',pomocni.brkas);
writeln('');
writeln(' UNESITE PROMJENE');
writeln('');

write('broj clanske karte (ZA BRISANJE 990) :99');
readln(pomocni.ClanskaK);
if pomocni.clanskak<>'0' then
begin
write('ime:'); readln(pomocni.ime);
write('prezime:'); readln(pomocni.prezime);
write('adresa:'); readln(pomocni.adresa);
pomocni.clanskaK:='99'+pomocni.clanskaK;
upisiC(pomocni);
end
else begin
Writeln('');
Write ('potvrdjujete brisanje!?! (D/N):');
readln(potvrda);
if ((potvrda='d') or (potvrda='D')) then brisiC;
end;
end;
if not(postoji) then
begin
pomocni.ime:=' ';
pomocni.prezime:=' ';
pomocni.adresa:=' ';
pomocni.brKas:=0;
writeln('');
write('ime:'); readln(pomocni.ime);
write('prezime:'); readln(pomocni.prezime);
write('adresa:'); readln(pomocni.adresa);
write('broj zaduzanih kaseta',pomocni.brkas);
dodajC(pomocni);
end;
clrscr;
end;
{**********************************************************}
Procedure UnAzKas; {UNOS, PROMJENA I BRISAMJE KASETE - meni i ostalo}
var broj:integer;
pomocni:tapeS;
brojs:string;
postoji:boolean;
potvrda,stanjeC:char;
begin
clrscr;
gotoXY(5,24);
writeln('ako sifra kasete ne postoji u bazi, novi slog ce biti
kreiran');
writeln(' ako kaseta postoji u bazi bice vam omogucena
izmjena i brisanje');
gotoXY(1,1);
writeln(' UNOS, PROMJENA I BRISAMJE
KASETE');
writeln('');
writeln('');
write('Unesite sifru kasete:11');
readln(broj);
gotoXY(5,23);
writeln('
');
writeln('
');
gotoXY(1,6);
str(broj,brojs);
brojs:='11'+ brojs;
postoji:=(traziK(brojs)<>-1);
pomocni.sifraK:=(brojs);
if (postoji) then
begin
pomocni.nazivK:=slogK.nazivK;
pomocni.reziserK:=slogK.reziserK;
pomocni.stanjeK:=slogK.stanjeK;
writeln('');
writeln('sifra kasete:',pomocni.sifraK);
writeln('naziv:', pomocni.nazivk);
writeln('reziser:',pomocni.reziserK);
writeln('adresa:',pomocni.stanjeK);
writeln('');
writeln(' UNESITE PROMJENE');
writeln('');
write('sifra kasete (ZA BRISANJE 110) :11');
readln(pomocni.sifraK);
if pomocni.sifraK<>'0' then
begin
write('naziv:'); readln(pomocni.nazivk);
write('reziser:'); readln(pomocni.reziserK);
Write('stanje (S - slobodna / I - izdata):');
readln(stanjeC);
if ((stanjeC='I') or (stanjeC='i')) then
pomocni.stanjeK:=True
else pomocni.stanjeK:=False;
pomocni.sifraK:='11'+pomocni.sifraK;
upisiK(pomocni);
end
else begin
Writeln('');
Write ('potvrdjujete brisanje!?! (D/N):');
readln(potvrda);
if ((potvrda='d') or (potvrda='D')) then brisiT;
end;
end;
if not(postoji) then
begin
pomocni.nazivK:=' ';
pomocni.reziserK:=' ';
pomocni.stanjeK:=True;
writeln('');
write('naziv:'); readln(pomocni.nazivK);
write('reziser:'); readln(pomocni.reziserK);
Write('stanje (S - slobodna / I - izdata):');
readln(stanjeC);
if ((stanjeC='I') or (stanjeC='i')) then
pomocni.stanjeK:=True
else pomocni.stanjeK:=False;
dodajK(pomocni);
end;
clrscr;
end;
{**********************************************************}
procedure UnAz; {UNOS I AZURIRANJE - meni}
var izbor1:integer;

begin
repeat
clrscr;
writeln('');
writeln('');
writeln('');
writeln(' UNOS I AZURIRANJE');
writeln('');
writeln('');
writeln(' 1 - BAZA CLANOVA');
writeln(' 2 - BAZA KASETA');
writeln('');
writeln(' 0 - IZLAZ');
writeln('');
writeln('');
writeln('');
write('Vas izbor:');
read(izbor1);
case izbor1 of
1:UnAzCl;
2:UnAzKas;
0:break;
end;
until false;
end;
{**********************************************************}
procedure vracanje(ss:string); {vracanje kasete}
var trazis:integer;
duznik:string;
pomocniz: zaduzs;
Year, Month, Day, DayOfWeek: word;
YearS, MonthS, DayS: string;


begin
seek(z,0);
while not(eof(z)) do begin
read (z,slogz);
if ((slogz.sifraK=ss) and (slogz.datumU='')) then begin
{upisuje datum vracanja}
duznik:=slogZ.clanskaK;
trazis:=filepos(z)-1;
seek(z,trazis);
getdate(Year, Month, Day, DayOfWeek);
str(Year,yearS);
str(Month, months);
str(Day,Days);
slogZ.datumU:=(DayS)+'/'+(MonthS)+'/'+(YearS);
write(z,slogZ);
break;
end;
end;
if eof(z) then begin
writeln('Kaseta nije zaduzena');
repeat
until keypressed;
exit;
end;


seek(k,0);
while not(eof(k)) do begin
read (k,slogk);
if slogk.sifraK=ss then begin {upisuje stanje kasete}
slogk.stanjeK:=false;
trazis:=filepos(k)-1;
seek(k,trazis);
write(k,slogk);
break;
end;
end;
seek(c,0);
while not(eof(c)) do begin {smanjuje brojac posudjenih kniga za 1}
read (c,slogc);
if slogc.clanskaK=duznik then begin
slogc.brkas:=slogc.brkas-1;
trazis:=filepos(c)-1;
seek(c,trazis);
write(c,slogc);
break;
end;
end;
end;
{**********************************************************}
procedure zaduzi(ss:string); {zaduzenje kasete}
var
pom1:string;
Year, Month, Day, DayOfWeek: Word;
YearS, Months, DayS: String;
pomslog:ZaduzS;
trazis:integer;

begin
seek(c,0);
while not(eof(c)) do begin {trazi clana i povecava brojac posudjenih
kaseta za 1}
read (c,slogc); {ako su vec posudjene tri kasete onda
prekida operaciju}
if slogc.clanskaK=ss then
if slogc.brkas<3 then begin
slogc.brkas:=slogc.brkas+1;
trazis:=filepos(c)-1;
seek(c,trazis);
write(c,slogc);
break;
end else begin
writeln('Clan je vec posudio
tri kasete');
repeat
until keypressed;
exit;
end;
end;
if eof(c) then begin
writeln('Clan ne postoji');
repeat
until keypressed;
exit;
end;

write('unesite sifru kasete:');
readln(pom1);

seek(k,0);
while not(eof(k)) do begin
read (k,slogk);
if slogk.sifraK=pom1 then begin {upisuje stanje kasetee}
slogk.stanjeK:=true;
trazis:=filepos(k)-1;
seek(k,trazis);
write(k,slogk);
break;
end;
end;
if eof(k) then begin
slogc.brkas:=slogc.brkas-1;
trazis:=filepos(c)-1;
seek(c,trazis);
write(c,slogc);
writeln('Kaseta ne postoji');
repeat
until keypressed;

end
else begin
pomslog.clanskaK:=ss; {dodaje slog u
datoteku zaduzenja}
pomslog.sifraK:=pom1;
Getdate(Year, Month, Day, DayOfWeek);
str(Year,yearS);
str(Month, months);
str(Day,Days);

pomslog.datumi:=(DayS)+'/'+(MonthS)+'/'+(YearS);
pomslog.datumU:='';
seek(z,filesize(z));
write (z,pomslog);
end;
end;
{**********************************************************}
procedure ZadVrac; {zaduzenje i vracanje kasete -meni}
var broj:integer;
brojS:string;
begin
clrscr;
gotoXY(5,25);
writeln('broj clanske karte za ZADUZENJE ili sifra kasete za
VRACANJE');
repeat
gotoXY(1,1);
writeln(' ZADUZENJE I VRACANJE
KASETE');
writeln('');
writeln('');
write('Unesite broj clanske karte/sifru kasete');
readln(broj);
str(broj,brojS);
until (((brojS[1]='9') and (brojS[2]='9')) or ((brojS[1]='1')
and (brojS[2]='1')));
if brojS[1]='1' then vracanje(brojS)
else zaduzi(brojS);
end;
{**********************************************************}
Procedure ListCl;
var ss:clanS;
pom1,pom2,pom3,pom4:integer;
begin
readln;
rewrite(ctxt);
writeln(ctxt,'No Prezime Ime Adresa
Br zaduzenih kaseta');
writeln(ctxt,'**************************************************************************************************');
seek(c,0);

while not(eof(c)) do begin
read(c,ss);
pom1:=7-length(ss.clanskaK);
pom2:=22-length(ss.prezime);
pom3:=20-length(ss.ime);
pom4:=30-length(ss.adresa);
writeln(ctxt, ss.clanskaK,' ':pom1, ss.prezime,' ':pom2, ss.ime,'
':pom3, ss.adresa,' ':pom4, ss.brkas);
end;
close(ctxt);
end;

{**********************************************************}
Procedure listkas;
var ss:tapeS;
stanje:string;
pom1,pom2,pom3:integer;
begin
rewrite(ktxt);
writeln(ktxt,'Sifra Naziv Reziser
Stanje');
writeln(ktxt,'***************************************************************');

seek(k,0);

while not(eof(k)) do begin
read(k,ss);
if ss.stanjeK=false then stanje:='slobodna'
else stanje:='izdata';
pom1:=6-length(ss.sifraK);
pom2:=30-length(ss.nazivK);
pom3:=21-length(ss.reziserK);
writeln(ktxt,ss.sifraK,' ':pom1, ss.nazivK,' ':pom2,
ss.reziserK,' ':pom3, stanje);
end;
close(ktxt);
end;

{**********************************************************}
Procedure listzad;
var ss:zaduzS;
pom1,pom2,pom3:integer;
begin

rewrite(ztxt);
writeln(ztxt,'Sifra Clanska karta Datum1 Datum2');
writeln(ztxt,'********************************************');
seek(z,0);

while not(eof(z)) do begin
read(z,ss);
pom1:=8-length(ss.sifraK);
pom2:=17-length(ss.clanskak);
pom3:=13-length(ss.datumI);
writeln(ztxt, ss.sifraK,' ':pom1, ss.clanskak,' ':pom2,
ss.datumI,' ':pom3, ss.datumU);
end;
close(ztxt);
end;
{**********************************************************}
procedure List; {listanje: meni1}
var izbor1:integer;

begin
repeat
clrscr;
writeln('');
writeln('');
writeln('');
writeln(' LISTANJE SADRZAJA BAZA');
writeln('');
writeln('');
writeln(' 1 - BAZA CLANOVA');
writeln(' 2 - BAZA KASETA');
writeln(' 3 - BAZA ZADUZENJA');
writeln('');
writeln(' 0 - IZLAZ');
writeln('');
writeln('');
writeln('');
write('Vas izbor:');
readln(izbor1);
readln;
case izbor1 of
0:Break;
1:ListCl;
2:ListKas;
3:ListZad;
end;
until false;
end;
{**********************************************************}
function exist(var dat:file):boolean; {provjerava da li postoji
datoteka}
begin
{$I-}
reset(dat);
close(dat);
{$I+}
Exist:=(IoResult=0);
end;
{**********************************************************}
{**********************************************************}
{**********************************************************}
begin {glavni}
assign(k,'tape.dat');
assign(c,'clan.dat');
assign(z,'dug.dat');
assign(ktxt,'tape.txt');
assign(ctxt,'clanovi.txt');
assign(ztxt,'duznici.txt');

if exist(file(k)) then reset(k)
else rewrite(k);
if exist(file(c)) then reset(c)
else rewrite(c);
if exist(file(z)) then reset(z)
else rewrite(z);
repeat
clrscr;
writeln('');
writeln('');
writeln('');
writeln(' GLAVNI MENI');
writeln('');
writeln(' 1 - UNOS I AZURIRANE (podaci o clanovima i
kasetama)');
writeln(' 2 - ZADUZENJE I VRACANJE KASETE');
writeln(' 3 - PREGLED BAZA');
writeln('');
writeln(' 0 - IZLAZ');
writeln('');
writeln('');
writeln('');
write('Vas izbor:');
read(izbor);
case izbor of
1:UnAz;
2:ZadVrac;
3:List;
0:break;
end;
until false;
close(k);
close(c);
close(z);

clrscr;
end.

koju poruku compiler ispljune ??? koda ko u prichi, pa ne bi bilo loshe da i error message napishes, ja mislim da chak i line oznachi, i ovo sam primjetio (iako povrshno pogledavshi) : sta ako neki retardirani user zvekne nesto razlichito od 0. 1, 2, 3 ili nije vazno jel input ispravan

nikola, nikola tuzit cu te buzi