А. Григорьев - О чём не пишут в книгах по Delphi
GetErrorString, mtError, [mbOK], 0);
// Так как сокет был успешно создан,
// в случае ошибки его нужно удалить
closesocket(FSocket);
FSocket := 0;
Exit;
end;
// Включаем режим "Соединение установлено"
OnConnect;
except
on EConvertError do
// Это исключение может возникнуть только в одном месте -
// при вызове StrToInt(EditPort.Text)
MessageDlg('"' + EditPort.Text + '"не является целым числом',
mtError, [mbOK], 0);
on ERangeError do
// Это исключение может возникнуть только в одном месте -
// при присваивании значения номеру порта
MessageDlg('Номер порта должен находиться в диапазоне 1-65535',
mtError, [mbOK], 0);
end;
end;
Теперь посмотрим, как клиент реагирует на нажатие кнопки Отправить (листинг 2.17). Сама по себе отправка — вещь очень простая: нужно сформировать адрес получателя и вызвать функцию send. Несколько сложнее выполняется чтение данных, потому что, согласно нашему протоколу, клиент не знает, сколько байтов он должен прочитать, и читает до тех пор, пока не встретит символ #0.
Листинг 2.17. Обработчик нажатия кнопки Отправитьprocedure TSimpleClientForm.BtnSendClick(Sender: TObject);
const
// Данные из буфера сокета мы будем читать порциями.
// константа BufStep определяет размер порции
BufStep = 10;
var
Str: string
StrLen, BufStart, Portion: Integer;
Buf: array of Char;
begin
Str := EditStringToSend.Text;
StrLen := Length(Str);
if StrLen = 0 then
begin
MessageDlg('Протокол не допускает отправки пустых строк',
mtError, [mbOK], 0);
Exit;
end;
// отправляем серверу длину строки
if send(FSocket, StrLen, SizeOf(StrLen), 0) < 0 then
begin
MessageDlg('Ошибка при отправке данных серверу '#13#10 +
GetErrorString, mtError, [mbOK], 0);
OnDisconnect;
Exit;
end;
// Отправляем серверу строку
if send(FSocket, Str[1], StrLen, 0) < 0 then
begin
MessageDlg('Ошибка при отправке данных серверу: '#13#10 +
GetErrorString, mtError, [mbOK], 0);
OnDisconnect;
Exit;
end;
BufStart := 0;
// Цикл получения ответа от сервера
// завершается, когда получаем посылку, оканчивающуюся на #0
repeat
SetLength(Buf, Length(Buf) + BufStep);
// Читаем очередную порцию ответа от сервера
Portion := recv(FSocket, Buf(BufStart), BufStep, 0);
if Portion <= 0 then
begin
MessageDlg('Ошибка при получении ответа от сервера: '#13#10 +
GetErrorString, mtError, [mbOK], 0);
OnDisconnect;
Exit;
end;
// Если порция кончается на #0, ответ прочитан полностью, выходим из
// цикла. Здесь мы использовали особенность нашего протокола, который
// запрещает серверу присылать несколько строк подряд, следующая
// строка будет выслана сервером только после нового запроса от
// клиента. Если бы протокол допускал отправку сервером нескольких
// ответов подряд, при чтении очередной порции данных могло бы
// оказаться, что начало порции принадлежит одной строке, конец -
// следующей, а признак конца строки нужно искать где-то в середине
if Buf[BufStart + Portion - 1] = #0 then
begin
EditReply.Text := PChar(@Buf[0]);
Break;
end;
Inc(BufStart, BufStep);
until False;
end;
Реакция на кнопку Отсоединиться совсем простая: нужно разорвать соединение и закрыть сокет (листинг 2.18).
Листинг 2.18. Реакция на нажатие кнопки Отсоединитьсяprocedure TSimpleClientForm.BtnDisconnectClick(Sender: TObject);
begin
shutdown(FSocket, SD_BOTH);
closesocket(FSocket);
OnDisconnect;
end;
Откомпилируем наши примеры и посмотрим, что получилось. Пока у нас один клиент работает с одним сервером, все вполне предсказуемо: клиент передает сообщения, сервер на них отвечает. Попытаемся подключиться вторым клиентом, не отключая первый, и посмотрим, что будет. Само подключение с точки зрения клиента проходит нормально, хотя сервер находится в своем внутреннем цикле и не вызывает accept, для второго клиента. Впрочем, как мы знаем, для успешного выполнения функции connect на стороне клиента достаточно, чтобы сокет сервера находился в режиме прослушивания. Теперь попытаемся отправить что-то серверу со второго клиента. Сама отправка проходит успешно, но при попытке получить ответ клиент "зависает", т.к. функция recv блокирует нить до прихода данных, а данные не приходят, потому что сервер не обрабатывает сообщения от этого клиента. Отсоединим первый клиент от сервера, чтобы сервер вернулся к выполнению функции accept. Мы видим, что сервер немедленно обнаружил подключение второго клиента, а также то, что клиент прислал ему сообщение. Соответственно, сервер отвечает на это сообщение, и второй клиент "отвисает" — теперь с ним можно нормально работать.
Простейший сервер и эксперименты с ним, конечно, очень познавательны, но на практике хотелось бы иметь такой сервер, который может работать одновременно с несколькими клиентами. Чтобы добиться этого, сделаем так же, как при написании UDP-чата: вынесем в отдельные нити работу с блокирующими функциями (пример MultithreadedServer на компакт-диске). Нам понадобится одна нить для выполнения функции accept и по одной нити на работу с каждым подключившимся клиентом. Инициализация выполняется при нажатии кнопки Запустить (листинг 2.19). После инициализации библиотеки сокетов, создания сокета и перевода его в режим прослушивания она создает нить типа TListenThread, передает ей дескриптор сокета и больше с сокетами не работает — дальнейшая роль главной нити заключается только в обработке сообщений. Благодаря этому сервер может иметь нормальный пользовательский интерфейс.
Листинг 2.19. Инициализация многонитевого сервера// Реакция на кнопку Запустить
procedure TServerForm.BtnStartServerClick(Sender: TObject);
var
// Сокет, который будет "слушать"
ServerSocket: TSocket;
// Адрес, к которому привязывается слушающий сокет
ServerAddr: TSockAddr;
begin
// Формирyем адрес для привязки.
FillChar(ServerAddr.sin_zero, SizeOf(ServerAddr.sin_zero), 0);
ServerAddr.sin_family := AF_INET;
ServerAddr.sin_addr.S_addr := ADDR_ANY;
try
ServerAddr.sin_port := htons(StrToInt(EditPortNumber.Text));
if ServerAddr.sin_port = 0 then
begin
MessageDlg('Номер порта должен находиться в диапазоне 1-65535',
mtError, [mbOK], 0);
Exit;
end;
// Создание сокета
ServerSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if ServerSocket = INVALID_SOCKET then
begin
MessageDlg('Ошибка при создании сокета: '#13#10 + GetErrorString,
mtError, [mbOK], 0);
Exit;
end;
// Привязка сокета к адресу
if bind(ServerSocket, ServerAddr, SizeOf(ServerAddr)) = SOCKET_ERROR then
begin
MessageDlg('Ошибка при привязке сокета к адресу: '#13#10 +
GetErrorString, mtError, [mbOK], 0);
closesocket(ServerSocket);
Exit;
end;
// Перевод сокета в режим прослушивания
if listen(ServerSocket, SOMAXCONN) = SOCKET_ERROR then
begin
MessageDlg('Ошибка при переводе сокета в режим просушивания:'#13#10 +
GetErrorString, mtError, [mbOK], 0);
closesocket(ServerSocket);
Exit;
end;
// Запуск нити, обслуживающей слушающий сокет
TListenThread.Create(ServerSocket);
// Перевод элементов управления в состояние "Сервер работает"
LabelPortNumber.Enabled := False;
EditРоrtNumber.Enabled := False;
BtnStartServer.Enabled := False;
LabelServerState.Caption := 'Сервер работает';
except
on EConvertError do
// Это исключение может возникнуть только в одном месте
// при вызове StrToInt(EditPortNumber.Text)
MessageDlg('"' + EditPortNumber.Text + '"не является целым числом',
mtError, [mbOK], 0);
on ERangeError do
// это исключение может возникнуть только в одном месте -
// при присваивании значения номеру порта
MessageDlg('Номер порта должен находиться в диапазоне 1-65535',
mtError, [mbOK], 0);
