Таблица 2. Трудоёмкость разработки по стадиям

Стадия разработки проекта	Затраты времени	Поправочный коэффициент	Затраты времени с учётом поправочного коэффициента
	Значение	Значение
1	2	3	4
1. Разработка технического задания
1.1. Затраты времени разработчика постановки задачи	15	0,65	9,5
1.2. Затраты времени разработчика программного обеспечения	15	0,35	5,25
2. Разработка эскизного проекта
2.1. Затраты времени разработчика постановки задачи	34	0,7	23,8
2.2. Затраты времени разработчика программного обеспечения	34	0,3	10,2
3. Разработка технического проекта
3.1. Затраты времени разработчика постановки задачи	9	1,827	16,443
3.2. Затраты времени разработчика программного обеспечения	5	1,827	9,135
4. Разработка рабочего проекта
4.1. Затраты времени разработчика постановки задачи	3	3,6936	11,0808
4.2. Затраты времени разработчика программного обеспечения	27	3,6936	99,7272
5. Внедрение
5.1. Затраты времени разработчика постановки задачи	5	1,39	6,95
5.2. Затраты времени разработчика программного обеспечения	5	1,39	6,95

Время работы ЭВМ при отладке и внедрении программы складывается из затрат времени разработчика программного обеспечения на технический проект, рабочий проект и внедрение.

Таким образом, затраты времени на отладку и внедрение составляют 49 человеко-дней или 392 часов.

6.1.1 Расчёт стоимости одного машинного часа.

Стоимость одного машинного часа определяется по формуле

, где (7)

Э_ксп - эксплуатационные годовые затраты (в рублях);

Т_ф - количество часов, отработанных всеми машинами в год (час).

Эксплуатационные годовые затраты включают в себя:

1 Годовая амортизация оборудования (Аоб), формула 8;

2 Годовые затраты на ремонт оборудования (Роб), формула 9;

3 Расходы на электроэнергию (Зэл), формула 10;

4 Прочие расходы (Зпр), формула 14.

1. Годовая амортизация оборудования определяется:

, где (8)

К_осн - коэффициент амортизации основного оборудования (в процентах);

С_осн - стоимость основного оборудования (в рублях);

К_всп - коэффициент амортизации вспомогательного оборудования (в процентах);

С_всп - стоимость вспомогательного оборудования (в рублях).

В данном случае стоимость одного принтера пропорционально распределена между двумя компьютерами.

руб.

2. Годовые затраты на текущий ремонт составляют 5% от общей стоимости используемого оборудования.

, где (9)

С_общ - общая стоимость оборудования (в рублях).

руб.

3. Затраты на электроэнергию складываются из расходов на освещение В_ос (формула 10) и расходов на производственное потребление электроэнергии В_э (формула 11).

З_эл=В_ос+В_э, где (10)

В_ос - расходы на освещение (в рублях);

В_э - расходы на производственное потребление электроэнергии (в рублях).

, где (11)

S - площадь помещения (в квадратных метрах);

К_э - усреднённый расход энергии, для освещения одного квадратного метра площади помещения в год (кВт на квадратный метр);

С_тар - тариф (в рублях).

руб.

, где (12)

Н_уст - мощность одного компьютера (кВт);

Н - количество компьютеров (штук);

К - коэффициент учитывающий потери в сети;

С_тар - тариф (в рублях);

Ф - годовой фонд времени работы оборудования рассчитывается по формуле:

, где (13)

Н_г - число дней в году;

Н_вых - число выходных дней в году;

Н_пр - число праздничных дней в году;

К_см - коэффициент сменности;

Ф_дн - продолжительность рабочего дня;

К_заг - коэффициент загрузки оборудования;

К_рем - коэффициент, учитывающий потери времени на ремонт оборудования.

часа.

Тогда расходы на производственное потребление электроэнергии (по формуле 12) равны руб.

Затраты на электроэнергию (по формуле 10) равны руб.

4. Прочие расходы составляют 5% от суммы расходов по предыдущим пунктам.

, где (14)

А_об - сумма годовой амортизации (в рублях);

Р_общ - годовые затраты на ремонт (в рублях);

Э - расходы на электроэнергию (в рублях).

руб.

Тогда эксплуатационные годовые расходы составляют:

, где (15)

А_об - сумма годовой амортизации (в рублях);

Р_общ - годовые затраты на ремонт (в рублях);

Э - расходы на электроэнергию (в рублях);

З_пр - прочие расходы (в рублях).

руб.

Количество часов, отработанных всеми машинами в год равно:

, где (16)

Н - количество компьютеров (в штуках);

Ф - годовой фонд времени работы оборудования (в часах).

часов

Тогда стоимость одного машинного часа (по формуле 7) равна:

руб.

6.1.2 Расчёт стоимости программного продукта.

Стоимость программного продукта определяется по формуле:

, где (17)

Т_дн - затраты времени на разработку (чел.-дней);

З_мес - среднемесячная зарплата (в рублях);

Н_дн - количество рабочих дней в месяце (дни);

Т_маш - затраты времени на отладку и внедрение (в часах);

С_м.ч. - стоимость одного машинного часа (в рублях).

руб.

Заключение

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

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

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

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

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

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

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

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

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

Приложение 1

Листинг кода серверной части программы

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