Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.01.2009, 20:00   #1
Defer
 
Регистрация: 25.01.2009
Сообщений: 3
По умолчанию помогите срочно завтра сдавать...

помогите срочно завтра сдавать в институте
нужно закоментить каждую строку проги
пожалуйста помогите!!!!!!!
нужно преподу объяснить что прога делает
и если он тыкнет в любое место исходнго кода я должен объяснить это место!!!!

program test_variant_14;
uses crt, windos;
type
rec=record
vopros:string;
tip:byte;
otvet:array [1..4] of string[100];
ball:integer;
end;

st=record
fam:string;
gruppa:integer;
ocenka:byte;
end;


var
zadanija:file of rec;
students:file of st;
stud:st;
z:rec;
pass:string;
key:char;
k:byte;

procedure menu_pr; forward;
procedure regim2; forward;
procedure test; forward;
procedure password; forward;



procedure menu;
begin
repeat
clrscr;
writeln('programma testirovanie studentov ');
writeln(' 1. Prepod');
writeln(' 2. Student');
writeln(' 3. Vyhod');
key:=readkey;
until (ord(key)>=49) and (ord(key)<=51);
case key of
'1': password;
'2': regim2;
'3': halt(1);
end;
end;


procedure prosmotr;
var
a,size:longint;
temp:file of rec;
i:byte;

begin
assign(zadanija,'zadanija');
{$I-}
reset(zadanija);
close(zadanija);
{$I+}
if IOResult <>0 then menu_pr;
reset(zadanija);
begin
while not eof(zadanija) do
begin
read(zadanija,z);
clrscr;
writeln('1-udalenie voprosa, 2-redaktirovanie');
writeln('najmi lubuju klavishu dla sledujushego voprosa');
writeln(z.vopros);
writeln('Pravilnii otvet: ',z.otvet[1]);
if z.tip<>2 then
for i:=2 to 4 do writeln('otvet № ',i,' ',z.otvet[i]);
writeln('ball: ',z.ball);
key:=readkey;
if key='1' then
begin
A:=filepos(zadanija);
Assign(temp,'temp');
Rewrite(temp);
Seek(zadanija,0);
If (a-1)<>0 then
While size<>(a-1) do
Begin
Read(zadanija,z);
Write(temp,z);
Size:=filepos(zadanija);
end;
seek(zadanija,a);
while not eof(zadanija) do
begin
read(zadanija,z);
write(temp,z);
end;
close(zadanija);
close(temp);
erase(zadanija);
rename(temp,'zadanija');
reset(zadanija);
seek(zadanija,a-1);
end;
if key='2' then
begin
seek(zadanija,filepos(zadanija)-1);
writeln('vvedi vopros:');
readln(z.vopros);
writeln(' Vyberete tip voprosa;');
writeln(' 1- neskolko variantov otveta ');
writeln(' 2- trebuetsya vvod znacheniya');
repeat
key:=readkey;
until (key='1') or (key='2');
case key of
'1':z.tip:=1;
'2':z.tip:=2;
end;
writeln(' Vvedi pravilnyi otvet');
Readln(z.otvet[1]);
If z.tip=1 then
for i:=2 to 4 do
begin
z.otvet[i]:='';
writeln(' Vvedi otvet №',i);
readln(z.otvet[i]);
end;
writeln(' Vvedi bally za pravilnyi otvet');
repeat
{$I-}
readln(z.ball);
{$I+}
Until Ioresult=0;
{$I-}
write(zadanija,z);
seek(zadanija,filepos(zadanija)-1);
end;
end;
clrscr;
writeln('вы просмотрели все задания');
writeln('нажмите любую клавишу,');
writeln('чтобы выйти в предыдущее меню');
key:=readkey;
menu_pr;
end;
end;

procedure otchet;
var
temp:file of rec;
begin
assign(students,'students');
{$I-}
Reset(students);
close(students);
{$I+}
if IOResult <> 0 then
begin

writeln('ERROR!!! Nikto ne proshel test!');
writeln('Najmi lyubuyu klavishu');
key:=readkey;
menu_pr;
end;
reset(students);
while not eof(students)do
begin
read(students,stud);
clrscr;
writeln(' Familiya: ',stud.fam);
writeln(' Gruppa: ',stud.gruppa);
writeln(' ball: ',stud.ocenka);
writeln;
writeln(' Najmite lyubuyu klavishu,chtoby prosmotret otchet dalshe');
key:=readkey;
end;
clrscr;
writeln(' Najmite lyubuyu klavishu,chtoby vyiti v menyu');
key:=readkey;
menu_pr;
end;

procedure vvod;{ввод новых заданий}
var
i,j:byte;
Defer вне форума Ответить с цитированием
Старый 25.01.2009, 20:00   #2
Defer
 
Регистрация: 25.01.2009
Сообщений: 3
По умолчанию продолжение

begin
Assign(zadanija,'zadanija');
clrscr;
writeln('vvedi vopros:');
readln(z.vopros);
writeln(' Vyberete tip voprosa;');
writeln(' 1- neskolko variantov otveta ');
writeln(' 2- trebuetsya vvod znacheniya');
repeat
key:=readkey;
until (key='1') or (key='2');
case key of
'1':z.tip:=1;
'2':z.tip:=2;
end;
writeln(' Vvedi pravilnyi otvet');
Readln(z.otvet[1]);
If z.tip=1 then
for i:=2 to 4 do
begin
z.otvet[i]:='';
writeln(' Vvedi otvet №',i);
readln(z.otvet[i]);
end;
writeln(' Vvedi bally za pravilnyi otvet');
repeat
{$I-}
readln(z.ball);
{$I+}
Until Ioresult=0;
{$I-}
reset(zadanija);
{$I+}
If ioresult<>0 then
Begin
rewrite(zadanija);
close(zadanija);
End;
reset(zadanija);
seek(zadanija,filesize(zadanija));
write(zadanija,z);
close(zadanija);
writeln(' Novoe zadanie dobavleno');
writeln(' Najmi lyubuyu klavishu');
key:=readkey;
menu_pr;
end;

procedure password;
begin
clrscr;
repeat
writeln(' vvedi parol (123) Dlya vyhoda vvedi EXIT');
readln(pass);
if pass = 'EXIT' then menu;
write(' ERROR!! Parol nevernyi ');
until pass='123';
menu_pr;
end;
procedure menu_pr;
begin
repeat
clrscr;
writeln(' 1. Vvod novyh zadanii');
writeln(' 2. Prosmotr i udalenie zadanii');
writeln(' 3. Otchet ');
writeln(' 4. Vyhod');
key:=readkey;
until (key>='1') and (key<='4');
case key of
'1': vvod;
'2': prosmotr;
'3': otchet;
'4': menu;
end;
end;




procedure regim2;
begin
CLRSCR;
assign(zadanija,'zadanija');
{$I-}
reset(zadanija);
close(zadanija);
{$I+}
if IOResult <> 0 then
begin
writeln('ERROR!!');
writeln('Vvedi zadaniya dlya testa');
writeln;
writeln('Najmi lyubuyu knopku');
key:=readkey;
menu;
end;
writeln('Vvedi familiyu:');
readln(stud.fam);
writeln('vvedi nomer gruppy');
repeat
{$I-}
readln(stud.gruppa);
{$I+}
Until (Ioresult=0) and (stud.gruppa>=1000) and (stud.gruppa<=9999);
writeln('Vy zaregistrirovalis');
writeln('najmite lyubuyu klavishu dlya nachala testa');
key:=readkey;
test;

end;
Defer вне форума Ответить с цитированием
Старый 25.01.2009, 20:01   #3
Defer
 
Регистрация: 25.01.2009
Сообщений: 3
По умолчанию продолжение

procedure test;

var
otvet,vop:byte;
m: array [1..4] of byte;
n,k1,stball:byte;
Hour,min,sec,sec100,time:word;
time_hour,time_min,time_sec:word;
Otvet1:string;
Label 1;
begin
vop:=0;
stball:=0;
Assign(zadanija,'zadanija');
reset(zadanija);
gettime(Hour,min,sec,sec100);
time_sec:=filesize(zadanija)*15+sec ;
time:=filesize(zadanija)*15;
time_min:=min;
time_hour:=hour;
if time_sec>=60 then
begin
inc(min);
time_min:=min;
time_sec:=time_sec-60;
if time_min>=60 then
begin
inc(hour);
time_hour:=hour;
time_min:=time_min-60;
end;
end;
repeat
read(zadanija,z);
clrscr;
writeln('na kajdoe zadanie otvedeno 15sek');
writeln('poetomu vsego u vas ',time,' sek');
writeln(z.vopros);

if z.tip=1 then
begin
randomize;
writeln;
writeln('otvety:');
for n:=1 to 4 do
begin
1: m[n]:=random(5);
for k1:=1 to (n-1) do
if m[n]=m[k1] then goto 1;
if m[n]=0 then goto 1;
if m[n]=1 then otvet:=n;
writeln(z.otvet[m[n]]);
end;
writeln('Vvedi № pravilnogo otveta');
writeln('Najmi Esc dlya vyhoda iz testa');
repeat
key:=readkey;
until ((key>='1') and (key<='5') or (key=#27));
case key of
'1'..'5':begin
Str(otvet,otvet1);
If key=otvet1 then
begin
stball:=stball+z.ball;
inc(vop);
end;
end;
#27:menu;
end;
end;
if z.tip=2 then
begin
writeln('Vvedi otvet ');
writeln('Vvedi EXIT dlya vyhoda iz testa');
readln(otvet1);
if otvet1=z.otvet[1] then
begin
stball:=stball+z.ball;
inc(vop);
end;
if otvet1='EXIT' then menu;
end;
gettime(hour,min,sec,sec100);
until (hour*10000+min*100+sec>=time_hour* 10000+time_min*100+time_sec) or (eof(zadanija));
clrscr;
if (hour*10000+min*100+sec>=time_hour* 10000+time_min*100+time_sec) and (not eof(zadanija)) then
writeln('vremja isteklo')
else writeln('vy proshli test!');
writeln('Vy nabrali ', stball,' ballov');
writeln('pravilnyh otvetov: ',vop);
stud.ocenka:=stball;
assign(students,'students');
{$I-}
Reset(students);
{$I+}
if IOResult <> 0 then
begin
rewrite(students);
close(students);
end;
reset(students);
seek(students,filesize(students));
write(students,stud);
close(students);
writeln('najmi lyubuyu klavishu');
key:=readkey;
menu;
end;

begin
menu
end.
Defer вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
ПОМОГИТЕ СРОЧНО!!!ЗАВТРА СДАТЬ УЖЕ(((( olview Microsoft Office Excel 4 29.05.2008 21:35
Помогите по паскалю завтра сдавать иначе выгонят!!!!! Кристина Паскаль, Turbo Pascal, PascalABC.NET 10 13.01.2007 23:05