Разработка программного обеспечения для оценки уровня знаний студентов с применением технологии "Клиент-сервер" — страница 3
Обновлено
function TServerForm. DecodeNumToSocketNum (StationNum:byte):byte; // поиск индекса станции в динамическом
var TryConnectedStation:byte; // массиве Connections по известному
begin // по номеру
Result:=0;
if DataSetForReport[StationNum].SocketHandle<>0 then
for TryConnectedStation:=ServerSocket1. Socket. ActiveConnections-1 downto 0 do // перебираем все соединения
begin // поиск ведется по дескриптору соединения
if ServerSocket1. Socket. Connections[TryConnectedStation].SocketHandle=DataSetForReport[StationNum].SocketHandle then
begin
Result:=TryConnectedStation; // если найдена соответствующая станция,
break; // выходим предварительно
end;
end;
end;
procedure TServerForm. ServerSocket1ClientError (Sender: TObject; // ошибка соединения
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode:=0;
DoAction:=true;
Inc(NetworkErrors);
Socket. Close;
end;
Procedure TServerForm. AddLogMessage (Message_:string);
begin
SendMessage (Handle, WM_User+2, DWord (PChar(Message_)), 0);
end;
procedure TServerForm. ServerSocket1ClientConnect (Sender: TObject; // соединение
Socket: TCustomWinSocket);
var ConnectionsScan:byte;
ConnectedClientNum:byte;
Buff:string;
Command:byte;
ConnectOK:boolean;
procedure KickFromServer;
begin
Command:=NM_KickFromServer;
Socket. SendBuf (Command, 1);
end;
begin
AddLogMessage (Socket. RemoteAddress+' Has client connection, check Socket…');
ConnectOK:=false;
if ServerSocket1. Socket. ActiveConnections<=45 then // если сервер не заполнен
begin
for ConnectionsScan:=0 to 44 do // ищем пустую ячейку (т. к. кто-то мог отсоединится)
begin
if (DataSetForReport[ConnectionsScan].SocketHandle=0) and (not (DataSetForReport[ConnectionsScan].PassTest)) then // если нашли сохраняем ее номер и идем дальше
begin
ConnectedClientNum:=ConnectionsScan;
DataSetForReport[ConnectionsScan].SocketHandle:=Socket. SocketHandle; // Заполняем ячейку буфера соединений
DataSetForReport[ConnectionsScan].Num:=ConnectedClientNum;
Buff:=Char (NM_Register1)+Char(ConnectionsScan)+GroupList+'>'; // список групп и персональный номер
Socket. SendBuf (Pointer(Buff)^, Length(Buff)); // отправка буфера
CurrenHLation:=ConnectedClientNum;
ConnectOK:=true;
AddLogMessage (Socket. RemoteAddress+' Client accepted');
break;
end;
end;
end else AddLogMessage (Socket. RemoteAddress+' Server is Full');
if not ConnectOK then
begin
AddLogMessage (Socket. RemoteAddress+' Client not accepted');
KickFromServer;
end;
Inc(ConnectedSumm); // увеличиваем счетчик соединений
end;
procedure TServerForm. CriticalClientDisconnect (Ip:string; Name, Group, WorkName, TeacherName: String; TrueAnsw, FalseAnsw:byte; TimeLater:TTime);
var i:byte;
begin
if Ip<>'' then
for i:=1 to StringGrid2. RowCount-1 do
begin
if StringGrid2. Cells [0, i]='' then
begin
StringGrid2. RowCount:=i+2;
StringGrid2. Cells [0, i]:=Ip;
StringGrid2. Cells [1, i]:=Name+' '+Group;
StringGrid2. Cells [2, i]:=WorkName;
StringGrid2. Cells [3, i]:=TeacherName;
StringGrid2. Cells [4, i]:=IntToStr (TrueAnsw+FalseAnsw);
StringGrid2. Cells [5, i]:=IntToStr(TrueAnsw);
StringGrid2. Cells [6, i]:=IntToStr(FalseAnsw);
StringGrid2. Cells [7, i]:=TimeToStr(TimeLater);
break;
end;
end;
end;
procedure TServerForm. ServerSocket1ClientDisconnect (Sender: TObject;
Socket: TCustomWinSocket);
var ScanConnections:byte;
DisconnectedClientNum:integer;
begin
for ScanConnections:=44 downto 0 do // перебираем все возможные подключения
begin
if DataSetForReport[ScanConnections].SocketHandle=Socket. SocketHandle then // ищем отключившуюся станцию
begin
DisconnectedClientNum:=ScanConnections;
if not DataSetForReport[DisconnectedClientNum].PassTest then // Если станция отключилась до окончания тестирования
// то исключить ее из отчета
begin
AddLogMessage (Socket. RemoteAddress+' Client critical disconnect');
CriticalClientDisconnect (
DataSetForReport[DisconnectedClientNum].Ip,
DataSetForReport[DisconnectedClientNum].Name,
DataSetForReport[DisconnectedClientNum].Group,
DataSetForReport[DisconnectedClientNum].WorkName,
DataSetForReport[DisconnectedClientNum].Teacher,
DataSetForReport[DisconnectedClientNum].True_,
DataSetForReport[DisconnectedClientNum].False_,
DataSetForReport[DisconnectedClientNum].TimeLater
);
DataSetForReport[DisconnectedClientNum].Name:='';
if DataSetForReport[ScanConnections].Registered then
begin
Dec(RegisteredClients);
DataSetForReport[ScanConnections].Registered:=false;
DisconnectComboBoxUpdate;
end;
ZeroMemory (Addr(DataSetForReport[DisconnectedClientNum].Questions), 254);
break;
end;
AddLogMessage (Socket. RemoteAddress+' Client pass test and disconnect');
DataSetForReport[ScanConnections].PassedCount:=0;
DataSetForReport[ScanConnections].SocketHandle:=0; // обнуляем соответствующую ячейку
DataSetForReport[ScanConnections].Num:=0;
ConnectionCount.caption:=inttostr(ConnectedSumm);
DoAction:=true;
break;
end;
end;
Dec(ConnectedSumm);
if ConnectedSumm=0 then AddLogMessage (' Server is empty');
end;
procedure TServerForm. ServerSocket1ClientRead (Sender: TObject;
Socket: TCustomWinSocket);
type TDataBuffer=array of byte;
var
Command:byte; // собственно команда
SendLen:integer; // Длина всего принятого потока
DataBuffer:TDataBuffer;
ClientNum:byte;
FieldNum:byte;
NameBuf:string;
SendBuff:string;
BuffLen:integer;
OpenedBuilet:byte;
UserAnswer: Word;
Wait:byte;
Procedure SetMark;
begin
if DataSetForReport[ClientNum].Questions[OpenedBuilet].TrueAnswer=UserAnswer then
begin
inc (DataSetForReport[ClientNum].True_);
inc (DataSetForReport[ClientNum].Mark);
end
else inc (DataSetForReport[ClientNum].False_);
end;
begin
Wait:=NM_Wait;
if not Processing then
begin
SendLen:=Socket. ReceiveLength;
SetLength (DataBuffer, SendLen);
ZeroMemory (DataBuffer, SendLen);
Socket. ReceiveBuf (Pointer(DataBuffer)^, SendLen);
Command:=DataBuffer[0];
ClientNum:=DataBuffer[1];
case Command of
NM_Register2:
begin
USERSBASE. SetActiveGroup (DataBuffer[2]);
SendBuff:=Char (NM_Register2)+USERSBASE. GetUsersStringList;
BuffLen:=Length(SendBuff);
Socket. SendBuf (Pointer(SendBuff)^, BuffLen);
end;
NM_RegisterGetWorks:
begin
SendBuff:=Char (NM_RegisterGetWorks);
SendBuff:=SendBuff+QUESTIONBASE. GetWorksStringList;
BuffLen:=Length(SendBuff);
Socket. SendBuf (Pointer(SendBuff)^, BuffLen);
end;
NM_RegisterGetTeachers:
begin
FieldNum:=DataBuffer[2]; // номер элемента списка
NameBuf:='';
QUESTIONBASE. TransactionUser:=Socket. RemoteAddress+' name unknown';
if QUESTIONBASE. SetActiveWork(FieldNum) then
begin
NameBuf:=QUESTIONBASE. ActivWorkName;
SendBuff:=Char (NM_RegisterGetTeachers)+SendBuff+QUESTIONBASE. GetTeachersStringList;
BuffLen:=Length(SendBuff);
Socket. SendBuf (Pointer(SendBuff)^, BuffLen);
end else ProblemWithData (@Socket, 'Error with Database');
end;
NM_RegisterOK:
begin
{
0 - команда
1 - № клиента
2 - Группа
3 - Ф.И.О.
4 - WorkName
5 - Teacher
}
// 1 {определение группы}
{РЕГИСТРАЦИЯ}
DataSetForReport[ClientNum].Group:=USERSBASE. GetGroupByIndex (DataBuffer[2]);
if (USERSBASE. SetActiveGroup (DataBuffer[2])) and (USERSBASE. SetActiveUser (DataBuffer[3])) then
begin
DataSetForReport[ClientNum].Ip:=Socket. RemoteAddress;
DataSetForReport[ClientNum].Name:=USERSBASE. ActiveUserName;
QUESTIONBASE. TransactionUser:=Socket. RemoteAddress+' '+DataSetForReport[ClientNum].Name+' '+DataSetForReport[ClientNum].Group;
// 3 {определение дисциплины}
if (QUESTIONBASE. SetActiveWork (DataBuffer[4])) then
if (QUESTIONBASE. SetActiveTeacher (DataBuffer[5])) then
begin
DataSetForReport[ClientNum].QuestCount:=QUESTIONBASE. QuestionsCount;
DataSetForReport[ClientNum].WorkName:=QUESTIONBASE. GetWorkByIndex (DataBuffer[4]);
DataSetForReport[ClientNum].UserWorkPathID. WorkID:=DataBuffer[4];
// 4 {определение имени руководителя}
DataSetForReport[ClientNum].Teacher:=QUESTIONBASE. GetTeacherByIndex (DataBuffer[5]);
DataSetForReport[ClientNum].UserWorkPathID. TeacherID:=DataBuffer[5];
DataSetForReport[ClientNum].SumTime:=StrToTime (QUESTIONBASE. WorkTimeLimit);
AddLogMessage (Socket. RemoteAddress+' '+DataSetForReport[ClientNum].Name+' '+DataSetForReport[ClientNum].Group+' Client passed registration');
DataSetForReport[ClientNum].Ip:=Socket. RemoteAddress;
DataSetForReport[ClientNum].True_:=0;
DataSetForReport[ClientNum].False_:=0;
DataSetForReport[ClientNum].Mark:=0;
DataSetForReport[ClientNum].TestingAbortedByTime:=false;
DataSetForReport[ClientNum].TimeLater:=StrToTime ('0:00:00');
DataSetForReport[ClientNum].PassTest:=false;
DataSetForReport[ClientNum].WorkPath:=RootPath+'Questions\'+DataSetForReport[ClientNum].WorkName+'\'+DataSetForReport[ClientNum].Teacher;
DataSetForReport[ClientNum].PassedCount:=0;
DataSetForReport[ClientNum].ImageType:=QUESTIONBASE. ImgFileType;
DataSetForReport[ClientNum].Registered:=true;
DisconnectComboBoxUpdate;
CurrenHLation:=ClientNum;
Inc(RegisteredClients); // зарегистрировано клиентов
PostMessage (Handle, WM_USER, ClientNum, 0);
DoAction:=true;
end else
begin
ProblemWithData (@Socket, 'Error with Database');
AddLogMessage (Socket. RemoteAddress+' Problem with registration, client application shutdown');
end;
end else
begin
ProblemWithData (@Socket, 'Error with Database');
AddLogMessage (Socket. RemoteAddress+' Problem with registration, client application shutdown');
end;
end;
NM_TestEvent:
begin
UserAnswer:=DataBuffer[2];
OpenedBuilet:=DataSetForReport[ClientNum].OpenQuest;
DataSetForReport[ClientNum].Questions[OpenedBuilet].Passed:=true;
Inc (DataSetForReport[ClientNum].PassedCount);
if DataSetForReport[ClientNum].QuestCount=DataSetForReport[ClientNum].PassedCount then
begin // если пройдены все билеты то заканчиваем тестирование
DataSetForReport[ClientNum].PassTest:=true;
SetMark;
inc(PassedTestCount);
SendBuff:=Char (NM_EndOfTest)+Char (DataSetForReport[ClientNum].Mark);
ZeroMemory (Addr(DataSetForReport[ClientNum].Questions), 254);
BuffLen:=Length(SendBuff);
Socket. SendBuf (Pointer(SendBuff)^, BuffLen);
end else SetMark;
PostMessage (Handle, WM_USER, ClientNum, 0);
DoAction:=true;
end;
end;
end else
begin
Socket. SendBuf (Wait, 1);
beep;
end;
end;
procedure TServerForm. TimeOUTTesting (StationNum:byte);
var SendBuff:string;
BuffLen:integer;
begin
DataSetForReport[StationNum].TestingAbortedByTime:=true;
DataSetForReport[StationNum].PassTest:=true;
inc(PassedTestCount);
SendBuff:=Char (NM_EndOfTest)+Char (DataSetForReport[StationNum].Mark);
ZeroMemory (Addr(DataSetForReport[StationNum].Questions), 254);
BuffLen:=Length(SendBuff);
ServerSocket1. Socket. Connections [DecodeNumToSocketNum(StationNum)].SendBuf (Pointer(SendBuff)^, BuffLen);
end;
procedure TServerForm. TableClear (Table:HLringGrid);
var i:word;
begin
for i:=1 to Table. RowCount do Table. Rows[i].Clear;
end;
procedure TServerForm. ReFillTable;
var i, ii:byte;
begin
DoAction:=false;
TableClear(StringGrid1);
i:=1;
if RegisteredClients>=StringGrid1. RowCount then StringGrid1. RowCount:=StringGrid1. RowCount+1;
for ii:=0 to 44 do
begin
if (DataSetForReport[ii].Registered) and (not DataSetForReport[ii].PassTest) then
begin
StringGrid1. Cells [0, i]:=DataSetForReport[ii].Ip;
StringGrid1. Cells [1, i]:=DataSetForReport[ii].Name;
StringGrid1. Cells [2, i]:=DataSetForReport[ii].Group;
StringGrid1. Cells [3, i]:=IntToStr (DataSetForReport[ii].True_+DataSetForReport[ii].False_);
StringGrid1. Cells [4, i]:=IntToStr (DataSetForReport[ii].True_);
StringGrid1. Cells [5, i]:=IntToStr (DataSetForReport[ii].False_);
StringGrid1. Cells [7, i]:=TimeToStr (DataSetForReport[ii].SumTime-DataSetForReport[ii].TimeLater);
StringGrid1. Cells [6, i]:=TimeToStr (DataSetForReport[ii].TimeLater);
StringGrid1. Cells [8, i]:='в процессе';
inc(i);
end;
end;
Label10. Caption:=IntToStr(PassedTestCount);
Label17. Caption:=IntToStr(NetworkErrors);
ConnectionCount. Caption:=inttostr(ConnectedSumm);
Label18. Caption:=IntToStr (RegisteredClients-PassedTestCount);
Label16. Caption:=IntToStr(RegisteredClients);
end;
procedure TServerForm. TimeRefresh;
var i, ii:byte;
begin
i:=1;
for ii:=0 to 44 do
begin
if (DataSetForReport[ii].Registered) and (not DataSetForReport[ii].PassTest) and (not DataSetForReport[ii].TestingAbortedByTime) then
begin
StringGrid1. Cells [6, i]:=TimeToStr (DataSetForReport[ii].TimeLater);
StringGrid1. Cells [7, i]:=TimeToStr (DataSetForReport[ii].SumTime-DataSetForReport[ii].TimeLater);
inc(i);
end;
end;
end;
procedure TServerForm. FormCreate (Sender: TObject);
var NewSearch:TSearchRec;
begin
QUESTIONBASE:=TQuestDB. Create(Handle);
USERSBASE:=TUsersDB. Create(Handle);
RootPath:=ExtractFilePath (Application. ExeName);
ShellTreeView1. Root:=RootPath+'Questions\';
StringGrid1. Cells [0,0]:='IP адрес';
StringGrid1. Cells [1,0]:='ФИО';
StringGrid1. Cells [2,0]:='Группа';
StringGrid1. Cells [3,0]:='Пройдено билетов';
StringGrid1. Cells [4,0]:='Верных';
StringGrid1. Cells [5,0]:='Неверных';
StringGrid1. Cells [6,0]:='Время тестирования';
StringGrid1. Cells [7,0]:='Осталось времени';
StringGrid1. Cells [8,0]:='Статус';
ReportGrid. Cells [0,0]:='ФИО';
ReportGrid. Cells [1,0]:='Группа';
ReportGrid. Cells [2,0]:='Дисциплина';
ReportGrid. Cells [3,0]:='Преподаватель';
ReportGrid. Cells [4,0]:='Верных';
ReportGrid. Cells [5,0]:='Неверных';
ReportGrid. Cells [6,0]:='Время';
ReportGrid. Cells [7,0]:='Оценка';
StringGrid2. Cells [0,0]:='IP адрес';
StringGrid2. Cells [1,0]:='ФИО';
StringGrid2. Cells [2,0]:='Дисциплина';
StringGrid2. Cells [3,0]:='Преподаватель';
StringGrid2. Cells [4,0]:='Пройдено';
StringGrid2. Cells [5,0]:='Верных';
StringGrid2. Cells [6,0]:='Неверных';
StringGrid2. Cells [7,0]:='Время';
GroupList:=USERSBASE. GetGroupsStringList;
FindFirst ('Groups\*.txt', faAnyfile, NewSearch);
repeat
Delete (NewSearch. Name, Length (NewSearch. Name) - 3,4);
ComboBox1. Items. Add (ExtractFileName(NewSearch. Name));
until FindNext(NewSearch)<>0;
if GroupList='' then ShowMessage ('Нет списков групп сервер незапущен') else ServerSocket1. Active:=true;
FindClose(NewSearch);
end;
procedure TServerForm. FormDestroy (Sender: TObject);
begin
ServerSocket1. Close;
ServerSocket1. Active:=false;
QUESTIONBASE. Destroy;
USERSBASE. Destroy;
end;
////////////////
procedure TServerForm. Timer1Timer (Sender: TObject);
var StationNum:byte;
begin
if (ConnectedSumm >0) or (StringGrid1. Cells [0,1]<>'') then
begin
if SecCounter>5 then
begin
DoAction:=true;
SecCounter:=0;
end else inc(SecCounter);
if RegisteredClients>0 then
for StationNum:=44 downto 0 do
if (DataSetForReport[StationNum].Registered) and (not DataSetForReport[StationNum].PassTest) and (not DataSetForReport[StationNum].TestingAbortedByTime) then
begin
DataSetForReport[StationNum].TimeLater:=DataSetForReport[StationNum].TimeLater+StrToTime ('0:00:01');
if DataSetForReport[StationNum].TimeLater>=DataSetForReport[StationNum].SumTime then TimeOUTTesting(StationNum);
end;
if DoAction then
begin
ReFillTable;
FillReportTable;
end else TimeRefresh;
end else ConnectionCount.caption:=inttostr(ConnectedSumm);
end;
procedure TServerForm. ProblemWithData (From_:PCustomWinSocket; TxtMessage:string);
var SendBuf:string;
BuffLen:byte;
begin
SendBuf:=Char (NM_DataError);
SendBuf:=SendBuf+Char (Length(TxtMessage))+TxtMessage;
BuffLen:=Length(SendBuf);
From_.SendBuf (Pointer(SendBuf)^, BuffLen);
end;
procedure TServerForm. TestEvent (StationNum:byte; Socket_:PCustomWinSocket);
var CurrenHLation: Peoples;
WorkPath:string;
TmpStr: String;
SumCount: Byte;
RNDQuestNum: Word;
TrueAnsw: Word;
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;