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.

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;