В данном дипломном проекте представлена «Автоматизированная система контроля знаний на основе архитектуры клиент-сервер», реализованная в среде программирования Borland Delphi 6.0.

Дополнительные средства разработки и возможности среды программирования позволили осуществить формирование и ведение базы теста, вывод необходимых форм и отчета успеваемости, создать удобный пользовательский интерфейс включающий:

· стандартная строка меню;

· кнопки - для активизации функций системы;

· сопроводительные сообщения.

Для повышения надежности хранения информации предусмотрены программные средства защиты информации:

· резервное сохранение базы теста;

Наличие встроенной контекстной помощи позволяет упростить использование программы.

Дипломный проект был выполнен в заданный срок.

program HLServer;

uses

Forms,

BaseUnit in 'BaseUnit.pas' {MainForm},

QBaseWork in 'QBaseWork.pas',

UBaseWork in 'UBaseWork.pas';

{$R *.res}

begin

Application. Initialize;

Application. CreateForm (TServerForm, ServerForm);

Application. Run;

end.

unit BaseUnit;

interface

uses

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

Dialogs, ScktComp, Grids, StdCtrls, ExtCtrls, Menus, CommCtrl, ComCtrls,

IniFiles, WinSock, ComObj, OleServer, Word97, ShellCtrls, Buttons, Word2000;

const

NM_Register1 = 6; // прием списка групп

NM_Register2 = 7; // запрос на список студентов

NM_RegisterGetWorks = 66; // запрос / ответ 'список предметов'

NM_RegisterGetTeachers = 77; // запрос / ответ 'список преподователей'

NM_RegisterOK = 8; // клиент зарегистрирован

NM_Service = 31; // прием сервисной информации

NM_TestEvent = 55; // событие по ходу тестирования

NM_FileOperation = 10; // сетевая операция с файлами

NM_EndOfTest = 33; // окончание тестирования

NM_KickFromServer = 44; // отключение от сервера администратором

NM_OutOfTime = 50; // отключение по истечении времени

NM_DataError = 54; // проблема с БД

NM_Wait = 61;

type

PCustomWinSocket=TCustomWinSocket;

Questions=record // Структура вопроса

Passed:boolean; // пройден (да/нет)

Style:byte; // стиль вопроса {radio, check, memo}

UserAnswer: word; // ответ пользователя

TrueAnswer: word; // верный ответ

end;

PathID=record

WorkID:byte;

TeacherID:byte;

end;

Peoples=record // структура 'Пользователь'

SocketHandle: Integer; // дескриптор соединения

Ip:string[15]; //IP адрес

Num:byte; // номер клиента

Registered:boolean; // прошел регистрацию (да/нет)

TestingAbortedByTime:boolean;

Group:string[8]; // группа

Name:string[20]; // имя

Teacher:string[40]; // преподаватель

WorkName:string[40]; // наим. дисциплины

WorkPath:string[255]; // рабочая директория пользователя

UserWorkPathID: PathID; // идентификаторы дисциплины и преподавателя

ImageType:string[3]; // тип файла вопросов {зарезервировано}

QuestCount:byte; // количество вопросов

OpenQuest:byte; // Ссылка на билет из массива Questions

 // для дальнейшего

TimeLater:TTime; // потрачено времени

SumTime:TTime; // общий бюджет бремени

PassedCount:byte; // пройдено вопросов

True_:byte; // верных ответов

False_:byte; // неверных ответов

Mark:byte; // оценка

PassTest:boolean; // тест пройден (да/нет)

Questions:array [1..255] of Questions; // массив пройденных вопросов

end;

type

TServerForm = class(TForm)

ServerSocket1: TServerSocket;

PageControl1: TPageControl;

TabSheet1: TTabSheet;

ComboBox1: TComboBox;

ListBox1: TListBox;

Label2: TLabel;

Label3: TLabel;

Timer1: TTimer;

Label4: TLabel;

Label5: TLabel;

TabSheet4: TTabSheet;

ConnectionCount: TLabel;

Timer2: TTimer;

TabSheet8: TTabSheet;

Panel3: TPanel;

Button3: TButton;

Button4: TButton;

Image1: TImage;

RadioGroup1: TRadioGroup;

ShellTreeView1: TShellTreeView;

ShellListView1: TShellListView;

ComboBox2: TComboBox;

Bevel8: TBevel;

Label1: TLabel;

Label6: TLabel;

Label7: TLabel;

Label8: TLabel;

Label9: TLabel;

Label16: TLabel;

Label10: TLabel;

Label17: TLabel;

Label18: TLabel;

Bevel1: TBevel;

Bevel4: TBevel;

Bevel5: TBevel;

Bevel6: TBevel;

Bevel7: TBevel;

Bevel9: TBevel;

Bevel13: TBevel;

Bevel10: TBevel;

Bevel11: TBevel;

Bevel12: TBevel;

Bevel14: TBevel;

Bevel15: TBevel;

Bevel16: TBevel;

Bevel17: TBevel;

Bevel18: TBevel;

Bevel19: TBevel;

Bevel20: TBevel;

WordDocument1: TWordDocument;

SpeedButton1: TSpeedButton;

PageControl2: TPageControl;

TabSheet3: TTabSheet;

TabSheet5: TTabSheet;

StringGrid1: HLringGrid;

StringGrid2: HLringGrid;

TabSheet6: TTabSheet;

Memo1: TMemo;

Button7: TButton;

Button8: TButton;

SaveDialog1: TSaveDialog;

Panel2: TPanel;

Label29: TLabel;

Label30: TLabel;

Label31: TLabel;

Label32: TLabel;

TabSheet7: TTabSheet;

ReportGrid: HLringGrid;

Button1: TButton;

procedure ServerSocket1ClientConnect (Sender: TObject;

Socket: TCustomWinSocket);

procedure FormCreate (Sender: TObject);

procedure FormDestroy (Sender: TObject);

procedure ServerSocket1ClientRead (Sender: TObject;

Socket: TCustomWinSocket);

procedure ComboBox1Change (Sender: TObject);

procedure Timer1Timer (Sender: TObject);

procedure ServerSocket1ClientDisconnect (Sender: TObject;

Socket: TCustomWinSocket);

procedure Timer2Timer (Sender: TObject);

procedure StringGrid1DblClick (Sender: TObject);

procedure Button3Click (Sender: TObject);

procedure ShellListView1Change (Sender: TObject; Item: TListItem;

Change: TItemChange);

procedure ShellListView1DblClick (Sender: TObject);

procedure Image1Click (Sender: TObject);

procedure ShellTreeView1Enter (Sender: TObject);

procedure ServerSocket1ClientError (Sender: TObject;

Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;

var ErrorCode: Integer);

procedure Button1Click (Sender: TObject);

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

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;

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');

end;

ErrTeachersListLoad:

begin

SMessage ('Base read teachers error');

end;

ErrImputWorkNumberFault:

SMessage ('Imput work number fault');

ErrImputTeacherNumberFault:

SMessage ('Imput work number fault');

ErrQuestionsNotFound:

SMessage ('No questions found in base');

ErrConfigIniFileWorkSetNotFound:

SMessage ('Config file WorkSet.ini not found');

ErrReadBuiletNumber:

SMessage ('Error with read number of builet');

ErrQuestionWithInputedNumberNotFound:

SMessage ('Direstory with inputed number (QuestionNum) is not found (number out of range)');

ErrQuestionFileWithInputedNumberNotFound:

SMessage ('File with inputed number (QuestionName) is not found (number out of range)');

ErrInSelectedDirectoryNotQuestFileNameFound:

SMessage ('In the selected tirectory question file is not found');

ErrGenerationRndQuest:

SMessage ('Error by generation random question file maybe question directory is not found');

ErrInvalidFileNameTraslate:

SMessage ('Invalid Translate question name filename STR to INT maybe filename error');

end;

end;

Procedure TQuestDB.SMessage (Message_:string);

begin

SendMessage (SelfParent, WM_User+2, DWord (PChar(TransactionUser+' '+Message_)), 0);

end;

 /////////////////QUESTIONS ////////////////

function TQuestDB. UpdateQuestionsSet:boolean;

var QCount:integer;

EnumFileDir:TSearchRec;

FOptions:TIniFile;

TryConvert:TDateTime;

WorkTimeLim:string;

begin

QuestionsPathName:=ProgRootDir+'\Questions\'+ActiveWork+'\'+ActiveTeacher;

try

try

FOptions:=TIniFile. Create (QuestionsPathName+'\WorkSet.ini');

QuestCount:=FOptions. ReadInteger ('QuestionCount', 'value', - 1);

WorkTimeLim:=FOptions. ReadString ('TimeForWork', 'value', '0:00:00');

TryConvert:=StrToTime(WorkTimeLim);

WorkTimeLimit_:=WorkTimeLim;

ImgType:=FOptions. ReadString ('ImgType', 'value', 'bmp');

FOptions. Destroy;

finally

if QuestCount>0 then result:=true else result:=false;

end;

except

result:=false;

end;

end;

function TQuestDB. ConverHLrToIntNum (StringNum:string):integer;

var ProtectAssign:integer;

begin

if TestByDigit(StringNum) then

begin

ProtectAssign:=StrToInt(StringNum);

result:=ProtectAssign;

end else

begin

ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrReadBuiletNumber);

result:=-1;

end;

end;

function TQuestDB. TestByDigit (DataString:string):boolean;

var DataLen:byte;

Offs:byte;

begin

Result:=true;

DataLen:=Length(DataString);

for Offs:=1 to DataLen do

if not (DataString[Offs] in ['0'..'9']) then

begin

result:=false;

break;

end;

end;

function TQuestDB. GetBuiletByNum (Num:integer):string;

var EnumBuiletsFile:TSearchRec;

StringBuiletNum:string;

begin

Result:='';

FindFirst (QuestionsPathName+'\*', faDirectory, EnumBuiletsFile);

repeat

if EnumBuiletsFile. Name[1]<>'.' then

begin

StringBuiletNum:=EnumBuiletsFile. Name;

if TestByDigit(StringBuiletNum) then

if ConverHLrToIntNum(StringBuiletNum)=Num then

begin

result:=QuestionsPathName+'\'+EnumBuiletsFile. Name;

break;

end;

end;

until FindNext(EnumBuiletsFile)<>0;

FindClose(EnumBuiletsFile);

If Result='' then ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrQuestionWithInputedNumberNotFound);

end;

function TQuestDB. GetFileBuiletByNumBuilet (BuiletNum, FileNum:integer):string;

var EnumBuiletsNamesFile:TSearchRec;

StringBuiletNum:string;

begin

Result:='';

FindFirst (QuestionsPathName+'\'+IntToStr(BuiletNum)+'\*', faAnyFile, EnumBuiletsNamesFile);

repeat

if EnumBuiletsNamesFile. Name[1]<>'.' then

begin

StringBuiletNum:=EnumBuiletsNamesFile. Name;

Delete (StringBuiletNum, Length(StringBuiletNum) - 3,4);

if TestByDigit(StringBuiletNum) then

if ConverHLrToIntNum(StringBuiletNum)=FileNum then

begin

result:=QuestionsPathName+'\'+EnumBuiletsNamesFile. Name;

break;

end;

end;

until FindNext(EnumBuiletsNamesFile)<>0;

FindClose(EnumBuiletsNamesFile);

If Result='' then ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrQuestionFileWithInputedNumberNotFound);

end;

function TQuestDB. GetRandomFileBuilet (BuiletNum:integer):string;

var EnumBuiletsNamesFile:TSearchRec;

RndCount:integer;

FileList:HLringList;

WorkPath:string;

begin

Result:='';

FileList:=HLringList. Create;

FileList. Clear;

WorkPath:=QuestionsPathName+'\'+IntToStr(BuiletNum);

if DirectoryExists(WorkPath) then

begin

FindFirst (WorkPath+'\*', faAnyFile, EnumBuiletsNamesFile);

repeat

if EnumBuiletsNamesFile. Name[1]<>'.' then

FileList. Add (EnumBuiletsNamesFile. Name);

until FindNext(EnumBuiletsNamesFile)<>0;

FindClose(EnumBuiletsNamesFile);

if FileList. Count>0 then

begin

Randomize;

RndCount:=Random (FileList. Count);

Result:=QuestionsPathName+'\'+IntToStr(BuiletNum)+'\'+FileList. Strings[RndCount];

end;

end;

FileList. Destroy;

If Result='' then ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrGenerationRndQuest);

end;

function TQuestDB. GetTrueAnswerForBuilet (QuestionPath:string):integer;

var QuestNum:integer;

TmpStr:string;

KeyFilePath:string;

TempQuestionsList:HLringList;

begin

Result:=-1;

QuestNum:=0;

TmpStr:=ExtractFileName(QuestionPath);

Delete (TmpStr, Length(TmpStr) - Length (ExtractFileExt(TmpStr))+1, Length (ExtractFileExt(TmpStr)));

if (TestByDigit(TmpStr)) and (Length(TmpStr)<5) then

begin

QuestNum:=StrToInt(TmpStr);

end else

begin

ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrInvalidFileNameTraslate);

Result:=-1;

exit;

end;

KeyFilePath:=ExtractFilePath (ExtractFileDir(QuestionPath))+'QuestKey.ini';

if FileExists(KeyFilePath) then

begin

TempQuestionsList:=HLringList. Create;

TempQuestionsList. LoadFromFile(KeyFilePath);

Result:=StrToInt (TempQuestionsList. Strings[QuestNum]);

TempQuestionsList. Destroy;

end else ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrConfigIniFileWorkSetNotFound);

end;

function TQuestDB. SetTrueAnswerForBuilet (QuestionPath:string; TrueAnswer: Integer):boolean;

var QuestNum:integer;

TmpStr:string;

KeyFilePath:string;

TempQuestionsList:HLringList;

begin

Result:=false;

QuestNum:=0;

TmpStr:=ExtractFileName(QuestionPath);

Delete (TmpStr, Length(TmpStr) - Length (ExtractFileExt(TmpStr))+1, Length (ExtractFileExt(TmpStr)));

if (TestByDigit(TmpStr)) and (Length(TmpStr)<5) then

begin

QuestNum:=StrToInt(TmpStr);

end else ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrInvalidFileNameTraslate);

KeyFilePath:=ExtractFilePath (ExtractFileDir(QuestionPath))+'QuestKey.ini';

if FileExists(KeyFilePath) then

begin

TempQuestionsList:=HLringList. Create;

TempQuestionsList. LoadFromFile(KeyFilePath);

TempQuestionsList. Strings[QuestNum]:=IntToStr(TrueAnswer);

TempQuestionsList. SaveToFile (KeyFilePath+'_');

TempQuestionsList. Destroy;

DeleteFile(KeyFilePath);

RenameFile (KeyFilePath+'_', KeyFilePath);

Result:=true;

end else ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrConfigIniFileWorkSetNotFound);

end;

end.

unit UBaseWork;

interface

uses Windows, Messages, SysUtils, Classes, Dialogs, IniFiles;

const

ErrImputGroupNumberFault = 1;

ErrImputUserNumberFault = 2;

type

UsersDBase=record

Groups:HLringList;

Users:array of HLringList;

end;

type

TUsersDB = class

private

SelfParent:HWND;

UsersDataBase: UsersDBase;

GroupsCount:integer;

ProgRootDir:string;

ActiveGroup:string;

ActiveUser:string;

ActivStationIP:string;

ActiveGroupNum:byte;

ActiveUserNum:byte;

procedure ERROR_MESSAGE_FOR_DEBUG_LEVEL (ErrID: byte);

procedure SMessage (Message_: string);

public

property TransactionIP:string read ActivStationIP write ActivStationIP;

property ActiveUserName:string read ActiveUser;

property ActiveGroupName:string read ActiveGroup;

function SetActiveGroup (Num: byte): boolean;

function SetActiveUser (Num: byte): boolean;

function GetGroupByIndex (i: byte): string;

function GetUserByIndex (i: byte): string;

function GetGroupsStringList: string;

function GetUsersStringList: string;

constructor Create (ParentHwnd:HWND);

destructor Destroy; override;

end;

implementation

{TQuestDB}

constructor TUsersDB. Create (ParentHwnd: HWND);

var ExeName:PChar;

AppName: String;

ExeNameLen:byte;

 /////

NewSearch_:TSearchRec;

CleanName:string;

i:byte;

begin

SelfParent:=ParentHwnd;

GetMem (ExeName, 255);

ExeNameLen:=255;

GetModuleFileName (0, ExeName, ExeNameLen); // определяем имя исполняемого модуля

AppName:=StrPas(ExeName);

ProgRootDir:=ExtractFileDir(AppName);

GroupsCount:=0;

UsersDataBase. Groups:=HLringList. Create;

FindFirst (ProgRootDir+'\Groups\*', faDirectory, NewSearch_);

repeat

if NewSearch_.Name[1]<>'.' then

begin

UsersDataBase. Groups. Add (NewSearch_.Name);

inc(GroupsCount);

end;

until FindNext (NewSearch_)<>0;

FindClose (NewSearch_);

SetLength (UsersDataBase. Users, GroupsCount);

for i:=0 to GroupsCount-1 do

begin

UsersDataBase. Users[i]:=HLringList. Create;

UsersDataBase. Users[i].LoadFromFile (ProgRootDir+'\Groups\'+UsersDataBase. Groups. Strings[i]);

CleanName:=UsersDataBase. Groups. Strings[i];

Delete (CleanName, Length(CleanName) - 3,4);

UsersDataBase. Groups. Strings[i]:=CleanName;

end;

end;

destructor TUsersDB. Destroy;

var i:integer;

begin

for i:=0 to UsersDataBase. Groups. Count-1 do

begin

UsersDataBase. Users[i].Destroy;

end;

SetLength (UsersDataBase. Users, 0);

UsersDataBase. Groups. Destroy;

inherited;

end;

function TUsersDB. SetActiveGroup (Num:byte):boolean;

begin

result:=false;

if Num< UsersDataBase. Groups. Count then

begin

ActiveGroup:=UsersDataBase. Groups. Strings[Num];

ActiveGroupNum:=Num;

result:=true;

end else ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrImputGroupNumberFault);

end;

function TUsersDB. SetActiveUser (Num:byte):boolean;

begin

result:=false;

if Num< UsersDataBase. Users[ActiveGroupNum].Count then

begin

ActiveUser:=UsersDataBase. Users[ActiveGroupNum].Strings[num];

ActiveUserNum:=Num;

result:=true;

end else ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrImputUserNumberFault);

end;

procedure TUsersDB.ERROR_MESSAGE_FOR_DEBUG_LEVEL (ErrID: byte);

begin

Case ErrID of

ErrImputGroupNumberFault:

SMessage ('Imput group number fault');

ErrImputUserNumberFault:

SMessage ('Imput user number fault');

end;

end;

Procedure TUsersDB.SMessage (Message_:string);

begin

SendMessage (SelfParent, WM_User+2, DWord (PChar(ActivStationIP+' '+Message_)), 0);

end;

function TUsersDB. GetGroupByIndex (i:byte): string;

begin

if i<=UsersDataBase. Groups. Count-1 then Result:=UsersDataBase. Groups. Strings[i] else Result:='';

end;

function TUsersDB. GetUserByIndex (i:byte): string;

begin

if i<=UsersDataBase. Users[ActiveGroupNum].Count-1 then

Result:=UsersDataBase. Users[ActiveGroupNum].Strings[i] else Result:='';

end;

function TUsersDB. GetGroupsStringList: string;

var i:integer;

begin

Result:='';

for i:=0 to UsersDataBase. Groups. Count-1 do Result:=Result+UsersDataBase. Groups. Strings[i]+'|';

Result:=Result+'>';

end;

function TUsersDB. GetUsersStringList: string;

var i:integer;

begin

Result:='';

for i:=0 to UsersDataBase. Users[ActiveGroupNum].Count-1 do Result:=Result+UsersDataBase. Users[ActiveGroupNum].Strings[i]+'|';

Result:=Result+'>';

end;

end.

unit Registation;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls;

type

HLartForm = class(TForm)

Panel2: TPanel;

ComboBox3: TComboBox;

ComboBox4: TComboBox;

Label5: TLabel;

Label6: TLabel;

Bevel2: TBevel;

Bevel3: TBevel;

Panel1: TPanel;

Bevel4: TBevel;

Bevel5: TBevel;

Label3: TLabel;

Label4: TLabel;

ComboBox1: TComboBox;

ComboBox2: TComboBox;

Bevel6: TBevel;

Bevel7: TBevel;

Panel3: TPanel;

Bevel1: TBevel;

Button1: TButton;

Button2: TButton;

Button3: TButton;

Panel4: TPanel;

procedure ComboBox1Change (Sender: TObject);

procedure Button2Click (Sender: TObject);

procedure Button1Click (Sender: TObject);

procedure Button3Click (Sender: TObject);

procedure ComboBox3Change (Sender: TObject);

procedure ComboBox2Change (Sender: TObject);

procedure FormClose (Sender: TObject; var Action: TCloseAction);

private

ServerIPAddress:string[15]; //IP адрес

Steps:byte; // номер шага регистрации (условно)

NoModify:boolean; // триггер интерфейса

function ReadServerIP: string; // чтение из файла IP.DAT информации о IP адресе сервера

public

procedure GetConnect; // Установка соединение

procedure HideWin_(YN: boolean); // скрыть элементы управления Windows (TaskBar, Deskdop)

procedure ExitProgram;

end;

var

StartForm: HLartForm;

implementation

uses MainForm;

{ /////////////////////////////////////////////////////

BEGIN

Сервисные подпрограммы

 ////////////////////////////////////////////////////// }

function HLartForm. ReadServerIP: string;

var IPInfFile:textfile;

IP:string;

begin

if fileexists (extractfilepath(application. ExeName)+'IP. Dat') then

begin

assignfile (IPInfFile, extractfilepath (application. ExeName)+'IP. Dat');

{$i-}

reset(IPInfFile);

Readln (IPInfFile, IP);

closefile(IPInfFile);

{$i+}

if ip<>'' then

begin

ReadServerIP:=IP;

end

else ReadServerIP:='127.0.0.1';

end else

begin

ReadServerIP:='127.0.0.1';

end;

end;

procedure HLartForm. HideWin_(YN:boolean);

var Wnd: hWnd;

ClassName:PChar;

ClassNameLen:byte;

Res:string;

begin

Wnd:=FindWindow ('Progman', 'Program Manager');

while wnd<>0 do

begin

wnd:=GetWindow (Wnd, GW_CHILD);

ClassNameLen:=0;

GetClassName (Wnd, ClassName, ClassNameLen);

SeHLring (Res, ClassName, ClassNameLen);

SeHLring (Res, ClassName, StrLen(ClassName));

if Res='SysListView32' then

begin

if YN=true then

begin

ShowWindow (Wnd, SW_Hide);

ShowWindow (findwINDOW('Shell_TrayWnd', nil), SW_Hide);

end else

begin

ShowWindow (Wnd, SW_Show);

ShowWindow (findwINDOW('Shell_TrayWnd', nil), SW_Show);

end;

break;

end;

end;

FreeMem (ClassName, 255);

end;

procedure HLartForm. ExitProgram;

begin

HideWin_(false);

Application. ProcessMessages;

Application. Terminate;

end;

{ /////////////////////////////////////////////////////

Сервисные подпрограммы

END

 ////////////////////////////////////////////////////// }

{ /////////////////////////////////////////////////////

BEGIN

Сетевые подпрограммы

 ////////////////////////////////////////////////////// }

procedure HLartForm. GetConnect;

begin

try

ServerIPAddress:=ReadServerIP;

TestForm. TestSocket. Address:=ServerIPAddress;

TestForm. TestSocket. Active:=true;

except

end;

end;

{ /////////////////////////////////////////////////////

Сетевые подпрограммы

END

 ////////////////////////////////////////////////////// }

{ /////////////////////////////////////////////////////

BEGIN

Обработка пользовательского интерфейса

 ////////////////////////////////////////////////////// }

procedure HLartForm. ComboBox1Change (Sender: TObject);

var Data:string;

begin

Data:=Char (NM_Register2)+Char (TestForm. MyNumber)+Char (ComboBox1. ItemIndex);

TestForm. TestSocket. Socket. SendBuf (Pointer(Data)^, Length(Data));

ComboBox3. Clear;

ComboBox4. Clear;

ComboBox2. Clear;

NoModify:=false;

Steps:=0;

end;

procedure HLartForm. Button2Click (Sender: TObject);

begin

Close;

end;

procedure HLartForm. Button1Click (Sender: TObject);

var Data:string;

begin

case Steps of // Дальнейшее действие

0:if ComboBox2. Text<>'' then

begin

NoModify:=true;

Data:=Char (NM_RegisterGetWorks)+Char (TestForm. MyNumber)+Char (ComboBox1. ItemIndex);

TestForm. TestSocket. Socket. SendBuf (Pointer(Data)^, Length(Data)); // Запрос на получение списка предметов

end;

Button3. Enabled:=true;

Panel1. Hide;

Panel2. Show; Steps:=1;

end;

1: if Panel2. Visible then

begin

if ComboBox4. Text<>'' then

begin

Data:=Char (NM_RegisterOK)+Char (TestForm. MyNumber)+

Char (ComboBox1. ItemIndex)+Char (ComboBox2. ItemIndex)+Char (ComboBox3. ItemIndex)+Char (ComboBox4. ItemIndex);

TestForm. TestSocket. Socket. SendBuf (Pointer(Data)^, Length(Data)); // Отсылка сведений для

 // окончательной регистрации

Self. Hide;

HideWin_(true);

end;

end else

begin

Panel1. Hide;

Panel2. Show;

Button3. Enabled:=true;

Steps:=1;

end;

end;

end;

procedure HLartForm. Button3Click (Sender: TObject);

begin

Panel2. Hide;

Panel1. Show;

Button3. Enabled:=false;

end;

procedure HLartForm. ComboBox3Change (Sender: TObject);

var Data:string;

begin

uses

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

Dialogs, WinSock, ExtCtrls, Buttons, StdCtrls, ScktComp;

const

NM_Register1 = 6; // прием списка групп

NM_Register2 = 7; // запрос на список студентов

NM_RegisterGetWorks = 66; // запрос / ответ 'список предметов'

NM_RegisterGetTeachers = 77; // запрос / ответ 'список преподователей'

NM_RegisterOK = 8; // клиент зарегистрирован

NM_Service = 31; // прием сервисной информации

NM_TestEvent = 55; // событие по ходу тестирования

NM_FileOperation = 10; // сетевая операция с файлами

NM_EndOfTest = 33; // окончание тестирования

NM_KickFromServer = 44; // отключение от сервера администратором

NM_Wait = 61;

NM_DataError = 54; // проблема с БД

procedure TTestForm. TestSocketRead (Sender: TObject;

Socket: TCustomWinSocket);

type TDataBuffer=array of byte; // буфер данных

var Data, Data1:string; // данные

SendLen:integer;

DataBuffer:TDataBuffer;

i: Word;

Command:byte;

GetSize:PInt64;

SizeOfFilename:byte;

PTrueAnswer:PWord;

PTimeForPassTest:PDouble;

begin

SendLen:=Socket. ReceiveLength; // размер принятых данных

SetLength (DataBuffer, SendLen);

Socket. ReceiveBuf (Pointer(DataBuffer)^, SendLen); // заполняем буфер

if lock then // если в режиме приема файла то продолжить прием

begin

MakePointer:=DWORD(DataBuffer);

NewFile. WriteBuffer (Pointer(MakePointer)^, SendLen);

SendedSize:=SendedSize+SendLen;

if SendedSize=FileSize then // если приняли весь файл то выход

begin

lock:=false;

NewFile. Destroy;

SetImg(FileName);

end;

end else

begin

Command:=DataBuffer[0];

case Command of

NM_Register1:

begin

MyNumber:=DataBuffer[1];

i:=2;

while i<=SendLen-3 do

begin

Data:='';

while DataBuffer[i]<>byte ('|') do

begin

Data:=Data+Char (DataBuffer[i]);

inc(i);

end;

if Data<>'' then StartForm. ComboBox1. Items. Add(Data);

if DataBuffer [i+1]=byte ('>') then break;

inc(i);

end;

end;

NM_Register2: // список студентов

begin

i:=1;

while i<=SendLen-2 do

begin

Data:='';

while DataBuffer[i]<>byte ('|') do

begin

Data:=Data+Char (DataBuffer[i]);

inc(i);

end;

if Data<>'' then StartForm. ComboBox2. Items. Add(Data);

if DataBuffer [i+1]=byte ('>') then break;

inc(i);

end;

end;

NM_RegisterGetWorks:

begin

i:=1;

StartForm. ComboBox3. Clear;

while i<=SendLen-2 do

begin

Data:='';

while DataBuffer[i]<>byte ('|') do

begin

Data:=Data+Char (DataBuffer[i]);

inc(i);

end;

if Data<>'' then StartForm. ComboBox3. Items. Add(Data);

if DataBuffer [i+1]=byte ('>') then break;

inc(i);

end;

end;

NM_RegisterGetTeachers:

begin

StartForm. ComboBox4. Clear;

i:=1;

while i<=SendLen-2 do

begin

Data:='';

while DataBuffer[i]<>byte ('|') do

begin

Data:=Data+Char (DataBuffer[i]);

inc(i);

end;

if Data<>'' then StartForm. ComboBox4. Items. Add(Data);

if DataBuffer [i+1]=byte ('>') then break;

inc(i);

end;

end;

NM_FileOperation:

begin

lock:=true;

PTrueAnswer:=Addr (DataBuffer[1]);

TrueAnswer:=PTrueAnswer^;

QuestionStyle:=DataBuffer[3];

GetSize:=Addr (DataBuffer[4]);

FileSize:=GetSize^;

SizeOfFilename:=DataBuffer[12];

Filename:=ApplicationPath+'Data.tmp'; // имя передаваемого файла

Deletefile(FileName);

NewFile:=TFileStream. Create (FileName, fmCreate);

NewFile. Position:=0;

MakePointer:=DWORD(DataBuffer)+13+SizeOfFilename; // 13=1+1+1+1+8+1

NewFile. WriteBuffer (Pointer(MakePointer)^, SendLen-13-SizeOfFilename);

SendedSize:=SendLen-13-SizeOfFilename;

if SendedSize=FileSize then // если приняли весь файл то выход

begin

lock:=false;

NewFile. Destroy;

SetImg(FileName);

end;

end;

NM_EndOfTest:

begin

SpeedButton5. Enabled:=false;

TestPassed:=true;

Mark:=DataBuffer[1];

PostMessage (Handle, WM_User, 0,0);

end;

NM_KickFromServer:

begin

TestTerminated:=true;

Label7. Hide;

Label8. Hide;

Button2. Hide;

Panel7. Caption:='Тестирование прервано';

PostMessage (Handle, WM_User, 0,0);

end;

NM_Service:

begin

QuestionsCount:=DataBuffer[1];

PTimeForPassTest:=Addr (DataBuffer[2]);

TimeForPassTest:=TTime (PTimeForPassTest^);

end;

NM_DataError:

begin

SendLen:=DataBuffer[1];

Data1:=Copy (PChar(DataBuffer), 3, SendLen)+#13+#10+#0;

PostMessage (Handle, WM_User+1, DWORD (PChar(Data1)), 1);

end;

NM_Wait: ShowMessage('Wait');

end;

end;

SetLength (DataBuffer, 0);

end;

procedure TTestForm. CloseNetworkSocket (var Message: TMessage);

begin

TestSocket. Active:=false;

TestSocket.close;

if TestForm. Visible then

begin

Panel8. Hide;

Panel7. Top:=Panel8. Top;

Panel7. Left:=Panel8. Left;

Panel7. Width:=Panel8. Width;

Panel7. Height:=Panel8. Height;

Panel7. Visible:=true;

if TestPassed then Panel7. Caption:=IntToStr(Mark) else

begin

Application. ProcessMessages;

Sleep(4000);

Application. ProcessMessages;

Application. Terminate;

end;

end else // если окно теста не открыто

begin

StartForm. Panel4. Visible:=true;

Application. ProcessMessages;

Sleep(4000);

Application. ProcessMessages;

Application. Terminate;

end;

end;

procedure TTestForm. TestSocketDisconnect (Sender: TObject;

Socket: TCustomWinSocket);

begin

if not (TestPassed or TestTerminated) then Application. Terminate;

end;

{ /////////////////////////////////////////////////////

Сетевые подпрограммы

END

 ////////////////////////////////////////////////////// }

end;

end.

1. Архангельский А.Я. Delphi 7 Справочное пособие. - М., Бином-Пресс. -2004. -1024 с.

2. Архангельский А.Я. Программирование в Delphi 7 + дискета, Бином, 2005

3. Бондаренко Е.А. Технические средства обучения в современной школе, Юверс, 2004

4. Вигерс Карл. Разработка требований к программному обеспечению. /Пер, с англ. - М.: Издательско-торговый дом «Русская Редакция», 2004. - 576 с.

5. Гаврилова Т.А., Хорошевский В.Ф. Базы знаний интеллектуальных систем. - СПб.: Питер, 2001. - 384 с.: ил.

6. Глушаков С.В., Клевцов А.Л., Программирование в среде Delphi 7.0, Фолио 2003

7. Дьяконов В.П. Новые информационные технологии, Солон-Пресс, 2005

8. Земсков А.И., Шрайберг Я.Л. Электронные библиотеки, Либерея, 2003

9. Клименко Р.Н. Оптимизация и автоматизация работы на ПК на 100% (+CD), Питер Пресс, 2007

10. Колин К.К. Фундаментальные основы информатики: социальная информатика / Учебное пособие для вузов. - М.: Академический проект, 200 -350 с.

11. Кондратьев Г.Г. Осваиваем Windows XP, Питер, 2005

12. Коплиен Дж., Мультипарадигменное проектирование для C++, Питер, 2005

13. Красильникова В.А. Становление и развитие компьютерных технологий обучения: Монография. - М.: ИИО РАО, 2002. - 168 с.

14. Круглински Д., Уингоу С, Шеферд Дж. Программирование на Microsoft Visual C++ 6.0 для профессионалов. /Пер, с англ. - СПб: Питер; М.: Издательско-торговый дом «Русская Редакция», 2004. - 861 с.

15. Леонтьев Б.К., Мультимедия Microsoft Windows без страха, Новый издательский дом, 2005

16. Мандел Т. Дизайн интерфейсов, ДМК, 2005

17. Музыченко Е.В., Фролов И.Б., Мультимедия для Windows, 2003

18. Пайс А. Гении науки. - М.: Институт компьютерных исследований, 2002

19. Архангельский А.А. Программирование в Delphi. - М.: Бином, 2003. - 1231 с.

20. Гофман В.Э., Хомоненко А.Д. Delphi 5. - СПб.: БХВ - Санкт Петербург, 2000. - 800 с.

21. Епанешников А., Епанешников В. Программирование в среде Delphi: Учебное пособие: В 4-х ч. Ч. 4. Работа с базами данных. Организация справочной системы - М.: ДИАЛОГ - МИФИ, 1998. - 400 с.

22. Зубков Сергей Владимирович Assembler для Dos, Windows, Unix. - М.: ДМКПресс, 2000. - 652 с.

23. Кэнту Марко Delphi 5.0 для профессионалов. - СПб.: Питер, 2001. - 1064 с.

24. Пирогов В.Ю. Assembler учебный курс. - М.: «Нолидж», 2001. - 926 с.

25. Рейнхардт Р., Ленц Д.У. Flash 5. Библия пользователя. - М.: «Вильямс», 2001. - 1164 с.

26. Фигурнов В.Э. IBM PC для пользователя. Изд. 7-е, перераб. и доп. - М.: ИНФРА - М, 1998. - 640 с.

27. Батищев П.С. Электронный On-Line учебник по курсу информатика.

28. Ивановский Р.И. Компьютерные технологии в науке и образовании. Практика применения систем Math CAD Pro, Высшая школа, 2003

29. Каймин В.А., Жданов В.С. и др. «Информатика» для поступающих в ВУЗы. Москва, АСТ, 2006 г.

30. Кудрявцев Е.М. Оформление дипломного проекта на компьютере, АСВ, 2004