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

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

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;