Правила форума
Прочтите прежде чем задавать вопрос!
" (Показать/Скрыть)
procedure Spravka(var spr1:spr1File);
var
anw,filename :string;
otv2,k,code,i,cd,anw2 :integer;
fl_ex,fl_ex1,wrtten :boolean;
zap :spr_1;
yn,otv :string;
temp :spr1File;
begin
fl_ex:=true;
i:=0;
while fl_ex do
begin
clrscr;
writeln('Viberite punkt menu(spravochnik):');
writeln('1. Sozdat novyi fail.');
writeln('2. Dobavit vkonez zapisi.');
writeln('3. Izmenit zapis.');
writeln('4. Raspechaka faila.');
chislo_ne_chislo(anw,anw2);
case anw2 of
1:begin
repeat
write('Vvedite imya spravochnika: ');
readln(filename);
assign(spr1,filename);
{$I-}
reset(spr1);
{$I+}
if ioresult=0 then
begin
inc(i);
write('Fail s takim imenem uzhe sushestvuet! Perezapisat''(y/n)?');
readln(yn);
if (yn='y') or (yn='Y') then
begin
rewrite(spr1);
fl_ex1:=false;
end
end
else
begin
writeln('Spravochnik "',filename,'" sozdan! Nazhmite Enter...');
rewrite(spr1);
fl_ex1:=false;
fl_ex:=false;
readln;
end;
until fl_ex1=false;
end;
2:begin
clrscr;
writeln('***Vvedite polya zapisi: ');
write('Vvedide abbreviaturu kafedri:');
readln(zap.abbr);
write('Vvedite polnoe nazvanie kafedri : ');
readln(zap.PolnNaz);
write('Vvedite nazvanie instituta: ');
readln(zap.inst);
write('Vvedite FIO zaveduushego kafedroi: ');
readln(zap.Zav);
write('Vvedite auditoriu: ');
readln(zap.room);
write('Vvedite telofonniy nomer kafedri: ');
readln(zap.tel);
writeln('Sohranit zapis?(y\n)');
readln(yn);
if (yn='y') or (yn='Y')
then
begin
seek(spr1,filesize(spr1));
write(spr1,zap)
end;
end;
3:begin
clrscr;
writeln('Soderzhimoe spravochnika: ');
writeln('-------------------------------');
seek(spr1,0);
{$I-}
read(spr1,zap);
{$I+}
if ioresult<>0
then
begin
writeln('V faile net zapisey! Nazhmite enter');
readln;
end
else
begin
seek(spr1,0);
i:=0;
repeat
inc(i);
read(spr1,zap);
writeln(i,'. ',zap.abbr,' ',zap.PolnNaz,' ',zap.Inst,' ',zap.Zav,' ',
zap.Room,' ',zap.Tel);
until eof(spr1);
writeln;
write('vvedite nomer zapisi: ');
readln(i);
seek(spr1,i-1);
read(spr1,zap);
repeat
writeln;
writeln('vybrannaya zapis'': ',zap.abbr,' ',zap.PolnNaz,' ',zap.Inst,' ',
zap.Zav,' ',zap.Room,' ',zap.Tel);
writeln('Vvedite pole, kotoroe hotite redaktirovat'': ');
writeln('1. Abbreviatura');
writeln('2. Polnoe nazvanie kafedri');
writeln('3. Intitut');
writeln('4. ZAvedushiy kafedri');
writeln('5. Auditoria');
writeln('6. Telefon');
writeln('7. Vernutsia');
chislo_ne_chislo(otv,otv2);
if otv2<>7 then
begin
write('Vvedite novoe znachenie: ');
case otv2 of
1:readln(zap.abbr);
2:readln(zap.polnnaz);
3:readln(zap.inst);
4:readln(zap.zav);
5:readln(zap.room);
6:readln(zap.tel);
end;
writeln('Zapomnit'' izmeneniya?(y/n)');
readln(yn);
if (yn='y') or (yn='Y') then
begin
del2(spr1,i);
write(spr1,zap)
end;
end;
until otv2=7;
end;
end;
4:begin
clrscr;
seek(spr1,0);
writeln('Sodergimoe spravochnika: ');
writeln('------------------------------------------------------------------------------------');
writeln(' Abbreviatura Nazvanie Institut Zavedushiy Auditoria Telefon ');
writeln('------------------------------------------------------------------------------------');
repeat
{$I-}
read(spr1,zap);
{$I+}
if ioresult<>0 then
writeln('V faile net zapisei!')
else
with zap do
writeln(abbr:6,polnnaz:13,inst:8,zav:12,room:11,tel:15);
until eof(spr1);
writeln('Press Enter...');
readln;
end;
end;
end;
end;
BEGIN
clrscr;
fl_exit:=true;
while fl_exit do
begin
repeat
clrscr;
writeln('*******MENU********');
writeln('1. RAbota s osnovnim failom');
writeln('2. Rabota so spravochnikom');
writeln('3. Formirovanie vedomostey');
writeln('4. Vihod iz pogrammi');
writeln('*******************');
writeln;
write('Vash vibor ');
readln(ans);
val(ans,ans2,code);
if code<>0 then
begin
textcolor(red);
writeln('Vi vveli ne chislo - ',ans,' Povtorite vvod');
textcolor(white);
readln;
clrscr;
end;
until code=0;
case ans2 of
1: osnovnoifile(osnf);
2: spravka(spr1);
3: Writeln('skoro budet');
4:
begin
clrscr;
writeln('Vyhod iz programmy');
textcolor(green);
writeln('Vi deystvitelno hotite viyti iz programmi? y/n');
textcolor(white);
readln(res);
if (res='y') or (res='Y') then
fl_exit:=false
else
begin
textcolor(red);
writeln('Neverniy vvod - ',ans2,' Povtorite popitku');
textcolor(white);
readln;
clrscr;
end;
end;
end;
end;
end.
-Евгения- 
