begin
CurrenHLation:=DataSetForReport[StationNum];
WorkPath:=DataSetForReport[StationNum].WorkPath;
SumCount:=DataSetForReport[StationNum].QuestCount;
randomize;
if DataSetForReport[StationNum].PassedCount<SumCount then
begin
QUESTIONBASE. TransactionUser:=DataSetForReport[StationNum].Ip+' '+DataSetForReport[StationNum].Name+' '+DataSetForReport[StationNum].Group;
repeat
RNDQuestNum:=random(SumCount)+1; // Случайный номер вопроса
until not DataSetForReport[StationNum].Questions[RNDQuestNum].Passed;
if QUESTIONBASE. SetActiveWork (DataSetForReport[StationNum].UserWorkPathID. WorkID) then
if QUESTIONBASE. SetActiveTeacher (DataSetForReport[StationNum].UserWorkPathID. TeacherID) then
begin
TmpStr:=QUESTIONBASE. GetRandomFileBuilet(RNDQuestNum);
if TmpStr<>'' then // Случайный билет
// Найти верный ответ и послать по сети
begin
TrueAnsw:=QUESTIONBASE. GetTrueAnswerForBuilet(TmpStr);
// |–Вычисляем номер сокета клиента
// \/
SendQuestion (DecodeNumToSocketNum(StationNum), TmpStr, 0, TrueAnsw);
DataSetForReport[StationNum].OpenQuest:=RNDQuestNum;
DataSetForReport[StationNum].Questions[RNDQuestNum].Style:=0;
DataSetForReport[StationNum].Questions[RNDQuestNum].Passed:=False;
DataSetForReport[StationNum].Questions[RNDQuestNum].TrueAnswer:=TrueAnsw;
DataSetForReport[StationNum].Questions[RNDQuestNum].UserAnswer:=0;
end else ProblemWithData (Socket_, 'Error with Database');
end else ProblemWithData (Socket_, 'Error with Database');
end;
end;
//////////////////////
/////////////////////
////////////////////
procedure TServerForm. ComboBox1Change (Sender: TObject);
var fNames:textfile;
NameBuf:string;
NameCounter:byte;
begin
ListBox1. Clear;
AssignFile (fNames, 'Groups\'+ComboBox1. Items [ComboBox1. ItemIndex]+'.txt');
{$i-}
Reset(fNames);
NameCounter:=0;
While not Eof(fNames) do
begin
Readln (fNames, NameBuf);
ListBox1. Items. Add (IntToStr(NameCounter)+' '+NameBuf);
inc(NameCounter);
end;
Label5. Caption:=IntToStr(NameCounter);
CloseFile(fNames);
{$i+}
end;
procedure TServerForm. Timer2Timer (Sender: TObject);
begin
Panel2. Visible:=false;
Timer2. Enabled:=false;
end;
procedure TServerForm. StringGrid1DblClick (Sender: TObject);
var MPoint:TPoint;
begin
if StringGrid1. Cells [0, SelectedRow]<>'' then
begin
GetCursorPos(MPoint);
MPoint:=ScreenToClient(MPoint);
Label31. Caption:=DataSetForReport [SelectedRow-1].WorkName;
Label32. Caption:=DataSetForReport [SelectedRow-1].Teacher;
panel2. Top:=MPoint.Y;
panel2. Left:=MPoint.X;
panel2. Visible:=true;
timer2. Enabled:=True;
end;
end;
procedure TServerForm. Button3Click (Sender: TObject);
var ExtNameLen:byte;
NumName:string;
NumN: Word;
StrCQFile:string;
TrueAsw:byte;
begin
if not Panel3.visible then
begin
ExtNameLen:=Length (ExtractFileExt(CurrentQuestFile));
NumName:=ExtractFileName(CurrentQuestFile);
Delete (NumName, Length(NumName) – ExtNameLen+1, ExtNameLen);
try
CurrentQuestionNum:=StrToInt(NumName);
TrueAsw:=QUESTIONBASE. GetTrueAnswerForBuilet(CurrentQuestFile);
RadioGroup1. ItemIndex:=TrueAsw-1;
RadioGroup1. Show;
except
ShowMessage ('Это не файл билета');
exit;
end;
Image1. Picture. Bitmap. LoadFromFile(CurrentQuestFile);
Panel3.visible:=true;
Button3. Caption:='Закрыть';
end else
begin
Panel3.visible:=false;
RadioGroup1. Visible:=False;
Button3. Caption:='Просмотреть билет';
RadioGroup1. Hide;
end;
end;
procedure TServerForm. ShellListView1Change (Sender: TObject;
Item: TListItem; Change: TItemChange);
begin
Button3.enabled:=false;
if ShellListView1. ItemIndex>=0 then
begin
CurrentQuestFile:=ShellTreeView1. Path+'\'+PChar (ShellListView1. SelectedFolder. DisplayName);
if (AnsiUpperCase (ExtractFileExt(CurrentQuestFile))=AnsiUpperCase ('.bmp')) or (AnsiUpperCase(ExtractFileExt(CurrentQuestFile))=AnsiUpperCase ('.jpg')) then Button3.enabled:=true;
end;
end;
procedure TServerForm. ShellListView1DblClick (Sender: TObject);
begin
Button3.enabled:=false;
if ShellListView1. ItemIndex>=0 then
begin
CurrentQuestFile:=ShellTreeView1. Path+'\'+PChar (ShellListView1. SelectedFolder. DisplayName);
if AnsiUpperCase (ExtractFileExt(CurrentQuestFile))=AnsiUpperCase ('.bmp') then
begin
Button3.enabled:=true;
Button3. Click;
end;
end;
end;
procedure TServerForm. Image1Click (Sender: TObject);
begin
Button3. Click;
end;
procedure TServerForm. ShellTreeView1Enter (Sender: TObject);
begin
Button3. Enabled:=false;
end;
procedure TServerForm. FillReportTable;
var i, ii:byte;
begin
i:=1; // начинаем со второй строки
TableClear(ReportGrid);
if PassedTestCount>0 then
begin
for ii:=0 to 44 do
begin
if (DataSetForReport[ii].PassTest) then
begin
ReportGrid. Cells [0, i]:=DataSetForReport[ii].Name;
ReportGrid. Cells [1, i]:=DataSetForReport[ii].Group;
ReportGrid. Cells [2, i]:=DataSetForReport[ii].WorkName;
ReportGrid. Cells [3, i]:=DataSetForReport[ii].Teacher;
ReportGrid. Cells [4, i]:=IntToStr (DataSetForReport[ii].True_);
ReportGrid. Cells [5, i]:=IntToStr (DataSetForReport[ii].False_);
ReportGrid. Cells [6, i]:=TimeToStr (DataSetForReport[ii].TimeLater);
ReportGrid. Cells [7, i]:=IntToStr (DataSetForReport[ii].Mark);
inc(i);
end;
ReportGrid. RowCount:=i+2;
end;
end else ShowMessage ('Нет прошедших тестирование');
end;
procedure TServerForm. DisconnectComboBoxUpdate;
var i:integer;
begin
ComboBox2. Clear;
for i:=0 to 44 do
begin
if DataSetForReport[i].Registered then ComboBox2. Items. Add (DataSetForReport[i].Name);
end;
end;
procedure TServerForm. CreateReport;
var
RangeW:word2000.range;
j:integer;
StrArr:array of string[30];
Data: WideString;
SData:string;
Sep, tmpRange, NumCols: OleVariant;
Parfs: Paragraphs;
Par: Paragraph;
begin
WordDocument1. Activate;
WordDocument1. Range. Font. Bold:=0;
WordDocument1. Range. Font. Size:=14;
WordDocument1. PageSetup. LeftMargin:=20;
WordDocument1. PageSetup. TopMargin:=20;
WordDocument1. PageSetup. RightMargin:=20;
WordDocument1. PageSetup. BottomMargin:=60;
SetLength (StrArr, ReportGrid. RowCount);
RangeW:=WordDocument1. Range (emptyParam, emptyParam);
tmpRange:=RangeW;
Parfs:=WordDocument1. Paragraphs;
par:=Parfs. Add(tmpRange);
tmpRange:=Par. Range.get_end_;
RangeW:=WordDocument1. Range(tmpRange);
SData:='';
Data:='ФИО@Группа@Дисциплина@Верных@Неверных@Время@Оценка@';
for j:=1 to ReportGrid. RowCount do
begin
begin // вывод информации по одному преподавателю
SData:=SData+ReportGrid. Cells [0, j]+'@'+ReportGrid. Cells [1, j]+'@'+ReportGrid. Cells [2, j]+'@'
+ReportGrid. Cells [4, j]+'@'+ReportGrid. Cells [5, j]+'@'+ReportGrid. Cells [6, j]+'@'+
ReportGrid. Cells [7, j]+'@';
Data:=Data+SData;
SData:='';
end;
end;
tmpRange:=RangeW;
Par:=Parfs. Add(tmpRange);
Par. Range. InsertBefore(Data);
Sep:='@';
NumCols:=7;
RangeW. ConvertToTableOld (Sep, EmptyParam, NumCols, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
WordDocument1. Disconnect;
SetLength (StrArr, 0);
end;
procedure TServerForm. Button1Click (Sender: TObject);
var
MsWord: Variant;
begin
try
MsWord:= CreateOleObject ('Word. Application');
MsWord. Visible:= True;
MsWord. Caption:='Отчет по реультатам тестирования';
CreateReport;
except
ShowMessage ('Невозможно запустить Microsoft Word');
Exit;
end;
end;
procedure TServerForm. SpeedButton1Click (Sender: TObject);
var Command:byte;
begin
if ComboBox2. ItemIndex>=0 then
begin
Command:=NM_KickFromServer;
ServerSocket1. Socket. Connections [ComboBox2. ItemIndex].SendBuf (Command, 1);
end;
end;
procedure TServerForm. StringGrid1SelectCell (Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
SelectedRow:=ARow;
end;
procedure TServerForm. Button7Click (Sender: TObject);
begin
Memo1. Clear;
end;
procedure TServerForm. Button8Click (Sender: TObject);
begin
if SaveDialog1. Execute then Memo1. Lines. SaveToFile (SaveDialog1. FileName);
end;
procedure TServerForm. LogMessage (var Message: TMessage);
begin
Memo1. Lines. Add (DateTimeToStr(Now)+' '+PChar (Message.WParam));
end;
end.
unit QBaseWork;
interface
uses
Windows, Messages, SysUtils, Classes, Dialogs, IniFiles;
const
ErrWorkListLoad = 1;
ErrImputWorkNumberFault = 2;
ErrTeachersListLoad = 3;
ErrImputTeacherNumberFault = 4;
ErrQuestionsNotFound = 5;
ErrConfigIniFileWorkSetNotFound = 6;
ErrReadBuiletNumber = 7;
ErrQuestionWithInputedNumberNotFound = 8;
ErrQuestionFileWithInputedNumberNotFound = 9;
ErrInSelectedDirectoryNotQuestFileNameFound = 10;
ErrGenerationRndQuest = 11;
type
DBase=record
Works:HLringList;
Teachers:array of HLringList;
end;
type
TQuestDB = class
private
SelfParent:HWND;
NewBase:DBase;
WorksCount_:integer;
WorkTimeLimit_:String;
ProgRootDir:string;
ActiveWork:string;
ActiveTeacher:string;
ActiveWorkNum:byte;
ActiveTeacherNum:byte;
///////QUESTIONS /////////
ImgType:string;
QuestCount:integer;
QuestionsPathName:string;
ActivTransactionUser: String;
procedure ERROR_MESSAGE_FOR_DEBUG_LEVEL (ErrID:byte);
///////QUESTIONS /////////
function ConverHLrToIntNum (StringNum: string): integer;
function TestByDigit (DataString: string): boolean;
procedure SMessage (Message_: string);
function UpdateQuestionsSet: boolean;
// function GetWorkIndex (WorkName: string): integer;
// function GetTeacherIndex (TeacherName: string): integer;
public
constructor Create (ParentHwnd:HWND);
destructor Destroy; override;
function SetActiveTeacher (Num: byte):boolean;
function SetActiveWork (Num: byte):boolean;
function GetWorksStringList:string;
function GetTeachersStringList:string;
property ActivWorkName:string read ActiveWork;
property ActivTeacherName:string read ActiveTeacher;
property TransactionUser:string read ActivTransactionUser write ActivTransactionUser;
property PubActivWorkNum:byte read ActiveWorkNum;
property PubActivTeacherNum:byte read ActiveTeacherNum;
property QuestionsFullPath:string read QuestionsPathName;
function GetWorkByIndex (i: byte): string;
function GetTeacherByIndex (i: byte): string;
///////QUESTIONS /////////
property ImgFileType:string read ImgType;
property QuestionsCount:integer read QuestCount;
property WorkTimeLimit: String read WorkTimeLimit_;
function GetBuiletByNum (Num: integer): string;
function GetFileBuiletByNumBuilet (BuiletNum, FileNum: integer): string;
function GetRandomFileBuilet (BuiletNum: integer): string;
function GetTrueAnswerForBuilet (QuestionPath: string): integer;
function SetTrueAnswerForBuilet (QuestionPath: string; TrueAnswer: Integer): boolean;
end;
implementation
{TQuestDB}
constructor TQuestDB. Create (ParentHwnd:HWND);
var ExeName:PChar;
AppName: String;
ExeNameLen:byte;
/////
NewSearch_:TSearchRec;
i, ii:byte;
QuestionPathName:string;
QCount:integer;
FOptions:TIniFile;
begin
SelfParent:=ParentHwnd;
GetMem (ExeName, 255);
ExeNameLen:=255;
GetModuleFileName (0, ExeName, ExeNameLen); // определяем имя исполняемого модуля
AppName:=StrPas(ExeName);
ProgRootDir:=ExtractFileDir(AppName);
WorksCount_:=0;
NewBase. Works:=HLringList. Create; // заполняем список работ
FindFirst (ProgRootDir+'\Questions\*', faDirectory, NewSearch_);
repeat
if NewSearch_.Name[1]<>'.' then
begin
NewBase. Works. Add (NewSearch_.Name);
inc (WorksCount_);
end;
until FindNext (NewSearch_)<>0;
FindClose (NewSearch_);
// Заполняем списки преподов
SetLength (NewBase. Teachers, WorksCount_);
for i:=0 to WorksCount_-1 do
begin
NewBase. Teachers[i]:=HLringList. Create;
FindFirst (ProgRootDir+'\Questions\'+NewBase. Works. Strings[i]+'\*', faDirectory, NewSearch_);
repeat
if NewSearch_.Name[1]<>'.' then NewBase. Teachers[i].Add (NewSearch_.Name);
until FindNext (NewSearch_)<>0;
FindClose (NewSearch_);
end;
for i:=0 to NewBase. Works. Count-1 do
begin
for ii:=0 to NewBase. Teachers[i].Count-1 do
begin
QuestionPathName:=ProgRootDir+'\Questions\'+NewBase. Works. Strings[i]+'\'+ NewBase. Teachers[i].Strings[ii];
if FileExists (QuestionPathName+'\WorkSet.ini') then
begin
FOptions:=TIniFile. Create (QuestionPathName+'\WorkSet.ini');
QCount:=0;
FindFirst (QuestionPathName+'\*', faDirectory, NewSearch_);
repeat
if NewSearch_.Name[1]<>'.' then
if TestByDigit (NewSearch_.Name) then inc(QCount);
until FindNext (NewSearch_)<>0;
FindClose (NewSearch_);
FOptions. WriteInteger ('QuestionCount', 'value', QCount);
FOptions. Free;
if QCount>0 then QuestCount:=QCount else ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrQuestionsNotFound);
end else ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrConfigIniFileWorkSetNotFound);
end;
end;
end;
destructor TQuestDB. Destroy;
var i:integer;
begin
for i:=0 to NewBase. Works. Count-1 do
begin
NewBase. Teachers[i].Destroy;
end;
SetLength (NewBase. Teachers, 0);
NewBase. Works. Destroy;
inherited;
end;
function TQuestDB. SetActiveWork (Num:byte):boolean;
begin
result:=false;
if Num<NewBase. Works. Count then
begin
ActiveWork:=NewBase. Works. Strings[Num];
ActiveWorkNum:=Num;
result:=true;
end else ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrImputWorkNumberFault);
end;
function TQuestDB. SetActiveTeacher (Num:byte):boolean;
begin
result:=false;
if Num<NewBase. Teachers[ActiveWorkNum].Count then
begin
ActiveTeacher:=NewBase. Teachers[ActiveWorkNum].Strings[Num];
ActiveTeacherNum:=Num;
if UpdateQuestionsSet then result:=true;
end else ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrImputTeacherNumberFault);
end;
function TQuestDB. GetTeachersStringList: string;
var i:integer;
begin
Result:='';
for i:=0 to NewBase. Teachers[ActiveWorkNum].Count-1 do Result:=Result+NewBase. Teachers[ActiveWorkNum].Strings[i]+'|';
Result:=Result+'>';
end;
function TQuestDB. GetWorksStringList: string;
var i:integer;
begin
Result:='';
for i:=0 to NewBase. Works. Count-1 do Result:=Result+NewBase. Works. Strings[i]+'|';
Result:=Result+'>';
end;
function TQuestDB. GetWorkByIndex (i:byte): string;
begin
if i<=NewBase. Works. Count-1 then Result:=NewBase. Works. Strings[i] else Result:='';
end;
function TQuestDB. GetTeacherByIndex (i:byte): string;
begin
if i<=NewBase. Teachers[ActiveWorkNum].Count-1 then
Result:=NewBase. Teachers[ActiveWorkNum].Strings[i] else
Result:='';
end;
procedure TQuestDB.ERROR_MESSAGE_FOR_DEBUG_LEVEL (ErrID: byte);
begin
Case ErrID of
ErrWorkListLoad:
begin
SMessage ('Base read works error');