Приложение 4. Листинг контролирующей программы.

cgi_res.pas

{$N+}

program cgi_res;

uses SysUtils;

const

INPUTS = 12;

HIDDEN1 = 12;

OUTPUTS = 4;

HIDDEN1_INDEX = INPUTS;

OUTPUT_INDEX = HIDDEN1_INDEX+HIDDEN1;

NUMNEURONS = INPUTS+HIDDEN1+OUTPUTS;

var

NEURON:array[0..NUMNEURONS-1]of double;

ans:array[1..INPUTS]of string[1];

h:array[1..INPUTS]of string[3];

check_in:array[0..INPUTS-1]of double;

check_out:array[0..OUTPUTS-1]of double;

st,in_str,fio,grp:string;

i,max:byte;

(* Weight arrays *)

const W_In_H1:array[0..HIDDEN1-1,0..INPUTS+1-1]of double = (

(0.109022, -0.0539257, -0.368034, -0.471941, -0.14011, 2.33927, -0.909139,

-0.322244, -1.40411, -0.195163, -0.184279, -0.124136, 0.314774),

(-0.715285, -1.01007, -0.896435, -1.04527, -0.986676, -0.492673, -1.27935,

-0.760259, -0.83849, -0.470172, -0.635299, -0.722786, 1.68905),

(0.781771, 0.585087, 0.698981, 0.0769728, 0.849104, 1.3434, 0.677218,

0.16054, -2.58012, -0.126845, -0.0477314, -0.0215265, -0.341294),

(-0.115014, -0.299009, -0.386707, -0.00167638, 0.00157645, -0.568074, -0.0401864,

-0.175029, 0.050284, 0.00745735, 0.0164164, -0.313791, 0.516574),

(1.69567, -0.00457102, -0.0258746, -2.53526, -0.0675847, 2.03239, -0.611646,

0.11374, 0.326477, 3.3361, -0.307153, -0.0233276, -0.101178),

(0.323127, 0.453094, 1.43307, -1.17937, -1.30469, -0.739903, -1.17307,

-0.0469102, 1.16848, -2.81881, 0.203912, -1.46856, 0.127351),

(-0.168771, -0.052278, -0.0937404, 0.138683, -0.394373, -0.0080455, -0.665677,

-0.0575857, -0.390231, -0.077412, 0.133436, -0.0252823, 0.147023),

(-0.562288, -2.02446, -6.6931, -0.218433, -0.0113713, 0.724795, 0.0589764,

-0.530525, 0.0380381, 1.67573, -1.0224, -1.14925, 0.438447),

(0.698312, -0.0160047, 1.53373, -1.44304, -0.4157, 2.64013, -0.818845,

0.862477, 5.69266, -0.957385, -0.0989055, -0.580727, -0.00278491),

(-1.52924, 0.347028, -0.242113, 0.252351, 0.798555, -0.280498, 0.53143,

0.597981, 4.06578, 0.815546, 1.94425, -0.444688, -0.0898223),

(-0.0374775, -0.471714, -0.0143863, -0.27478, -0.0654873, -0.163415, -0.0978362,

-0.384747, 0.0309396, -0.00209866, -0.243247, -0.470842, 0.498723),

(-0.0497225, -0.0284349, 0.0242167, -2.14155, -0.00824269, -0.0183397, 0.103547,

0.0900314, 0.0350896, -0.0246594, -1.62929, 0.108472, 0.211198)

);

const W_H1_Out:array[0..OUTPUTS-1,0..HIDDEN1+1-1]of double = (

(-0.0417788, 12.4763, -0.0492676, -0.692518, 0.170335, -0.956991, -0.0457157,

-0.853115, 0.0116715, -2.03634, -0.505628, -0.0066435, -0.0376796),

(-2.29736, -22.4874, 0.600889, 1.61897, -0.813111, 8.56052, 0.00762325, 8.00798,

-2.84516, 0.0328812, 2.55626, 1.1535, -0.0463112),

(10.4161, -12.1323, -6.40036, 5.11533, -0.111914, -10.3867, 0.0734312, -11.4413,

-0.0479404, -0.0105011, 2.59167, 2.88688, -0.0289983),

(-5.28685, 0.0179245, 3.75147, -2.29328, 1.07041, 3.82189, -7.86089, -4.68059,

1.79581, 0.82398, -9.13616, -4.97627, 0.219971)

);

(* Nonlinearity functions *)

function sigmoid(x:double):double;

begin

sigmoid:=1.0/(1.0+exp(-x));

end;

(* Compute the network response

* Arguments:

* inpts (double) array containing the input values

* outpts (double) array which receives the results

*)

procedure eval_net(var inpts,outpts:array of double);

var i,j:integer;

begin

{ /* Zero neuron sums */}

for i:=0 to NUMNEURONS-1 do NEURON[i] := 0.0;

{ /* Apply inpts */}

for i:=0 to INPUTS-1 do NEURON[i] := inpts[i];

{ /* Compute hidden layer #1 */}

for i:=0 to HIDDEN1-1 do

begin

for j:=0 to INPUTS-1 do

begin

NEURON[HIDDEN1_INDEX + i]:=NEURON[HIDDEN1_INDEX + i]+

NEURON[j]*W_In_H1[i][j];

end;

NEURON[HIDDEN1_INDEX + i]:=NEURON[HIDDEN1_INDEX + i] +W_In_H1[i][INPUTS];

NEURON[HIDDEN1_INDEX + i]:= sigmoid( NEURON[HIDDEN1_INDEX + i] );

end;

{ /* Compute network outputs */}

for i:=0 to OUTPUTS-1 do

begin

for j:=0 to HIDDEN1-1 do

begin

NEURON[OUTPUT_INDEX + i] :=NEURON[OUTPUT_INDEX + i] +NEURON[HIDDEN1_INDEX + j]*W_H1_Out[i][j];

end;

NEURON[OUTPUT_INDEX + i] := NEURON[OUTPUT_INDEX + i]+W_H1_Out[i][HIDDEN1]; {/* BIAS */}

NEURON[OUTPUT_INDEX + i] := sigmoid( NEURON[OUTPUT_INDEX + i] );

end;

{ /* Copy outputs to outpt array */}

for i:=0 to OUTPUTS-1 do

outpts[i] := NEURON[OUTPUT_INDEX + i];

end;

Procedure Head;

begin

writeln('Content-type: text/html ');writeln('');

writeln('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">');

writeln('<HTML><HEAD><TITLE> Результаты теста</TITLE></HEAD><BODY>');

write('<p><font size=5 ><center><i> Вы закончили финальный тест!</i><p></center></FONT>');

end;

Procedure Fin;

begin

writeln('</BODY></HTML>');

end;

procedure Analize;

var buf:string;

begin

buf:='';

read(input,in_str);st:=in_str;

for i:=1 to INPUTS do begin

buf:='rad'+IntToStr(i)+'=';

if pos(buf,st) > 0 then delete(st,pos(buf,st),length(buf));

ans[i]:=copy(st,1,pos('&',st)); delete(st,1,pos('&',st));

write(st,'<p>');}

end; {for}

if pos('hid=',st) > 0 then delete(st,pos('hid=',st),length('hid='));

for i:=1 to INPUTS do begin

h[i]:=st[1+3*(i-1)];

end;

delete(st,1,pos('+',st)); delete(st,1,6);

fio:=copy(st,1,pos('%',st)-1); delete(st,1,pos('grp',st)+5);

grp:=st;

for i:=1 to INPUTS do

if ans[i]=h[i] then check_in[i-1]:=1

else check_in[i-1]:=0;

eval_net(check_in,check_out);

end;

BEGIN

HEAD;

ANALIZE;

write('<h3> Испытуемый: ',fio,' <p>');

write(' группа : ',grp,' <p>');

max:=0;

for i:=0 to OUTPUTS-1-1 do

if check_out[max]>check_out[i+1] then max:=max

else max:=i+1;

case max of

0:begin

write('<h3> Ваша оценка - <FONT SIZE=6>2 (=+ L-+TT+TT+¦LT+T-=+)</FONT> <p></h3>')

end;

1:begin

write('<h3> Ваша оценка - <FONT SIZE=6>3 (L-+TT+TT+¦LT+T-=+)</FONT> <p></h3>')

end;

2:begin

write('<h3> Ваша оценка - <FONT SIZE=6>4 (-+¦+++)</FONT> <p></h3>')

end;

3:begin

write('<h3> Ваша оценка - <FONT SIZE=6>5 (+TTL+=+)</FONT> <p></h3>')

end;

end; {case}

FIN;

END.

cgi_form.pas

program cgi_form;

uses SysUtils;

const v1='v1';

v2='v2';

v3='v3';

v4='v4';

v5='v5';

v6='v6';

a1='1';

a2='2';

a3='3';

type mas=array[1..3,0..3]of byte;

var st,

in_str,

name,

fio,

grp,

file_name,

a:string;

f:text;

q_num:integer;

y,

ind,

cal:byte;

quest_mas:mas;

h:array[1..12]of string[3];

Procedure Error;

begin

writeln('Content-type: text/html ');

writeln('');

writeln('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">');

writeln('<HTML><HEAD><TITLE>PAZiC </TITLE></HEAD><BODY bgcolor=#FF0000>');

writeln('<H1>Error- Ошибка!!!</H1>');

writeln('</BODY></HTML>');

end;

Procedure Head;

begin

writeln('Content-type: text/html ');writeln('');

writeln('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">');

writeln('<HTML><HEAD><TITLE>Контрольные вопросы</TITLE></HEAD><BODY>');

write('<form method=post action="/advcgi/cgi-res.exe">');

end;

Procedure Fin;

begin

write('<center><P align=center> <INPUT type="submit" value="Проверь cебя "></p></center>');

writeln('</BODY></HTML>');

end;

Procedure Analize_Name;

begin

name:='';

read(input,in_str); st:=in_str;

delete(st,1,(pos('fam=',st)+3));

name:=copy(st,1,pos('&grp=',st)-1); fio:=name;

delete(st,1,(pos('&grp=',st)+4)); grp:=st;

name:=name+' '+st;

end;

Procedure Point_Q (ind:byte);

var buf:string; i,probel:word;

begin

reset(f); readln(f,buf); probel:=ind+3*(ind-1); i:=0;

while not (eof(f)) do begin

readln(f,buf);

if buf='' then i:=i+1;

if i=probel then break;

end;

end;

Procedure Point_A(n:byte);

var buf:string; i:word;

begin

i:=0;

while not (eof(f)) and (i<>n) do begin

readln(f,buf);

if buf='' then i:=i+1;

end;

end;

Procedure Wr;

var buf:string;

begin

buf:='Buffer';

while not (eof(f)) and (buf<>'') do begin

readln(f,buf);

writeln(buf);

end;

end;

Procedure Init(q:byte; var q_m:mas);

var i:byte;

begin

if q < 3 then begin

repeat q_m[1,0]:=random(3); until q_m[1,0]<>0;{1- question find randomly}

repeat q_m[1,1]:=random(4); until q_m[1,1]<>0;{1- answer find randomly}

repeat q_m[1,2]:=random(4);

until (q_m[1,2]<>q_m[1,1])and(q_m[1,2]<>0);

q_m[1,3]:=3-(q_m[1,1]+q_m[1,2])+3;

q_m[2,0]:=2-q_m[1,0]+1;{2-last question}

repeat q_m[2,1]:=random(4); until q_m[2,1]<>0;{1- answer find randomly}

repeat q_m[2,2]:=random(4);

until (q_m[2,2]<>q_m[2,1])and(q_m[2,2]<>0);

q_m[2,3]:=3-(q_m[2,1]+q_m[2,2])+3;

for i:=0 to 3 do q_m[3,i]:=0;

end

else begin

repeat q_m[1,0]:=random(q_num+1); until (q_m[1,0]<>0);{1- question find randomly}

repeat q_m[2,0]:=random(q_num+1); until (q_m[2,0]<>q_m[1,0])and(q_m[2,0]<>0);{1- question find randomly}

repeat q_m[3,0]:=random(q_num+1);

until (q_m[3,0]<>q_m[2,0])and(q_m[3,0]<>q_m[1,0])and(q_m[3,0]<>0);{1- question find randomly}

for i:=1 to 3 do begin

repeat q_m[i,1]:=random(4); until q_m[i,1]<>0;{1- answer find randomly}

repeat q_m[i,2]:=random(4); until (q_m[i,2]<>q_m[i,1])and(q_m[i,2]<>0);

q_m[i,3]:=3-(q_m[i,1]+q_m[i,2])+3;

end;

end;

end;

Function Hide(right:byte):string;

var s:word;

begin

if right = 1 then repeat s:=random(200); until (s> 100);

if right = 2 then repeat s:=random(300); until (s> 200);

if right = 3 then repeat s:=random(400); until (s> 300);

Hide:=IntToStr(s);

end;

begin

randomize;

Analize_Name;

cal:=0;

Head;

write('<p><font size=5><center><i>',fio,', Вам необходимо ответить на следующие вопросы:</i><p></center>');

write('<center>');

write('<table width=100% ');

write('border=3 bordercolor=#FFFFFF bordercolordark=#FFFFFF bordercolorlight=#FFFFFF>');

for ind:=1 to 6 do begin

if ind=1 then file_name:=v1;

if ind=2 then file_name:=v2;

if ind=3 then file_name:=v3;

if ind=4 then file_name:=v4;

if ind=5 then file_name:=v5;

if ind=6 then file_name:=v6;

{$I-}

assign(f,file_name); reset(f);

if ioresult<>0 then begin Error; exit end;

{$I+}

readln(f,st); q_num:=StrToInt(st);{Read questions number}

Init(q_num,quest_mas);

for y:=1 to 2 do begin

if quest_mas[y,0]=0 then break;

inc(cal);

write('<tr><td>');

a:='rad'+IntToStr(cal);

Point_Q(quest_mas[y,0]); write(IntToStr(cal),'. ');Wr;

write('</td>');

write('<td>');

write('<input type=radio name="',a,'" value="',a1,'">');

Point_Q(quest_mas[y,0]); Point_A(quest_mas[y,1]); Wr;

write('<br>');

write('<input type=radio name="',a,'" value="',a2,'">');

Point_Q(quest_mas[y,0]); Point_A(quest_mas[y,2]);Wr;

write('<br>');

write('<input type=radio name="',a,'" value="',a3,'">');

Point_Q(quest_mas[y,0]); Point_A(quest_mas[y,3]);Wr;

write('<br>');

write('</td>');

{Which question is right}

if quest_mas[y,1] = 1 then h[{y}cal]:=Hide(1);

if quest_mas[y,2] = 1 then h[{y}cal]:=Hide(2);

if quest_mas[y,3] = 1 then h[{y}cal]:=Hide(3);

end;

write('</tr>');

close(f);

end;

write('</table></center>');

st:='';

for y:=1 to 12 do st:=st+h[y];

write('<input type=hidden name="hid" Value="',st,' ',in_str{file_name},'">');

Fin

end.

cgi_file.pas

program cgi_file;

uses SysUtils;

type mas=array[1..3,0..3]of byte;

var st,in_str,instr,file_name,a,a1,a2,a3:string;

f:text; q_num:integer; y,cal:byte;

quest_mas:mas;h:array[1..3]of string[3];

Procedure Error;

begin

writeln('Content-type: text/html ');

writeln('');

writeln('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">');

writeln('<HTML><HEAD><TITLE>PAZiC </TITLE></HEAD><BODY bgcolor=#FF0000>');

writeln('<H1>Error-+Ошибка!!!</H1>');

writeln('</BODY></HTML>');

end;

Procedure Head;

begin

writeln('Content-type: text/html ');writeln('');

writeln('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">');

writeln('<HTML><HEAD><TITLE> Промежуточные вопросы</TITLE></HEAD><BODY>');

write('<p><font size=5><center><i>Для продолжения обучения,<p>Вам необходимо ответить на следующие вопросы:</i><p></center>');

write('<form method=post action="/advcgi/cgi-an.exe">');

end;

Procedure Fin;

begin

write('<center><P align=center> <INPUT type="submit" value="¦ЁютхЁ№ Tхс "></p></center>');

writeln('</BODY></HTML>');

end;

Procedure Analize_File_Name;

begin

file_name:='';

read(input,in_str); st:=in_str; instr:=in_str;

delete(in_str,1,4);

if pos('hid=',st) > 0 then delete(st,1,(pos('hid=',st)+3));

if pos('+',st) > 0 then delete(st,pos('+',st),length(st));

file_name:=st;

end;

Procedure Point_Q (ind:byte);

var buf:string; i,probel:word;

begin

reset(f); readln(f,buf); probel:=ind+3*(ind-1); i:=0;

while not (eof(f)) do begin

readln(f,buf);

if buf='' then i:=i+1;

if i=probel then break;

end;

end;

Procedure Point_A(n:byte);

var buf:string; i:word;

begin

i:=0;

while not (eof(f)) and (i<>n) do begin

readln(f,buf);

if buf='' then i:=i+1;

end;

end;

Procedure Wr;

var buf:string;

begin

buf:='Buffer';

while not (eof(f)) and (buf<>'') do begin

readln(f,buf);

writeln({fo,}buf);

end;

end;

Procedure Init(q:byte; var q_m:mas);

var i:byte;

begin

if q < 3 then begin

repeat q_m[1,0]:=random(3); until q_m[1,0]<>0;{1- question find randomly}

repeat q_m[1,1]:=random(4); until q_m[1,1]<>0;{1- answer find randomly}

repeat q_m[1,2]:=random(4);

until (q_m[1,2]<>q_m[1,1])and(q_m[1,2]<>0);

q_m[1,3]:=3-(q_m[1,1]+q_m[1,2])+3;

q_m[2,0]:=2-q_m[1,0]+1;{2-last question}

repeat q_m[2,1]:=random(4); until q_m[2,1]<>0;{1- answer find randomly}

repeat q_m[2,2]:=random(4);

until (q_m[2,2]<>q_m[2,1])and(q_m[2,2]<>0);

q_m[2,3]:=3-(q_m[2,1]+q_m[2,2])+3;

for i:=0 to 3 do q_m[3,i]:=0;

end

else begin

repeat q_m[1,0]:=random(q_num+1); until (q_m[1,0]<>0);{1- question find randomly}

repeat q_m[2,0]:=random(q_num+1); until (q_m[2,0]<>q_m[1,0])and(q_m[2,0]<>0);{1- question find randomly}

repeat q_m[3,0]:=random(q_num+1);

until (q_m[3,0]<>q_m[2,0])and(q_m[3,0]<>q_m[1,0])and(q_m[3,0]<>0);{1- question find randomly}

for i:=1 to 3 do begin

repeat q_m[i,1]:=random(4); until q_m[i,1]<>0;{1- answer find randomly}

repeat q_m[i,2]:=random(4); until (q_m[i,2]<>q_m[i,1])and(q_m[i,2]<>0);

q_m[i,3]:=3-(q_m[i,1]+q_m[i,2])+3;

end;

end;

end;

Function Hide(right:byte):string;

var s:word;

begin

if right = 1 then repeat s:=random(200); until (s> 100);

if right = 2 then repeat s:=random(300); until (s> 200);

if right = 3 then repeat s:=random(400); until (s> 300);

Hide:=IntToStr(s);

end;

begin

randomize;

Analize_File_Name;

{$I-}

assign(f,file_name); reset(f);

if ioresult<>0 then begin Error; exit end;

{$I+}

Head;

readln(f,st); q_num:=StrToInt(st);{Read questions number}

Init(q_num,quest_mas);

write('<center>');

write('<table width=100% ');

write('border=3 bordercolor=#FFFFFF bordercolordark=#ffffff bordercolorlight=#FFFFFF>');

for y:=1 to 3 do begin

if quest_mas[y,0]=0 then break;

inc(cal);

write('<tr><td>');

a:='rad'+IntToStr(y);

a1:='1';

a2:='2';

a3:='3';

Point_Q(quest_mas[y,0]); write(IntToStr(cal),'. '); Wr;

write('</td>');

write('<td>');

write('<input type=radio name="',a,'" value="',a1,'">');

Point_Q(quest_mas[y,0]); Point_A(quest_mas[y,1]); Wr;

write('<br>');

write('<input type=radio name="',a,'" value="',a2,'">');

Point_Q(quest_mas[y,0]); Point_A(quest_mas[y,2]);Wr;

write('<br>');

write('<input type=radio name="',a,'" value="',a3,'">');

Point_Q(quest_mas[y,0]); Point_A(quest_mas[y,3]);Wr;

write('<br>');

write('</td>');

{Which question is right}

if quest_mas[y,1] = 1 then h[y]:=Hide(1);

if quest_mas[y,2] = 1 then h[y]:=Hide(2);

if quest_mas[y,3] = 1 then h[y]:=Hide(3);

end;

write('</tr></table>');

write('</center>');

write('<input type=hidden name="hid" Value="',h[1],h[2],h[3],' ',in_str{file_name},'">');

close(f);

Fin

end.

cgi_an.pas

program cgi_an;

var st,in_str,hid,ff:string;

h,ans_mas:array[1..3]of string[3];

Procedure Head;

begin

writeln('Content-type: text/html ');writeln('');

writeln('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">');

writeln('<HTML><HEAD><TITLE>Результат</TITLE></HEAD><BODY>');

end;

Procedure Fin;

begin

writeln('</BODY></HTML>');

end;

function Analize:boolean;

var i,j:byte;buf,bf:string;

begin

read(input,in_str);

st:=in_str;

if pos('hid=',st) > 0 then begin

buf:=copy(st,(pos('hid=',st)+4),length(st));

bf:=copy(buf,1,(pos('+',buf)-1));

ff:=copy(st,(pos('%2B',st)+3),((pos('.htm',st)+4)- (pos('%2B',st)+3)) );

delete(st,pos('hid=',st),length(st));

if length(bf)=3 then begin j:=1; h[2]:=' '; h[3]:=' ';end;

if length(bf)=6 then begin j:=2; h[3]:=' ';end;

if length(bf)=9 then j:=3;

for i:=1 to j do h[i]:=copy(bf,(i+2*(i-1)),(i+2*(i-1))+2);

delete(buf,1,(pos('+',buf))); delete(buf,pos('%2B',buf),length(buf));

hid:=buf;

if hid[1]='l' then delete(hid,1,1);

end;

if pos('rad1=',st) > 0 then begin

buf:=copy(st,(pos('rad1=',st)+5),(pos('&',st)-6));

{delete(buf,1,6);} delete(st,1,pos('&',st));

ans_mas[1]:=buf;

end;

if pos('rad2=',st) > 0 then begin

buf:=copy(st,(pos('rad2=',st)+5),pos('&',st)-6);

delete(st,1,pos('&',st));

ans_mas[2]:=buf;

end

else ans_mas[2]:=' ';

if pos('rad3=',st) > 0 then begin

buf:=copy(st,(pos('rad3=',st)+5),pos('&',st)-6);

delete(st,1,pos('&',st));

ans_mas[3]:=buf;

end {if}

else ans_mas[3]:=' ';

if (ans_mas[1]=h[1][1])and(ans_mas[2]=h[2][1])and(ans_mas[3]=h[3][1]) then

Analize:=true

else Analize:=false;

end;

begin

Head;

if Analize then begin

write('<p><center><font size=5><i> Вы абсолютно правы! </i><p>');

write('<p><center><font size=5> Продолжаем обучение... <p>');

write('<meta http-equiv="Refresh" content="2; url=/',ff,'">');

write('<a href="http://158.250.47.76/',ff,' "TARGET=_MAIN>Ok</a></center>');

end

else begin

write('<p><center><font size=5> Вам надо повторить материал<p>');

write('<meta http-equiv="Refresh" content="2; url=http://158.250.47.76/',hid,'.htm">');

write('<a href="http://158.250.47.76/',hid,'.htm">Ok</a> </center>');

end;

Fin

end.

179