![]() |
|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
![]() |
|
Опции темы | Поиск в этой теме |
![]() |
#1 |
Регистрация: 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; |
![]() |
![]() |
![]() |
#2 |
Регистрация: 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; |
![]() |
![]() |
![]() |
#3 |
Регистрация: 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. |
![]() |
![]() |
![]() |
![]() |
||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
ПОМОГИТЕ СРОЧНО!!!ЗАВТРА СДАТЬ УЖЕ(((( | olview | Microsoft Office Excel | 4 | 29.05.2008 21:35 |
Помогите по паскалю завтра сдавать иначе выгонят!!!!! | Кристина | Паскаль, Turbo Pascal, PascalABC.NET | 10 | 13.01.2007 23:05 |