48627 (Разработка программного обеспечения для оценки уровня знаний студентов с применением технологии "Клиент-сервер"), страница 8
Описание файла
Документ из архива "Разработка программного обеспечения для оценки уровня знаний студентов с применением технологии "Клиент-сервер"", который расположен в категории "". Всё это находится в предмете "информатика" из , которые можно найти в файловом архиве . Не смотря на прямую связь этого архива с , его также можно найти и в других разделах. Архив можно найти в разделе "остальное", в предмете "информатика, программирование" в общих файлах.
Онлайн просмотр документа "48627"
Текст 8 страницы из документа "48627"
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 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 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. Архангельский А.Я. Delphi 7 Справочное пособие. – М., Бином-Пресс. -2004. -1024 с. Архангельский А.Я. Программирование в Delphi 7 + дискета, Бином, 2005 Бондаренко Е.А. Технические средства обучения в современной школе, Юверс, 2004 Вигерс Карл. Разработка требований к программному обеспечению. /Пер, с англ. – М.: Издательско-торговый дом «Русская Редакция», 2004. - 576 с. Гаврилова Т.А., Хорошевский В.Ф. Базы знаний интеллектуальных систем. – СПб.: Питер, 2001. – 384 с.: ил. Глушаков С.В., Клевцов А.Л., Программирование в среде Delphi 7.0, Фолио 2003 Дьяконов В.П. Новые информационные технологии, Солон-Пресс, 2005 Земсков А.И., Шрайберг Я.Л. Электронные библиотеки, Либерея, 2003 Клименко Р.Н. Оптимизация и автоматизация работы на ПК на 100% (+CD), Питер Пресс, 2007 Колин К.К. Фундаментальные основы информатики: социальная информатика / Учебное пособие для вузов. – М.: Академический проект, 200 –350 с. Кондратьев Г.Г. Осваиваем Windows XP, Питер, 2005 Коплиен Дж., Мультипарадигменное проектирование для C++, Питер, 2005 Красильникова В.А. Становление и развитие компьютерных технологий обучения: Монография. – М.: ИИО РАО, 2002. – 168 с. Круглински Д., Уингоу С, Шеферд Дж. Программирование на Microsoft Visual C++ 6.0 для профессионалов. /Пер, с англ. – СПб: Питер; М.: Издательско-торговый дом «Русская Редакция», 2004. – 861 с. Леонтьев Б.К., Мультимедия Microsoft Windows без страха, Новый издательский дом, 2005 Мандел Т. Дизайн интерфейсов, ДМК, 2005 Музыченко Е.В., Фролов И.Б., Мультимедия для Windows, 2003 Пайс А. Гении науки. – М.: Институт компьютерных исследований, 2002 Архангельский А.А. Программирование в Delphi. – М.: Бином, 2003. – 1231 с. Гофман В.Э., Хомоненко А.Д. Delphi 5. – СПб.: БХВ – Санкт Петербург, 2000. – 800 с. Епанешников А., Епанешников В. Программирование в среде Delphi: Учебное пособие: В 4-х ч. Ч. 4. Работа с базами данных. Организация справочной системы – М.: ДИАЛОГ – МИФИ, 1998. – 400 с. Зубков Сергей Владимирович Assembler для Dos, Windows, Unix. – М.: ДМКПресс, 2000. – 652 с. Кэнту Марко Delphi 5.0 для профессионалов. – СПб.: Питер, 2001. – 1064 с. Пирогов В.Ю. Assembler учебный курс. – М.: «Нолидж», 2001. – 926 с. Рейнхардт Р., Ленц Д.У. Flash 5. Библия пользователя. – М.: «Вильямс», 2001. – 1164 с. Фигурнов В.Э. IBM PC для пользователя. Изд. 7-е, перераб. и доп. – М.: ИНФРА – М, 1998. – 640 с. Батищев П.С. Электронный On-Line учебник по курсу информатика. Ивановский Р.И. Компьютерные технологии в науке и образовании. Практика применения систем Math CAD Pro, Высшая школа, 2003 Каймин В.А., Жданов В.С. и др. «Информатика» для поступающих в ВУЗы. Москва, АСТ, 2006 г. Кудрявцев Е.М. Оформление дипломного проекта на компьютере, АСВ, 2004
Приложение 2
Листинг кода клиентской части программы
Литература