48627 (588582), страница 6

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 6)

procedure SpeedButton1Click (Sender: TObject);

procedure StringGrid1SelectCell (Sender: TObject; ACol, ARow: Integer;

var CanSelect: Boolean);

procedure Button7Click (Sender: TObject);

procedure Button8Click (Sender: TObject);

private

function DecodeNumToSocketNum (StationNum: byte): byte;

procedure SendQuestion (ForStation: byte; TheFile: String; QuesHLyle:byte; TrueAnswer: Word);

procedure TestEvent (StationNum: byte; Socket_:PCustomWinSocket);

procedure SendFileMessage (var Message: TMessage); message WM_USER;

procedure LogMessage (var Message: TMessage); message WM_USER+2;

procedure FillReportTable;

procedure CreateReport;

procedure TableClear (Table:HLringGrid);

procedure ReFillTable;

procedure CriticalClientDisconnect (Ip, Name, Group, WorkName,

TeacherName: String; TrueAnsw, FalseAnsw: byte; TimeLater: TTime);

procedure TimeRefresh;

procedure ProblemWithData (From_:PCustomWinSocket; TxtMessage: string);

procedure AddLogMessage (Message_: string);

procedure DisconnectComboBoxUpdate;

procedure TimeOUTTesting (StationNum: byte);

// function DecodeSocketToClientNum (Socket_: THandle): byte;

end;

var

ServerForm: TServerForm;

FOptions:TIniFile;

NetworkErrors:word;

RootPath:string;

DataSetForReport:array [0..44] of Peoples;

CurrenHLation:byte;

GroupList: String;

RegisteredClients:byte;

PassedTestCount:byte;

ConnectedSumm:byte;

// TimeForPassTest:TTime;

SelectedRow:integer;

CurrentQuestFile:string;

CurrentQuestionNum:integer;

DoAction:boolean;

QUESTIONBASE:TQuestDB;

USERSBASE:TUsersDB;

SecCounter:byte;

Processing:boolean;

implementation

{$R *.dfm}

procedure TServerForm. SendQuestion (ForStation:byte; TheFile: String; QuesHLyle: Byte; TrueAnswer: Word); // Отправка вопроса

var FileStream:TMemoryStream; // Файловый поток

Command:byte; // Команда

procedure LoadFileForSend (const FileName: string); // Локальная процедура подготовки

var Stream: HLream; // файлового потока

Count: Int64; // размер файла данных

MakePointer:DWORD; // искусственный указатель

CurrSize: Int64; // размер файлового потока

FNameLen:byte; // длина имени файла (для корректного распознавания на стороне клиента)

begin

Stream:= TFileStream. Create (FileName, fmOpenRead or fmShareDenyWrite); // создаем поток

try

Count:= Stream. Size;

Stream. Position:=0;

// далее переносим информацию в поток

FileStream. WriteBuffer (Count, SizeOf(Int64)); // размер файла данных

FNameLen:=Length(FileName);

FileStream. WriteBuffer (FNameLen, 1); // длина имени файла

FileStream. WriteBuffer (Pointer(FileName)^, FNameLen); // имя файла

FileStream. Position:=0;

CurrSize:=FileStream. Size;

FileStream. SetSize (Count+CurrSize); // расширяем поток (в смысле размера)

MakePointer:=DWORD (FileStream. Memory)+CurrSize;

if Count<>0 then Stream. ReadBuffer (Pointer(MakePointer)^, Count); // переписываем данные из потока в поток

// с использованием указателя на память

finally

Stream. Free; // освобождаем промежуточный поток

end;

end;

begin

try

Command:=NM_FileOperation;

FileStream:=TMemoryStream. Create;

FileStream. WriteBuffer (Command, 1);

FileStream. WriteBuffer (TrueAnswer, 2);

FileStream. WriteBuffer (QuesHLyle, 1);

LoadFileForSend(TheFile);

FileStream. Position:=0;

ServerSocket1. Socket. Connections[ForStation].SendStream(FileStream); // отправка потока

except

FileStream. Free;

end

end;

// очищать неверный дисконнект

procedure TServerForm. SendFileMessage (var Message: TMessage); // внутреннее событие отправка файла

var

DataStream:TMemoryStream;

Data:byte;

StationNum:byte;

PSock:TCustomWinSocket;

begin

StationNum:=Message.WParam;

if DataSetForReport[StationNum].PassedCount=0 then

begin

DataStream:=TMemoryStream. Create; // создаем поток

Data:=NM_Service; // код команды

DataStream. WriteBuffer (Data, 1);

Data:=DataSetForReport[StationNum].QuestCount; // количество вопросов

DataStream. WriteBuffer (Data, 1);

DataStream. WriteBuffer (DataSetForReport[StationNum].SumTime, SizeOf (DataSetForReport[StationNum].SumTime)); // время на тестирование

DataStream. Position:=0;

ServerSocket1. Socket. Connections [DecodeNumToSocketNum(StationNum)].SendStream(DataStream);

// отправка потока

sleep(1); // задержка 1ms

end;

PSock:=ServerSocket1. Socket. Connections [DecodeNumToSocketNum(StationNum)];

TestEvent (StationNum,@PSock); // генерация события связанного с тестированием

end;

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]:='Оценка';

Характеристики

Список файлов ВКР