Разработка программного обеспечения для оценки уровня знаний студентов с применением технологии "Клиент-сервер"

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;

Страницы: 1, 2, 3, 4