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;

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11