WinSock, функция select, зависание сервера

[MDmitry]

Доброго времени суток.
Можно ли как-нибудь сделать так, чтобы сервер не зависал, не выделяя accept в отдельную нить?

unit CServer;
{ Класс сервера
}
 
interface
 
uses Classes,SysUtils,WinSock,Dialogs,StdCtrls,CPredokClientServer,FGetErrorString;
 
// Информация о поключившемся клиенте
type
  PConnection=^TConnection;     // Информация о поключившемся клиенте
  TConnection=record
    ClientAddr:string;     // Строковое представление адреса клиента
    ClientSocket:TSocket;  // Сокет, созданный accept для взаимодействия с клиентом
    Deleted:Boolean;       // Если FALSE, то соединение с клиентом утеряно
end;
 
type
  TServer=class(TPredokClientServer)
  private
    FClientSocket:TSocket;        // Сокет клиента
    FClientSocketAddr:TSockAddr;  // Адрес клиента
    FConnections:TList;           // Список подключившихся клиентов
    FMemoLog:TMemo;
    // Привязка сокета к адресу
    procedure PrivyazkaKAdresu(MemoLog:TMemo);
    // Создание соединения с клиентом
    procedure SozdatSoedineniyeSKlientom;
    // Принять сообщение
    procedure PrinyatSoobchsheniye(var Connection: TConnection);
  public
    // Запуск сервера
    procedure StartServer(IpAddres:string;Port:word;TypeProtokol,TypeSocket:char;MemoLog:TMemo);
end;
 
 
implementation
 
// ---------- Запуск сервера ---------------------------------------------------
// - IpAddres - ip-адрес
// - Port - номер порта
// - TypeProtokol - тип сокера (UDP,TCP)
// - TypeSocket - тип сокета (С - сервер, К - клиент)
// - MemoLog - Лог
procedure TServer.StartServer(IpAddres:string;Port:word;TypeProtokol,TypeSocket:char;MemoLog:TMemo);
begin
FMemoLog:=MemoLog;
// Создание сокета
CreateSocket(IpAddres,Port,TypeProtokol,TypeSocket);
// Привязка сокета к адресу
PrivyazkaKAdresu(MemoLog);
// Создание соединения с клиентом
SozdatSoedineniyeSKlientom;
end;
 
// ---------- Привязка сокета к адресу -----------------------------------------
procedure TServer.PrivyazkaKAdresu;
begin
  // Сокет, созданный с помощью функции socket не привязан ни к какому адрему.
  // Привязка осуществляется функцией bind.
  // function bind(s:TSocket; var addr:TSockAddr; namelen:Integer): Integer;
  // - s - дескриптор сокета, который привязывается к адресу
  // - addr - адрес, к которому требуется привязать сокет
  // - namelen - длина структуры, содержащей адрес
  if bind(FSocket,FSocketAddr,SizeOf(TSockAddr)) = SOCKET_ERROR
    then
    begin
      MessageDlg('Ошибка при привязке сокета к адресу ' + GetErrorString, mtError, [mbOK], 0);
      Exit;
    end
    else FMemoLog.Lines.Append('Сервер успешно запущен');
end;
 
// ---------- Создание соединения с клиентом -----------------------------------
procedure TServer.SozdatSoedineniyeSKlientom;
var
  TimeOut:TimeVal;     // Таймаут для функции select
  SetSockets:TFDSet;   // Множество сокетов для функции select
  ClientAddrLen:Integer;
  NewConnection:PConnection; // Вспомогательная переменная, использующаяся при создании нового соединения
  x:word;
begin
  FConnections:=TList.Create;
  // Перевод сокета в режим ожидания соединения
  // function listen(s:TSocket; backlog:Integer): Integer;
  // - s - дескриптор сокета, который переводится в режим ожидания
  // - backlog - размер очереди подключений (для сокета, находящегося в режиме
  //             ожидания, создаётся очередь подключений). Максимально возможный
  //             размер очереди
  // Функция вовращает 0 в случае успешного завершения или SOCKET_ERROR в случае
  // ошибки.
  // Когда клиент вызывает функцию connect, и по указанному в ней адресу имеется
  // сокет, находящийся в режиме ожидания подключения, то информация о клиенте
  // помещается в очередь подключений этого сокета.
  if listen(FSocket, SOMAXCONN)=SOCKET_ERROR
    then MessageDlg('Невозможно установить сокет в режим прослушивания. '+GetErrorString,mtError,[mbOK],0);
  // Устанавливаем таймаут, равный 0, чтобы select ничего не ждала, а возвращала готовность
  // сокетов на момент вызова
  Timeout.tv_sec:=0;    // число секунд
  Timeout.tv_usec:=0;   // число микросекунд
  // Начало цикла для подключения и общения с клиентами
  repeat
    // Сначала проверяем, готов ли слушающий сокет. Если он готов, это означает,
    // что есть подключившийся, но не обработанный функцией accept клиент
    // procedure FD_ZERO(var FDSet:TFDSet); - инициализирует множество FDSet
    FD_ZERO(SetSockets);
    // procedure FDSet(Socket:TSocket; var FDSet:TFDSet); - добавляет сокет Socket в множество FDSet
    FD_SET(FSocket,SetSockets);
    // Проверка готовности сокета
    // function select(nfds:Integer; readfds,writefds,exceptfds:PFDSet; timeout:PTimeVal): LongInt;
    // - nfds - оставлен только для совместимости со старыми версиями библиотеки сокетов, в новых игнорируется
    // - readfds, writefds, exceptfds - указатели на множество сокетов, которые нужно проверять
    //   (не будут блокировать нить readfds-recv,recvfrom; writefds-send,sento;
    //    exceptfds - неудача попытки соединения, получения высокоуровневых данных)
    // - timeout - время, которое функция будет ожидать, пока хотя бы один из сокетов не будет готов к требуемой операции
    if select(0,@SetSockets,nil,nil,@Timeout)=SOCKET_ERROR
      then MessageDlg('Ошибка при проверке готовности слушающего сокета. ' + GetErrorString, mtError, [mbOK], 0);
    // Если функция select оставила сокет в множестве, значит, зафиксировано подключение клиента, и функция accept
    // не приведёт к блокированию нити.
    // procedure FD_ISSET(Socket:TSocket; FDSet:TFDSet) - определяет, входит ли Socket в множество FDSet
    if FD_ISSET(FSocket,SetSockets)
      then
      begin
        ClientAddrLen:=SizeOf(FClientSocketAddr);
        // Ожидаем подключение клиента
        // Извлечение из очереди соединений информации соединении и создание сокета для
        // его обслуживания
        // function accept(s:TSocket; addr:PSockAddr; addrlen: PInteger): TSocket;
        // - s - сокет, который находится в режиме ожидания соединения
        // - addr - адрес клиента, установившего соединение
        // - addrlen - длина буфера, в который будет помещён адрес клиента
        // В случае ошибки возвращается INVALID_SOCKET, при успешном завершении - дескриптор
        // сокета, созданного библиотекой сокетов и предназначенного для обслуживания
        // данного соединения. Этот сокет уже привязан к адресу и соединён с сокетом клиента,
        // установившего соединение.
        // Если на момент вызова функции accept очередь соединений пуста, то нить,
        // вызвавшая её блокируется до тех пор, пока какой-нибудь клиент не полключиться
        // к серверу.
        FClientSocket:=accept(FSocket,@FClientSocketAddr,@ClientAddrLen);
        if FClientSocket=INVALID_SOCKET then
        begin
          MessageDlg('Ошибка при ожидании подключения клиента: ' + GetErrorString, mtError, [mbOK], 0);
          break;
        end
        else
        begin
          // Создаём в динамической памяти новый экземпляр TConnection и заполняем его данными, соответствующими
          // подключившемуся клиенту
          New(NewConnection);
          NewConnection.ClientSocket:=FClientSocket;
          NewConnection.ClientAddr:=Format('%u.%u.%u.%u:%u', [
                                            Ord(FClientSocketAddr.sin_addr.S_un_b.s_b1),
                                            Ord(FClientSocketAddr.sin_addr.S_un_b.s_b2),
                                            Ord(FClientSocketAddr.sin_addr.S_un_b.s_b3),
                                            Ord(FClientSocketAddr.sin_addr.S_un_b.s_b4),
                                            ntohs(FClientSocketAddr.sin_port)]);
          NewConnection.Deleted:=False;
          // Добавляем соединение в список
          FConnections.Add(NewConnection);
          FMemoLog.Lines.Append('Зафиксировано подключение с адреса '+NewConnection.ClientAddr);
        end;
      end;
    if FConnections.Count>0
      then
      begin
        // Теперь проверяем готовность всех сокетов подключившихся клиентов
        FD_ZERO(SetSockets);
        for x:=0 to FConnections.Count-1
          do FD_SET(PConnection(FConnections[x])^.ClientSocket,SetSockets);
        if select(0, @SetSockets, nil, nil, @Timeout) = SOCKET_ERROR
          then MessageDlg('Ошибка при проверке готовности слушающего сокета. ' + GetErrorString, mtError, [mbOK], 0);
        // Проверяем, какие сокеты select оставила в множестве и вызываем ...
        for x:=0 to FConnections.Count-1
          do if FD_ISSET(PConnection(FConnections[x])^.ClientSocket,SetSockets)
            then PrinyatSoobchsheniye(PConnection(FConnections[x])^);  
        // Проверяем отключвшихся клиентов
        for x:=FConnections.Count-1 downto 0
          do if PConnection(FConnections[x])^.Deleted
            then
            begin
              closesocket(PConnection(FConnections[x])^.ClientSocket);
              Dispose(PConnection(FConnections[x]));
              FConnections.Delete(x);
            end;
      end;
    Sleep(100);
  until False;
  for x:=FConnections.Count-1 downto 0 do
  begin
    closesocket(PConnection(FConnections[x])^.ClientSocket);
    Dispose(PConnection(FConnections[x]));
  end;
  FConnections.Free;
  FMemoLog.Lines.Append('Сервер завершил работу');
end;
 
// ---------- Принять сообщение ------------------------------------------------
procedure TServer.PrinyatSoobchsheniye(var Connection: TConnection);
var
  Mes:string[255];   // Сообщение клиента
begin
  // Если выполнение функции не дойдёт до конца, это значит, что связь
  // с клиентом по тем или иным причинам потеряна. В этом случае
  // поле Deleted останется равным False, и ресурсы, выделенные для
  // данного клиента, будут освобождены. Если же функция выполнится
  // до конца, полю Deleted будет вновь присвоено значение False,
  // т.е. ресурсы не будут удалены.
  Connection.Deleted:=True;
  // Принять сообщение
  // function recv(s:TSocket; var buf,len,flags:Integer):Integer;
  // - s - сокет, который служит для передачи данных
  // - buf - буфер, в котором хранятся данные для оправки
  // - len - размер этих данных в байтах
  // - flags - указывает некоторые дополнительные опциии, которые в большинстве
  //           случаев не нужны
  case recv(Connection.ClientSocket,Mes,SizeOf(Mes),0) of
    -1: // Ошибка при принятии
    begin
      MessageDlg('Произошла ошибка при чтении '+GetErrorString,mtError,[mbOK],0);
      exit;
    end;
    0:  // Клиент закрыл соединение
    begin
      FMemoLog.Lines.Append('Клиент '+Connection.ClientAddr+' закрыл соединение ');
      exit;
    end
    else FMemoLog.Lines.Append(Mes);
  end;
  // Если выполнение дошло до этого места, значит, связь с клиентом
  // не потеряна, и ресурсы освобождать не надо.
  Connection.Deleted := False;
end;
 
end.

Добавлено 18.04.11, 04:45
Предок сервера

unit CPredokClientServer;
{ Класс, который содержит функции, являющиеся общими для клиента и сервера,
  а также некоторые другие для WinSock}
 
interface
 
uses
  SysUtils,Dialogs,WinSock,Windows,FGetErrorString;
 
type
  TPredokClientServer=class
  public
    FSocket:TSocket;       // Сокет
    FSocketAddr:TSockAddr; // Адрес, к которому привязывается сокет
    // Описание структуры TSockAddr
    // - sin_family - семейство протоколов (для TCP/IP - PF_INET)
    // - sin_port - номер порта, к которому привязывается сокет
    // - sin_addr.S_addr - адрес для привязки сокета.
    // - sin_zero - должна быть заполнена нулями (не несёт никакой смысловой
    //              нагрузки, нужно только для увеличения размера структуры
    //              до 16 байтов
    // Создание сокета
    procedure CreateSocket(IpAddres:string;Port:word;TypeProtokol,TypeSocket:char);
end;
 
implementation
 
// ---------- Создание сокета --------------------------------------------------
// - IpAddres - ip-адрес
// - Port - номер порта
// - TypeProtokol - тип сокера (UDP,TCP)
// - TypeSocket - тип сокета (С - сервер, К - клиент)
procedure TPredokClientServer.CreateSocket(IpAddres:string;Port:word;TypeProtokol,TypeSocket:char);
begin
  // Формируем адрес сервера, к которому надо подключиться
  // FillChar - стандартная процедура Паскаля, некоторую область памяти заданными
  // значениями. В данном случае 0
  FillChar(FSocketAddr.sin_zero,SizeOf(FSocketAddr.sin_zero),0);
  // Семейство протоколов
  FSocketAddr.sin_family:=AF_INET;
  // Ip-адрес
  // inet_addr - для преобразования адреса из строки в 32-х битное число
  case TypeSocket of
    'К': FSocketAddr.sin_addr.S_addr := inet_addr(PChar(IpAddres));
    'С': FSocketAddr.sin_addr.S_addr := inet_addr(PChar(IpAddres));
    //'С': FSocketAddr.sin_addr.S_addr:=htonl(INADDR_ANY);    
  end;
  // Для совместимости со старыми версиями Delphi приводим константу INADDR_NONE
  // к типу u_long
  if FSocketAddr.sin_addr.S_addr=u_long(INADDR_NONE)
  then
  begin
    MessageDlg('Синтаксическая ошибка в IP-адресе',mtError,[mbOK],0);
    Exit;
  end;
  // Преобразование в сетевой формат
  // Функция htons служит для преобразования номера порта из привычного нам в
  // сетевой. Если номер порта оставить нулевым, то система сама выберет для
  // сокета свободный порт с номером от 1024 до 5000
  FSocketAddr.sin_port:=htons(Port);
  // Создание сокета
  // function socket (AF,SocketType,Protocol:Integer):TSocket;
  // - AF - какой стек протоколов используется (для TCP/IP - AF_INET)
  // - SocketType - тир сокета (SOCK_STREAM - потоковый, SOCK_DGRAM - дейтаграммный)
  // - Protocol - тип протокола TCP - потоковый, UDP - дейтаграммный
  case TypeProtokol of
    'T':FSocket:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
    'U':FSocket:=socket(AF_INET,SOCK_DGRAM,IPPROTO_UDP);
  end;
  if FSocket = INVALID_SOCKET then
  begin
    MessageDlg('Ошибка при создании сокета: ' + GetErrorString, mtError, [mbOK], 0);
    Exit;
  end;
end;

[Fr0sT]

У select есть таймаут

[MDmitry]

Есть, пробовал менять значения, не помогло

[Mr.Delphist]

Правильно ли я понимаю, что хочется "неблокирующих сокетов"?
http://www.rsdn.ru/forum/network/1262011.flat.aspx