Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms

************ Modul *********
unit Modul;
interface
USES Dialogs, SysUtils;
TYPE
TQuestion = record
Question: String;
Answers: array of String;
RightAnswer: integer;
end;
VAR
LOfQStr:string;
TestString: String;
HtmlBegin, HtmlEnd, HtmlTitle: String;
CurDir:String;
PathOfTestFile: String;
HeadString: String;
BodyString: String;
BodyBeginString, BodyEndString: String;
Questions: array of TQuestion;
//List: array of String;
LOfQ : array of integer; //Links Of Questions - ññûëêè íà âîïðîñû
COfQ : integer; //Count Of Questions - êîëè÷åñòâî âîïðîñîâ â îäíîì òåñòå
AllQ : integer; //All Questions - êîëè÷åñòâî âñå âîïðîñîâ
CurQ: integer;//Current Question - òåêóùèé âîïðîñ
OneTest: array of TQuestion;
LinksOfOneTest: array of integer;
i,j,k,m,n: integer;
Procedure GetQuestions;
Procedure GetTest;
implementation
uses Unit1, Math, Start;
PROCEDURE GetTest;
var
tmpj, tmpi:integer;
tmpCurQ: integer;
tmpAns: String;
FileHtml: TextFile;
BEGIN
{---------Ãåíåðàöèÿ ñëó÷àéíûõ âîïðîñîâ îäíîãî òåñòà-----------------}
Randomize;
if CurQ = -1 then CurQ := AllQ - 1;//Âñå âîïðîñû óæå èñïîëüçîâàíû, òî íà÷èíàåì ïåðåáîð çàíîâî
IF CurQ >= COfQ - 1 then //êîëè÷åñòâî îñòàâøèõñÿ âîïðîñîâ áîëüøå êîëè÷åñòâà âîïðîñîâ â îäíîì òåñòà
Begin
tmpCurQ := CurQ;
for CurQ := tmpCurQ downto tmpCurQ - COfQ + 1 do
begin
Randomize;
tmpj := random(CurQ);
tmpi := LOfQ[tmpj];
LOfQ[tmpj] := LOfQ[CurQ];
LOfQ[CurQ] := tmpi;
end;
End
ELSE //If CurQ < COfQ - 1 then
Begin //êîëè÷åñòâî îñòàâøèõñÿ âîïðîñîâ ìåíüøå, ÷åì êîëè÷åñòâà âîïðîñîâ â îäíîì òåñòà
Randomize;
for tmpi := 0 to CurQ do LOfQ[AllQ-1-tmpi] := LOfQ[CurQ - tmpi];
for tmpi := 0 to AllQ-2-CurQ do LOfQ[tmpi] := tmpi;
for tmpi := AllQ-2-CurQ to AllQ-1 do LOfQ[LOfQ[tmpi]] := tmpi;
for tmpCurQ := AllQ-2-CurQ downto AllQ-COfQ do
if LOfQ[CurQ] = CurQ then
begin
Randomize;
tmpj := random(tmpCurQ);
tmpi := LOfQ[tmpj];
LOfQ[tmpj] := LOfQ[tmpCurQ];
LOfQ[tmpCurQ] := tmpi;
end;
CurQ := AllQ - COfQ - 1;
End;
{-------Âñå âîïðîñû îäíîãî òåñòà êîïèðóþòñÿ â OneTest----------}
OneTest := nil;
SetLength(OneTest, COfQ);
LOfQStr := '';
for tmpi:=1 to COfQ do
Begin
m := LOfQ[CurQ + tmpi];
LOfQStr := LOfQStr + IntToStr(m+1)+';' ;
OneTest[tmpi-1] := Questions[m];
OneTest[tmpi-1].Answers := Copy(Questions[m].Answers);
OneTest[tmpi-1].RightAnswer := 0
End;
{----------Ñëó÷àéíîå ïåðåìåøèâàíèå îòâåòîâ â âîïðîñàõ îäíîãî òåñòà-------}
for i := 0 to COfQ-1 do
Begin
j := Length(OneTest[i].Answers);
Randomize;
repeat
k := random(j);
dec(j);
tmpAns := OneTest[i].Answers[j];
OneTest[i].Answers[j] := OneTest[i].Answers[k];
OneTest[i].Answers[k] := tmpAns;
Randomize;
until (k = 0)or( j = 0);
if k = 0 then OneTest[i].RightAnswer := j;
End;
{-----------Ãåíåðàöèÿ html ôàéëà îäíîãî òåñòà-------------}
TestString := '';
TestString := HtmlBegin;
TestString := TestString + ''+#13#10;
TestString := TestString + ''+#13#10;
for i := 0 to Length(OneTest)-1 do
Begin
TestString := TestString + ''+#13#10+' '+#13#10+' ' + #13#10;
TestString := TestString + ' ' + #13#10 + ' ' + #13#10;
TestString := TestString + ''+#13#10;
End;
TestString := TestString + '

	'+#13#10 + ' '+#13#10; m := pos('>',OneTest[i].Question); Insert(IntToStr(i+1) + ') ', OneTest[i].Question, m+1); TestString := TestString + {' ' +} OneTest[i].Question + ' '+#13#10; for j := 0 to Length(OneTest[i].Answers)-1 do begin m := pos('>', OneTest[i].Answers[j]); Insert(chr(65+j) + ') ', OneTest[i].Answers[j], m+1); TestString := TestString + ' ' + OneTest[i].Answers[j] + ' ' + #13#10; end; TestString := TestString + ' ' + #13#10 + '	' + #13#10; for j := 0 to Length(OneTest[i].Answers)-1 do TestString := TestString + ' ' + chr(65+j) + ') ' + #13#10; TestString := TestString + '

'+#13#10;
TestString := TestString + HtmlEnd;
//ShowMessage(TestString);
//Çàïèñü TestString íà äèñê
//AssignFile(FileHtml, CurDir + '\temp.htm');
//Rewrite(FileHtml);
// Writeln(FileHtml, TestString);
//CloseFile(FileHtml);
//TestString := '';
//Form1.WebBrowser1.Navigate(CurDir + '\temp.htm');
//Form1.WebBrowser1.
//ShowMessage(OneTest[0].Answers[0]);
END;
PROCEDURE GetQuestions;
var
ae: char;
tmpAns: String;
TestFile, TestFile1: TextFile;
COfA: integer;
BeginString, EndString: integer;
StringOfTestFile: String;
BEGIN
{--------Çàãðóçêà òåñòà èç ôàéëà---------}
TestString := '';
if FileExists(PathOfTestFile) then
Begin
AssignFile(TestFile, PathOfTestFile);
{$I-}
Reset(TestFile);
{$I+}
if IOResult = 0 then
begin
//ShowMessage(IntToStr(ord(ae)));
while not(Eof(TestFile))do
Begin
//read(TestFile, ae);
//TestString := TestString + ae;
//ShowMessage(ae + ' - ' + IntToStr(ord(ae)));
ReadLn(TestFile, StringOfTestFile);
TestString := TestString + StringOfTestFile + #13#10;
End;
CloseFile(TestFile);
end else ShowMessage('Äîñòóï ê ôàéëó çàïðåù¸í');
StringOfTestFile := '';
End else ShowMessage('Ôàéë íå ñóùåñòâóåò');
//AssignFile(TestFile, 'C:\TempFull.htm');
//Rewrite(TestFile);
//Write(TestFile, #13);
// for i := 0 to 255 do Write(TestFile, Chr(i));
//Write(TestFile, TestString);
//CloseFile(TestFile);
{------Äåëåíèå òåñòà íà íà÷àëî (HtmlBegin), êîíåö (HtmlEnd) è ñåðåäèíó (BodyString)------}
i := Pos('
HtmlBegin := copy(TestString,1,i-1);
j := Length(TestString);
while (j >= 3)and not((TestString[j-2] = '<')and(TestString[j-1] = '/')
and(TestString[j] = 'p')and(TestString[j+1] = '>')) do dec(j);
BodyString := copy(TestString, i, j+2-i);
HtmlEnd := copy(TestString,j+3,Length(TestString));
{------Ïîëó÷åíèå âîïðîñîâ èç BodyString------}
AllQ := 0;
//Êîëè÷åñòâî âñåõ âîïðîñîâ
for i:=1 to length(BodyString)-6 do
if (BodyString[i] = #0169) then inc(AllQ);
SetLength(Questions, AllQ);
//Ïî óìîë÷àíèþ RightAnswer=0
for i := 0 to Length(Questions)-1 do Questions[i].RightAnswer := 0;
//Êîëè÷åñòâî îòâåòîâ â êàæäîì âîïðîñå
COfA := 0;
j := AllQ;
for i := length(BodyString)-1 downto 1 do
begin
if BodyString[i] = #0169 then
begin
dec(j);
SetLength(Questions[j].Answers, COfA);
COfA := 0;
end;
if BodyString[i] = #0174 then inc(COfA);
end;
//Ïîëó÷åíèå âñåõ âîïðîñîâ è îòâåòîâ ê íèì
BeginString := length(BodyString);
EndString := BeginString + 1;
for i := Length(Questions)-1 downto 0 do
begin
for j := Length(Questions[i].Answers)-1 downto 0 do
begin
while (BodyString[BeginString] <> #0174) do dec(BeginString); //#0174 = ®
if BodyString[BeginString+1] = '_' then Questions[i].RightAnswer := j;
dec(BeginString);
while not((BodyString[BeginString-3] = '<')and(BodyString[BeginString-2] = '/')
and(BodyString[BeginString-1] = 'p')and(BodyString[BeginString] = '>')) do dec(BeginString);
inc(BeginString);
Questions[i].Answers[j] := copy(BodyString, BeginString, EndString - BeginString);
EndString := BeginString;
end;
while (BodyString[BeginString] <> #0169) do dec(BeginString);
dec(BeginString);
while (BeginString >= 0) and not((BodyString[BeginString-3] = '<')and(BodyString[BeginString-2] = '/')
and(BodyString[BeginString-1] = 'p')and(BodyString[BeginString] = '>')) do dec(BeginString);
inc(BeginString);
Questions[i].Question := copy(BodyString, BeginString, EndString - BeginString);
EndString := BeginString;
end;
{------------Óäàëåíèå íåïå÷àòíûõ ñèìâîëîâ-----------}
for i:=0 to Length(Questions)-1 do
begin
while (Questions[i].Question[1] = #13#10) do Delete(Questions[i].Question, 1,1);
while (Questions[i].Question[Length(Questions[i].Question)] = #13#10) do Delete(Questions[i].Question, Length(Questions[i].Question), 1);
for j := 0 to Length(Questions[i].Answers)-1 do
begin
while (Questions[i].Answers[j][1] = #13#10) do Questions[i].Answers[j] := copy(Questions[i].Answers[j], 2, Length(Questions[i].Answers[j]));
while (Questions[i].Answers[j][Length(Questions[i].Answers[j])] = #13#10) do Questions[i].Answers[j] := copy(Questions[i].Answers[j], 1, Length(Questions[i].Answers[j])-1);
end;
end;
{------------Ïåðåíîñ ïðàâèëüíîãî îòâåòà íà ïåðâîå ìåñòî--------------}
for i := 0 to Length(Questions)-1 do
if Questions[i].RightAnswer <> 0 then
begin
j := Questions[i].RightAnswer;
tmpAns := Questions[i].Answers[j];
Questions[i].Answers[j] := Questions[i].Answers[0];
Questions[i].Answers[0] := tmpAns;
Questions[i].RightAnswer := 0;
end;
{------------Î÷èñòêà îò "óïðàâëÿþùèõ" ñèìâîëîâ ('®', '©', '®_')--------------}
for i:=0 to Length(Questions)-1 do
begin
k := pos('©', Questions[i].Question);
Delete(Questions[i].Question,k,1);
for j:=0 to Length(Questions[i].Answers)-1 do
begin
k := pos('®', Questions[i].Answers[j]);
if Questions[i].Answers[j][k+1] = '_' then
Delete(Questions[i].Answers[j],k,2)
else Delete(Questions[i].Answers[j],k,1);
end;
end;
{--------Íàçâàíèå òåñòà-----}
// i := 1;
//j := Length(HtmlBegin)-7;
//while (copy(HtmlBegin,i,7) <> '