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

Обновлено 2026-10-10

p align="left">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;

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;

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

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;

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;

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;

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;

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;

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;

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;

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;

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.

Приложение 2Листинг кода клиентской части программы

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;

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;

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

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

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

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;

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;

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;

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;

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;

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;

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;

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;

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

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