Правила форума
Прочтите прежде чем задавать вопрос!
program kursov;
uses crt;
type
student=record
name,part,prof:string[23]; {имя и инициалы}
number,vozrast:integer; {номер группы}
{ ball:array[1..5] of integer;} {успеваемость}
{srball:real;} {средняя оценка}
end;
var
f1,f2:file of student; {файловая переменная массива}
zap:student;
repeatkey:char;
num:integer; {общее количество записей в массиве}
i,j:integer;
gg,gg2,gg3,sor:longint;
sel:integer; {выбор пункта меню}
sum:longint; {сумма значений полей}
m1,m2:student; {для сортировки записей}
s:boolean; {ключ сортировки}
filename:string; {имя файла с записями}
z:string; {фильтрация пробелов}
pball:string[9]; {Оценки для ввода и вывода}
{описание вспомогательных процедур}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure shapka; {заголовок таблицы}
begin
writeln (' TABLICA ZAPISEU');
writeln;
writeln ('/===============TT==========TT==========TT=========TT=============\');
writeln ('[ fAMILIIA I.O. ][ #okryga ][ vozrast ][ partiia ][ professiia ]');
writeln ('\===============++==========++==========++=========++=============/');
end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure undertable; {низ таблицы}
begin
writeln ('\==================¦===========¦===========¦==========+===========/');
end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure nofile; {отсутствие файла}
begin
clrscr;
writeln;
writeln (' OSHIBKA!');
writeln (' Faul ',filename,' otsytstvyet! Najmite Enter.');
readkey;
end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure opening; {процедура открытия файла с f1}
begin
writeln;
write (' VVedite imia faula ');
readln (filename);
assign (f1,filename);
end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure printing; {процедура вывода текущей строки}
begin
with zap do
begin
write ('¦ ',name:5,' ');
write (number:10,' ');
pball:='';
{формирование строки оценок и вывод на экран}
write (vozrast:10,' ');
write (part:10,' ');
write (prof:10,' ');
writeln;
end;
end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure obmen;
begin
sor:=sor-2;
seek(f1,sor);
write(f1,m2);
write(f1,m1);
sor:=sor+2;
sor:=sor-1;
seek(f1,sor);
end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure editforedit; {Процедура выбора пункта изменения и изменения}
begin
repeat
clrscr;
Writeln(' vy xotite izmenit:');
Writeln(' -----------------------');
Writeln(' 1. familiy I.O.');
Writeln(' 2. Nomer okryga');
Writeln(' 3. vozrast');
Writeln(' 4. naimen partii');
Writeln(' 5. professiy');
Writeln(' -----------------------');
Write(' >>');
Readln(sel);
clrscr;
writeln;
writeln (' zapis ',gg);
writeln;
writeln (' vvedite novye dannye: ');
writeln;
case sel of
1:begin
write (' familiia i.o. ');
readln (zap.name);
writeln;
writeln(' familiia v zapisi ',gg,' izmenena');
end;
2:begin
write (' # okryga ');
readln (zap.number);
writeln;
writeln(' # okryga',gg,' izmenen');
end;
3:begin
writeln (' vvedite novyu vozrast');
readln (zap.vozrast);
writeln(' vozrast ',gg,' izmenen');
end;
4:begin
write (' Naim partii ');
readln (zap.part);
writeln;
writeln(' naim partii ',gg,' izmeneno');
end;
5:begin
write (' professiia ');
readln (zap.prof);
writeln;
writeln(' professiia ',gg,' izmenena');
end;
{Подсчет Среднего Балла}
{sum:=0;
for j:=1 to 5 do
sum:=sum+zap.ball[j];
zap.srball:=sum/5; }
{writeln(' vozrast ',gg,' izmenen');
end; }
end;
clrscr;
Writeln;
Write(' vy xotite izmenit chto nibyd eshe ? [Y/N] либо [Д/Н] ');
Readln(repeatkey);
until (UpCase(repeatkey) in ['N','Н']);
seek(f1,gg-1);
write(f1,zap);
end;
{Основные подпрограммы 1-7}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure create; {процедура создания нового файла}{(1 подпрограмма)}
begin
clrscr;
Writeln(' vvedite imia faula');
Write(' ');
Readln(filename);
Assign(f1,filename);
Rewrite(f1);
Writeln(' faul s imenem ',filename,' sozdan. najmite ENTER.');
readkey;
close(f1);
end; {процедура создания нового файла}{(конец 1 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure enter; {процедура добавления записи в файл}{(2 подпрограмма)}
begin
clrscr; {ассоциация с файлом и переход в конец}
writeln (' dobavlenie zapisi v faul');
opening;
{$I-}
reset (f1);
{$I+}
if IOResult=0 then
begin
if not eof(f1) then
begin
gg:=filesize(f1);
seek(f1,gg);
end;
clrscr;
writeln (' vvod zapiseu');
writeln;
write (' vvedite kol-vo zapiseu ');
readln (num);
for i:=1 to num do
begin
clrscr;
writeln;
writeln (' zapis ',i);
with zap do
begin
write (' familiia i.o. ');
readln (name);
write ('# okryga ');
readln (number);
writeln (' vozrast : ');
readln (vozrast);
writeln ('Naimenovanie partii : ');
readln (part);
writeln (' professia ');
readln (prof);
end;
write(f1,zap);
writeln;
end;
close(f1);
end
else nofile;
end; {процедура добавления записи в файл}{(конец 2 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure udalen; {процедура удаления записи}{(3 подпрограмма)}
begin
clrscr;
writeln (' ydalenie zapisi iz faula');
opening;
{$I-}
reset (f1);
{$I+}
if IOResult=0 then
begin
assign (f2,'buf');
rewrite (f2);
clrscr;
writeln (' ydalenie zapisi');
writeln;
write (' vvedite nomer zapisi ');
readln (num);
for i:=1 to num-1 do
begin
read(f1,zap);
write(f2,zap);
end;
read(f1,zap);
while (not(eof(f1))) do
begin
read(f1,zap);
write(f2,zap);
end;
close(f1);
close(f2);
erase(f1);
rename(f2,filename);
clrscr;
Writeln(' zapis ',num,' ydalena. najmite ENTER.');
readkey;
end
else nofile;
end; {процедура удаления записи}{(конец 3 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure edit; {процедура корректировки записи}{(4 подпрограмма)}
begin
clrscr;
repeatkey:=' ';
writeln (' korrektirovka zapisi v faule');
opening;
{$I-}
reset (f1);
{$I+}
if IOResult=0 then
begin
repeat
clrscr;
writeln (' korrektirovka zapisi');
writeln;
write (' vvedite nomer zapisi ');
readln (gg);
seek(f1,gg-1);
read(f1,zap);
editforedit;
clrscr;
Writeln;
Write(' vy xotite izmenit drygyy zapis? [Y/N] libo [Д/Н] ');
Readln(repeatkey);
until (UpCase(repeatkey) in ['N','Н']);
close(f1);
end
else nofile;
end; {процедура корректировки записи}{(конец 4 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure view; {вывод массива на экран}{процедура просмотра файла}{(5 подпрограмма)}
begin
clrscr;
writeln (' prosmotr faula');
opening;
{$I-}
reset (f1);
{$I+}
if IOResult=0 then
begin
clrscr;
shapka;
while (not Eof(f1)) do
begin
read(f1,zap);
with zap do
printing;
end;
undertable;
readkey;
end
else nofile;
end; {вывод массива на экран}{процедура просмотра файла}{(конец 5 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure disp; {процедура вывода на дисплей при условии}{(7 подпрограмма)}
begin
clrscr;
writeln;
opening;
{$I-}
reset (f1);
{$I+}
if IOResult=0 then
begin
clrscr;
shapka;
s:=false;
while (not Eof(f1)) do
begin
read(f1,zap);
with zap do
if vozrast>4 then
begin
printing;
s:=true;
end;
end;
if s=false then writeln ('¦ poisk neydachen ¦ ¦ ¦ ¦');
undertable;
readkey;
end
else nofile;
end; {процедура вывода на дисплей при условии}{(конец 7 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
BEGIN
repeat
clrscr;
writeln;
writeln (' ychebnaia praktika');
writeln;
writeln;
writeln (' baza dannyx ======== Kandidaty');
writeln;
writeln (' ------------------------------------');
writeln (' 1. Sozdanie faula');
writeln (' 2. Dobavlenie zapisi v faul');
writeln (' 3. Ydalenie ykazannou zapisi');
writeln (' 4. Korektirovka ykazannou zqapisi');
writeln (' 5. Prosmotr faula');
writeln (' 6. tyt doljen byt poisk');
writeln (' 7. vyxod');
writeln (' ------------------------------------');
writeln;
write (' > ');
readln (sel);
case sel of
1:create;
2:enter;
3:udalen;
4:edit;
5:view;
6:disp;
7:break;
end;
until false;
END.
pomogite plz vmesto procedyry disp sdekat poisk xotia by po imeni
i eshe sdelat' vyxo bez soxraneniia
zaranee spasibo
