Книга о Synapse. Глава 0 «Сокеты».

Итак, как я и говорил в последнем сообщении, работа над книгой про библиотеку Synapse подошла к первой контрольной точке и мы готовы представить на всеобщее обозрение первую главу. Надо сказать, что, начиная работу я не подозревал, что мы так увлечемся работой и будем все время что-то дополнять, добавлять, исправлять :) Но, в итоге решили, что все-таки стоит опубликовать первую главу сейчас, чтобы вы смогли оценить наш скромный труд и, если потребуется, то внести и свою лепту в работу над книгой.

Вторым автором книги стал Михаил Балабаев, предложив свою помощь в работе над книгой. И я благодарен Михаилу за те замечания и исправления, которые он вносил (и продолжает вносить :)) в текст книги. Надеюсь, что и к финишу мы придём вместе.

Следует отметить, что представленный ниже текст главы был написан практически с нуля и затрагивает самые основы Synapse — работу с сокетами, о которой я очень кратко упоминал в блоге.

Вполне возможно, что после публикации в блоге, текст главы претерпит некоторые изменения (благодаря вашим замечаниям и предложениям), но суть должна остаться прежней. В общем, усаживайтесь по удобнее и читайте первую главу книги о Synapse — «Сокеты».

Краткий обзор сокетов

Сокеты (sockets) представляют собой низкоуровневый унифицированный интерфейс взаимодействия с телекоммуникационными протоколами.

Исторически, сокеты появились в системе UNIX. Когда же Microsoft приняли решение ввести поддержку сетевых протоколов в Windows, ими была реализована обратная совместимость с уже сложившимися стандартами. Таким образом, существует два вида сокетов: классические сокеты Unix и Windows-сокеты, или просто WinSocks. Впрочем, Windows фактически поддерживает оба типа, т.к. по сути сокеты Windows являются функциональным расширением классических сокетов.

По типу взаимодействия с использующим их кодом сокеты делятся на два принципиально разных по способу использования типа: синхронные (ещё их иногда называют блокируемые или блокирующие) и асинхронные (неблокируемые, неблокирующие).

Все операции, производимые с блокирующими сокетами, являются синхронными основному потоку приложения. Это значит, что вызвав некоторую функцию сокета мы будем ожидать результата её работы. Например, отправив серверу некий запрос, мы не сможем продолжить работу до тех пор пока от сервера не придет ответ или пока не возникнет ошибка передачи данных.

В этой особенности кроются как достоинства так и недостатки блокирующих сокетов. С одной стороны, написание кода для блокирующих сокетов относительно несложно, т.к. весь код обработки может быть локализован и линейно структурирован: отправили запрос – получили ответ. С другой стороны, необходимо учитывать временные простои при ожидании ответов и помещать обработку в отдельную нить.

Код для работы с асинхронными сокетами строится совершенно по иному принципу. Например, отправив запрос серверу можно спокойно продолжать выполнять другую работу, в том числе отправку новых запросов. Ответ же от сервера (если он будет) поступает в виде возникновения сообщений, которые и необходимо обрабатывать. Такой подход позволяет реализовывать масштабируемые и весьма стабильные системы (за счет возможности распараллеливания обработки запросов), но требует написания значительного объёма дополнительного кода, направленного на синхронизацию состояний и данных. Скажем, никаким образом не гарантируется, что ответы от сервера придут в том же порядке что были отправлены запросы. И что они вообще поступят. Заботу обо всех этих мелочах должен взять на себя код, использующий неблокирующие сокеты.

Независимо от вида, сокеты классифицируются в зависимости от способа передачи данных на потоковые и блочные (datagram, датаграммные).

Потоковые сокеты работают с установкой соединения, обеспечивая надежную идентификацию обоих сторон, и гарантируют целостность и успешность доставки данных. Потоковые сокеты базируются на протоколе TCP.

Блочные сокеты работают без установки соединения и не обеспечивают ни идентификации отправителя, ни контроля факта доставки данных, ни даже соблюдения очередности доставки пакетов (однако если пакет был доставлен получателю, то именно в том виде в котором был отправлен). Преимущество же блочных сокетов в том, что они заметно быстрее потоковых. Блочные сокеты базируются на протоколе UDP.

Выбор того или иного типа сокетов определяется транспортным протоколом на котором работает сервер, а значит клиент не может по своему желанию установить с блочным сервером потоковое соединение или наоборот.

Помимо потоковых и блочных сокетов существуют, так называемые, «сырые» (RAW) сокеты. Они предоставляют возможность полного контроля над формированием IP-пакетов, в том числе полный доступ к содержимому заголовков отправляемых и получаемых пакетов. Именно эта особенность зачастую используется в приложениях, которым необходим низкоуровневый доступ к сетям передачи данных (сетевые сканеры, брандмауэры, различное вредоносное ПО).

Реализация сокетов в Synapse

Все необходимые объекты и типы данных для работы с сокетами располагаются в модуле blcksock.pas.

Рассмотрим классы, реализующие различные типы сокетов в Synapse.

Класс TBlockSocket

У всех сокетов в Synapse имеется один общий предок  –  TBlockSocket. В этом классе реализованы наиболее общие свойства, методы и события, используемые при работе с сокетами в Synapse в целом.

Рассмотрим свойства, методы и события этого класса.   

Свойства сокета:

property WSAData: TWSADATA

property FDset: TFDSet;

property LocalSin: TVarSin

property RemoteSin: TVarSin

property Socket: TSocket

property LastError: Integer

property LastErrorDesc: string

property LineBuffer: AnsiString

property SizeRecvBuffer: Integer

property SizeSendBuffer: Integer

property NonBlockMode: Boolean

property TTL: Integer

property IP6used: Boolean

property RecvCounter: Integer

property SendCounter: Integer

property Tag: Integer

property RaiseExcept: Boolean

property MaxLineLength: Integer

property MaxSendBandwidth: Integer

property MaxRecvBandwidth: Integer

property MaxBandwidth: Integer

property ConvertLineEnd: Boolean

property Family: TSocketFamily

property InterPacketTimeout

property SendMaxChunk: Integer

property StopFlag: Boolean

property NonblockSendTimeout: Integer

property HeartbeatRate: integer

Методы сокета:

procedure CreateSocket;

procedure CreateSocketByName(const Value: String);

procedure CloseSocket;

procedure AbortSocket;

procedure Bind(IP, Port: string);

procedure Connect(IP, Port: string);

procedure Listen;

function Accept: TSocket;

function SendBuffer(Buffer: TMemory; Length: Integer): Integer;

procedure SendByte(Data: Byte);

procedure SendString(Data: AnsiString);

procedure SendInteger(Data: integer);

procedure SendBlock(const Data: AnsiString);

procedure SendStreamRaw(const Stream: TStream);

procedure SendStream(const Stream: TStream);

procedure SendStreamIndy(const Stream: TStream);

function RecvBuffer(Buffer: TMemory; Length: Integer): Integer;

function RecvBufferEx(Buffer: TMemory; Len: Integer; Timeout: Integer): Integer;

function RecvBufferStr(Len: Integer; Timeout: Integer): AnsiString;

function RecvByte(Timeout: Integer): Byte;

function RecvInteger(Timeout: Integer): Integer;

function RecvString(Timeout: Integer): AnsiString;

function RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString;

function RecvPacket(Timeout: Integer): AnsiString;

function RecvBlock(Timeout: Integer): AnsiString;

procedure RecvStreamRaw(const Stream: TStream; Timeout: Integer);

procedure RecvStreamSize(const Stream: TStream; 
                                Timeout: Integer; Size: Integer);

procedure RecvStream(const Stream: TStream; Timeout: Integer);

procedure RecvStreamIndy(const Stream: TStream; Timeout: Integer);

function PeekBuffer(Buffer: TMemory; Length: Integer): Integer;

function PeekByte(Timeout: Integer): Byte;

function WaitingData: Integer;

function WaitingDataEx: Integer;

procedure Purge;

procedure SetLinger(Enable: Boolean; Linger: Integer);

procedure GetSinLocal;

procedure GetSinRemote;

procedure GetSins;

procedure ResetLastError;

function SockCheck(SockResult: Integer): Integer;

procedure ExceptCheck;

function LocalName: string;

procedure ResolveNameToIP(Name: string; const IPList: TStrings);

function ResolveName(Name: string): string;

function ResolveIPToName(IP: string): string;

function ResolvePort(Port: string): Word;

procedure SetRemoteSin(IP, Port: string);

function GetLocalSinIP: string;

function GetRemoteSinIP: string;

function GetLocalSinPort: Integer;

function GetRemoteSinPort: Integer;

function CanRead(Timeout: Integer): Boolean;

function CanReadEx(Timeout: Integer): Boolean;

function CanWrite(Timeout: Integer): Boolean;

function SendBufferTo(Buffer: TMemory; Length: Integer): Integer;

function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer;

function GroupCanRead(const SocketList: TList; Timeout: Integer; 
                                         const CanReadList: TList): Boolean;

procedure EnableReuse(Value: Boolean);

procedure SetTimeout(Timeout: Integer);

procedure SetSendTimeout(Timeout: Integer);

procedure SetRecvTimeout(Timeout: Integer);

function GetSocketType: integer;

function GetSocketProtocol: integer;

class function GetErrorDesc(ErrorCode: Integer): string;

function GetErrorDescEx: string;

У TBlockSocket определены следующие события:

property OnStatus: THookSocketStatus
THookSocketStatus = procedure(Sender: TObject; Reason: THookSocketReason;
                              const Value: String) of object

property OnReadFilter: THookDataFilter
THookDataFilter = procedure(Sender: TObject; var Value: AnsiString) of object

property OnCreateSocket: THookCreateSocket
THookCreateSocket = procedure(Sender: TObject) of object;

property OnMonitor: THookMonitor
THookMonitor = procedure(Sender: TObject; Writing: Boolean; 
                         const Buffer: TMemory; Len: Integer) of object;

property OnHeartbeat: THookHeartbeat
 
THookHeartbeat = procedure(Sender: TObject) of object;

Значения параметра THookSocketReason

HR_ResolvingBegin

HR_ResolvingEnd

HR_SocketCreate

HR_SocketClose

HR_Bind

HR_Connect

HR_CanRead

HR_CanWrite

HR_Listen

HR_Accept

HR_ReadCount

HR_WriteCount

HR_Wait

HR_Error

Класс TSocksBlockSocket

В этом классе-надстройке реализованы основные свойства и события, необходимые для создания SOCKS4 и SOCKS5 прокси-клиентов.

property SocksIP: string

property SocksPort: string

property SocksUsername: string

property SocksPassword: string

property SocksTimeout: integer

property SocksResolver: Boolean

property SocksType: TSocksType;

type TSocksType = (ST_Socks5,
 
ST_Socks4);

property UsingSocks: Boolean

property SocksLastError: integer

Методы класса:

function SocksOpen: Boolean;

function SocksRequest(Cmd: Byte; const 
     IP, Port: string): Boolean;

function SocksResponse: Boolean;

Класс TTCPBlockSocket

Этот класс реализует сокет TCP.  Поддерживаемые возможности: работа с IPv4, IPv6, SSL/TLS или SSH, SOCKS4 и SOCKS5 прокси, HTTP прокси.

Свойства класса:

property SSL: TCustomSSL

property HTTPTunnel: Boolean

property HTTPTunnelIP: string

property HTTPTunnelPort: string

property HTTPTunnelUser: string

property HTTPTunnelPass: string

property HTTPTunnelTimeout: integer

Методы класса:

constructor CreateWithSSL(SSLPlugin: TSSLClass);

procedure SSLDoConnect;

procedure SSLDoShutdown;

function SSLAcceptConnection: Boolean;

События класса:

property OnAfterConnect: THookAfterConnect
type
THookAfterConnect = procedure(Sender: TObject) of object;

Класс TTCPBlockSocket – это первый класс из модуля blcksock.pas, который мы можем без всяких оговорок и ограничений использовать при разработке своих программ. А раз так, то настало время написать наш первый рабочий пример использования библиотеки Synapse в Delphi.

Первый пример: сканер портов

Сканер портов – программное обеспечение, созданное для обнаружения хостов сети, в которых открыт нужный порт или набор портов. Сканеры портов, как правило, используются системными администраторами для выявления слабых мест их сетей.

Выбор в качестве первого примера сканера портов сделан не случайно. Во-первых, для реализации этой программы нам потребуется минимум кода. Во-вторых, так как от нас сейчас требуется лишь ознакомиться с работой класса, а не писать сверхмощные навороченные хакерские утилиты, то и сам алгоритм работы программы будет простым и незамысловатым. И, в-третьих, вполне возможно, что предложенный в примере код пригодиться Вам для вполне мирных целей.

Итак, от нашей программы требуется совсем не много – это:

1. Попытаться подключиться к заданному узлу в cети по заданному порту;
2. Вернуть результат подключения (успешно/не успешно) и, если потребуется – вывести на экран код ошибки, которая возникла при попытке подключения.

От пользователя для работы программы потребуются следующие данные:

1. IP-адрес или имя узла в сети, который необходимо проверить
2. Диапазон портов для проверки;
3. Значение тайм-аута для подключения, по истечению которого программа будет считать, что попытка подключения была провальной.

Так как мы будем использовать для работы блокирующие сокеты, то для оптимизации вынесем всю работу с ними в отдельную нить.

Теперь приступим к разработке программы. Открываем Delphi, создаем новый проект (назовем его PortScanner) и поместим на главную форму приложения компоненты как показано на рисунке ниже:

Главная форма приложения PortScanner

Открываем исходный код главного модуля и подключаем в uses модуль blcksock.pas.
Вначале создадим класс нити и определим необходимые для его работы типы данных:

type
  //успешное подключение к узлу IP по порту Port
  TOnConnect = procedure (Sender: TObject; const IP: string; Port: word) of object;
  //ошибка подключения к узлу IP по порту Port; ErrorCode - код ошибки; ErrorDesk - описание ошибки
  TOnError = procedure (Sender: TObject; const IP: string; Port: word; Error-Code: integer; ErrorDesc:string) of object;
 
  {поток для сканирования заданного диапазона портов}
  TTCPThread = class(TThread)
  private
    FSocket: TTCPBlockSocket;//объект сокета
    FIP: string;
    FStartPort: word;
    FEndPort: word;
    FOnConnect: TOnConnect;
    FOnError  : TOnError;
    procedure DoConnect(const IP: string; Port: word);
    procedure DoError(const IP: string; Port: word);
  protected
    procedure Execute;override;
  public
    constructor Create(ASyspended: boolean; AIP: string; AStartPort,AEndPort, ATimeout:integer);
    destructor Destroy; override;
    property OnConnect: TOnConnect read FOnConnect write FOnConnect;
    property OnError  : TOnError read FOnError write FOnError;
end;

В конструктор нити передается IP или имя узла, начало и конец диапазона портов для проверки и тайм-аут подключения. Ниже представлен исходный код всех методов потока:

{ TTCPThread }
 
constructor TTCPThread.Create(ASyspended: boolean; AIP: string; AStartPort,
  AEndPort, ATimeout:integer);
begin
  inherited Create(ASyspended);
  FSocket:=TTCPBlockSocket.Create;
  FSocket.ConnectionTimeout:=ATimeout;
  FIP:=AIP;
  FStartPort:=AStartPort;
  FEndPort:=AEndPort;
end;
 
destructor TTCPThread.Destroy;
begin
  FSocket.Free;//освобождаем память
  inherited;
end;
 
procedure TTCPThread.DoConnect(const IP: string; Port: word);
begin
  if Assigned(FOnConnect) then
    FOnConnect(self,IP,Port);
end;
 
procedure TTCPThread.DoError(const IP: string; Port: word);
begin
  if Assigned(FOnError) then
    FOnError(Self,IP,Port,FSocket.LastError, FSocket.LastErrorDesc);
end;
 
procedure TTCPThread.Execute;
var i:integer;
begin
  i:=FStartPort;
  while (i<=FEndPort)and(not Terminated) do
    begin
       FSocket.Connect(FIP,IntToStr(I));//пробуем соединиться
       FSocket.GetSins;
       if FSocket.LastError=0 then //ошибок нет - соединились успешно
          DoConnect(FSocket.GetRemoteSinIP, I)
       else
         DoError(FSocket.GetRemoteSinIP, I);//возвращаем ошибку
      FSocket.CloseSocket;//закрывем сокет
      inc(i);
    end;
  if not Terminated then
    FreeOnTerminate:=True;
end;

Здесь стоит обратить внимание на следующие моменты работы:

1. Для событий мы используем IP-адрес, полученный от сокета (FSock-et.GetRemoteSinIP), а не значение, которое передает в поток пользователь (пользователь может указать и имя узла, вместо IP-адреса).
2. После каждой попытки подключения мы обязательно должны за-крыть сокет, выполнив метод FSocket.CloseSocket. Если этого не делать, начиная со второй попытки подключения, мы будем получать ошиб-ку 10037 «Operation already in progress».

Теперь напишем код основной программы:

unit main;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, Sys-tem.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, blcksock, Vcl.StdCtrls;
 
resourcestring
  rsScan = 'Сканировать';
  rsStopScan = 'Остановить';
 
type
  TMainForm = class(TForm)
    grpOptions: TGroupBox;
    Label4: TLabel;
    edConnectTimeout: TEdit;
    Label5: TLabel;
    chkWriteError: TCheckBox;
    edPortEnd: TEdit;
    Label3: TLabel;
    edPortStart: TEdit;
    Label2: TLabel;
    edIPAddress: TEdit;
    Label1: TLabel;
    grpLog: TGroupBox;
    memLog: TMemo;
    btnStart: TButton;
    procedure btnStartClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
     //объект потока
     TCPThread: TTCPThread;
     //обработчик события нити OnConnect
     procedure OnConnect(Sender: TObject; const IP: string; Port: word);
     //Обработчик события нити OnError
     procedure OnError(Sender: TObject; const IP: string; Port: word; Error-Code: integer; ErrorDesc:string);
     //Вспомогательный метод для "включения/отключения" элементов управления в группе "Настройки"
     procedure EnableControls(AEnable: boolean);
     //Обработчик события завершения работы потока
     procedure OnTerminate(Sender: TObject);
  public
    { Public declarations }
  end;
 
var
  MainForm: TMainForm;
 
implementation
 
{$R *.dfm}
 
procedure TMainForm.btnStartClick(Sender: TObject);
begin
   //изменяем состояние элементов управления в группе "Настройки"
   EnableControls(btnStart.Caption<>rsScan);
   if btnStart.Caption=rsScan then
     begin
       TCPThread:=TTCPThread.Create(True,//"спящий поток"
                            edIPAddress.Text,//адрес
                            StrToInt(edPortStart.Text),//начало диапазона сканирования портов
                            StrToInt(edPortEnd.Text),//конец диапазона сканирования портов
                            StrToInt(edConnectTimeout.Text));//таймаут ожидания соединения
       //определяем обработчики событий нити
       TCPThread.OnConnect:=OnConnect;
       TCPThread.OnError:=OnError;
       TCPThread.OnTerminate:=OnTerminate;
       //запускаем нить
       TCPThread.Start;
       btnStart.Caption:=rsStopScan;
     end
   else
     begin
       //останавливаем нить и освобождаем память
       TCPThread.Terminate;
       TCPThread.WaitFor;
       TCPThread.Free;
     end;
end;
 
procedure TMainForm.EnableControls(AEnable: boolean);
var i:integer;
begin
  for i:=0 to grpOptions.ControlCount-1 do
    if grpOptions.Controls[i].ClassType<>TButton then
       TWinControl(grpOptions.Controls[i]).Enabled:=AEnable;
end;
 
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Assigned(TCPThread) and (not TCPThread.Finished) then
    begin
      TCPThread.Terminate;
      TCPThread.WaitFor;
      TCPThread.Free;
    end;
end;
 
procedure TMainForm.OnConnect(Sender: TObject; const IP: string; Port: word);
const cSuccessStr = '[%s] [%s] Порт %d открыт';
begin
  //выводим сообщение в лог
  memLog.Lines.Add(Format(cSuccessStr,[TimeToStr(Now),IP, Port]));
end;
 
procedure TMainForm.OnError(Sender: TObject; const IP: string; Port: word;
  ErrorCode: integer; ErrorDesc: string);
const cErrorStr = '[%s] [%s] Порт %d закрыт. Ошибка %d (%s)';
begin
  if chkWriteError.Checked then
    mem-Log.Lines.Add(Format(cErrorStr,[TimeToStr(Now),IP,Port,ErrorCode,ErrorDesc]))
end;
 
procedure TMainForm.OnTerminate(Sender: TObject);
begin
  btnStart.Caption:=rsScan;
  EnableControls(True);
end;
 
end.

Смысл работы этого кода следующий: после того как пользователь задал необходимые настройки и нажал на кнопку «Сканировать», то создается новый экземпляр нити TTCPThread, все элементы управления в группе «Настройки» отключаются, а надпись кнопки меняется на «Остановить». Нить после каждой попытки подключения вызывает либо событие OnCon-nect (если подключение успешно), либо OnError (если произошла ошибка подключения). Обработчики событий в главной программе выводят в лог соответствующие сообщения.
Так выглядит интерфейс программы, когда нить запущена, а флажок «Выводить в лог ошибки» выбран:

Сканер портов в работе

Как видите, пример достаточно прост и затрагивает лишь некоторые из свойств и методов класса TTCPBlockSocket. Однако это лишь первый пример работы с Synapse.

Рассмотрим другой, более сложный в реализации пример работы с классом TTCPBlockSocket.

Второй пример: TCP эхо-сервер

Это пример более сложный по сравнению с предыдущим, т.к. нам придётся разработать сразу две программы – сервер и клиент. Смысл работы примера простой: клиент отправляет на сервер строку, а сервер отправляет обратно клиенту строку, полученную из исходной заменой порядка символов на обратный.

Для работы над проектом нам опять же понадобиться только один класс Synapse – TTCPBlockSocket.

Вначале рассмотрим работу по шагам. Итак, что должен уметь клиент:

1. Создать сокет;
2. Подключиться к серверу по заданному IP-адресу и порту;
3. Отправить на сервер любую произвольную строку текста;
4. Дождаться ответа сервера и вывести его на экран.

С сервером дела обстоят немного сложнее. Что должен уметь сделать сервер:

1. Создать сокет;
2. Связать сокет с локальным IP-адресом и портом;
3. Перейти в режим ожидания и ожидать нового соединения с клиентом;
4. Извлечь из очереди запрос на подключение и получить дескриптор сокета;
5. Получить от клиента строку, «перевернуть» её и отправить обратно на клиент;
6. Вести лог подключений и работы с клиентами.

При работе сервера следует учитывать то, что клиент должен уметь обрабатывать запросы от нескольких клиентов одновременно, поэтому в серверной части клиента нам опять же придётся использовать нити. Причем одна нить будет ожидать запросы клиентов на подключение, а все остальные (их теоретически может быть сколько угодно много) – будут обрабатывать запросы от уже подключенных клиентов.

Работу над проектом начнем с наиболее сложной части – с сервера.

Сервер

Открываем Delphi, создаем новый проект с названием «Server» и размещаем на главной форме компоненты как показано на рисунке ниже:

Главная форма сервера

Вначале напишем класс потока, который будет «слушать» клиентов. Он будет следующим:

type
  {"Слушающая нить". Ожидает запрос на подключение и управляет потоками
  для работы с клиентами}
  TListenerThread = class(TThread)
  private
     FSocket: TTCPBlockSocket;//объект сокета
     FThreadList: TList; //список дескрипторов потоков для работы с клиентами
  protected
     procedure Execute;override;
  public
     constructor Create(ASyspended: boolean{; const AIP,APort: string});
     destructor Destroy;override;
     property Socket: TTCPBlockSocket read FSocket;
end;
 
{ TListenerThread }
 
constructor TListenerThread.Create(ASyspended: boolean);
begin
  FSocket:=TTCPBlockSocket.Create;
  FThreadList:=TList.Create;
  inherited Create(ASyspended)
end;
 
destructor TListenerThread.Destroy;
var T:TTCPThread;
begin
  //завершаем все работающие нити
  while FThreadList.Count>0 do
    begin
      T:=TTCPThread(FThreadList.Extract(FThreadList.Last));
      T.Terminate;
      T.WaitFor;
      T.Free;
    end;
  //освобождаем память
  FThreadList.Free;
  FSocket.Free;
  inherited;
end;
 
procedure TListenerThread.Execute;
var T:TTCPThread;
begin
  FSocket.CreateSocket;//создаем новый сокет
  //связываем сокет с локальным адресом
  //выбор номера порта оставляем на усмотрение Synapse
  FSocket.Bind(FSocket.LocalName,'0');
  if FSocket.LastError=0 then //связываение с локальным адресом прошло успешно
     FSocket.Listen //переходим в режим ожидания
  else
    raise Exception.Create(FSocket.LastErrorDesc);//ошибка связывания - показываем её пользователю
  repeat
     if FSocket.CanRead(100) then //можем произвести чтение
       begin
         //получаем дескриптор сокета и создаем новую нить для клиента
         T:=TTCPThread.Create(True,FSocket.Accept);
         //определяем обработчик события ONStatus для новой нити
         T.Socket.OnStatus:=FSocket.OnStatus;
         //добавляем указатель на нить в список
         FThreadList.Add(pointer(T));
         //запускаем нить на выполнение
         T.Start;
       end;
   until Terminated;//"гуляем" по циклу до тех пор, пока пользователь не остановит
end;

Здесь стоит обратить внимание на метод Execute. Во-первых, здесь мы вручную создаем сокет:

FSocket.CreateSocket;

Во-вторых, для связывания сокета с локальным адресом мы целиком и полностью полагаемся на Synapse, т.е. в качестве имени узла мы выполняем метод LocalName, а выбор порта оставляем на усмотрение самой Synapse, указав во втором параметре ‘0’:

FSocket.Bind(FSocket.LocalName,'0');

После чего переводим сокет в режим ожидания входящих подключений

FSocket.Listen;

И, если не произошло никаких ошибок, то в цикле пробуем извлекать из очереди подключение очередного клиента:

repeat
  if FSocket.CanRead(100) then 
    begin
      …
      T:=TTCPThread.Create(True,FSocket.Accept);
      …
    end;
   until Terminated;

В целом, алгоритм работы потока такой:

1. Создаем сокет;
2. Связываем его с локальным адресом;
3. Переходим в режим «прослушивания»;
4. Как только получен запрос на подключение, создаем новую нить и передаем в неё дескриптор из метода Accept;
5. Переходим к п.4 до тех пор пока не поступит запрос на завершение работы.

Теперь посмотрим, что представляет собой нить, отвечающая за работу с конкретным клиентом:

//Нить для работы с отдельным клиентом
TTCPThread = class(TThread)
private
  FSocket: TTCPBlockSocket;
  {Обрабатывает полученные от клиента данные и отправляет их обратно}
  procedure ProcessingData(const AData: string);
protected
  procedure Execute;override;
public
  //ASocket - дескриптор сокета из очереди подключений.
  constructor Create(ASyspended: boolean; ASocket: integer);
  destructor Destroy; override;
  property Socket:TTCPBlockSocket read FSocket;
end;
 
{ TTCPThread }
 
constructor TTCPThread.Create(ASyspended: boolean; ASocket: integer);
begin
  FSocket:=TTCPBlockSocket.Create;
  FSocket.Socket:=ASocket;
  FSocket.GetSins;
  inherited Create(ASyspended);
end;
 
destructor TTCPThread.Destroy;
begin
  FSocket.Free;
  inherited;
end;
 
procedure TTCPThread.Execute;
var S:string;
begin
 //работаем пока не поступит сигнал на остановку
 while not Terminated  do
   begin
    //есть данные ожидающие чтения
    if FSocket.WaitingData > 0 then
     begin
      //получаем данные
      s:=FSocket.RecvPacket(2000);
      //ошибок при получении данных не было
      if FSocket.LastError = 0 then
        ProcessingData(S);//обрабатываем данные
      end;
    sleep(10);//"спим" 10 миллисекунд
   end;
end;
 
procedure TTCPThread.ProcessingData(const AData: string);
begin
  //есть какой-то текст
  if Length(AData)>0 then
    FSocket.SendString(ReverseString(AData));//"переворачиваем" строку и отправляем обратно клиенту
end;

Здесь для нас особый интерес представляет конструктор нити, а именно строки:

FSocket.Socket:=ASocket;
FSocket.GetSins;

Обратите внимание на то, что здесь мы уже не вызываем метод CreateSock-et, а указываем свойству Socket объекта значение дескриптора, после чего в обязательном порядке актуализируем информацию в свойствах LocalSin и RemoteSin вызовом метода GetSins.
Для получения данных от клиента мы используем метод RecvPacket, а для отправки строки клиенту (в методе ProcessingData) – метод SendString.
Теперь приступим к работе над основной программой. Здесь нам необходимо реализовать запуск/остановку «слушающей» нити, а также логирование операций. Для получения данных о работе сокета мы воспользуемся событием OnStatus, т.к. используя его можно получить практически любую необходимую информацию о сокете и при этом не потерять в скорости работы с сокетом, как, например, при использовании события On-Heartbeat.
Код основной программы представлен ниже:

unit main;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, Sys-tem.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, blcksock;
 
resourcestring
  rsStart = 'Запустить';
  rsStop = 'Остановить';
 
type
  Tfmain = class(TForm)
    Label1: TLabel;
    lbAddress: TLabel;
    Button1: TButton;
    memLog: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    Server: TListenerThread;
    procedure ServerStatus(Sender: TObject; Reason: THookSocketReason; const Value: String);
  public
    { Public declarations }
  end;
 
var
  fmain: Tfmain;
 
implementation
 
uses StrUtils;
 
{$R *.dfm}
 
procedure Tfmain.Button1Click(Sender: TObject);
begin
  if Button1.Caption=rsStart then
    begin
      Server:=TListenerThread.Create(True);
      Server.Socket.OnStatus:=ServerStatus;
      Server.Start;
      Button1.Caption:=rsStop
    end
  else
    begin
      Server.Terminate;
      Server.WaitFor;
      Server.Free;
      Button1.Caption:=rsStart;
    end;
end;
 
procedure Tfmain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Server.Terminate;
  Server.WaitFor;
  Server.Free;
end;
 
procedure Tfmain.ServerStatus(Sender: TObject; Reason: THookSocketReason;
  const Value: String);
begin
  case Reason of
    HR_Bind: begin
               memLog.Lines.Add('Bind: '+Value);
               lbAddress.Caption:=Server.Socket.GetLocalSinIP+':'+
                   IntToStr(Server.Socket.GetLocalSinPort)
             end;
    HR_CanRead: memLog.Lines.Add('Can Read');
    HR_CanWrite: memLog.Lines.Add('Can Write');
    HR_Listen: memLog.Lines.Add('Listen');
    HR_Accept: memLog.Lines.Add('Accept '+Server.Socket.GetRemoteSinIP);
    HR_ReadCount: memLog.Lines.Add('Read Count '+Value);
    HR_WriteCount: memLog.Lines.Add('Write Count '+Value);
    HR_Wait: memLog.Lines.Add('Wait');
    HR_Error: memLog.Lines.Add('Error '+Server.Socket.LastErrorDesc);
  end;
end;
 
end.

Здесь, в методе ServerStatus мы выводим в лог текущую работу нашего не-большого сервера. Запускаем приложение и жмем кнопку «Запустить». Смотрим на рисунок ниже:

Вид окна запущенного сервера

Обратите внимание на то, какое значение вернулось нам в событии OnStatus при связывании сокета с локальным адресом (Reason=HR_Bind) и какое значение мы получили, воспользовавшись методами GetLocalSinIP и Get-LocalSinPort. Здесь нет никакой ошибки, просто

Клиент

Клиент у нас будет очень простой. Все, что требуется – это соединиться с сервером, отправить строку на сервер и получить ответ. Создаем новый проект Delphi (назовем его «Client») и размещаем на форме приложения компоненты как показано на рисунке ниже:

Главная форма приложения-клиента

Код проекта достаточно простой и представлен ниже:

unit main;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, Sys-tem.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, blcksock, Vcl.StdCtrls;
 
resourcestring
  rsConnected = 'Подключено';
 
const
  cReadTimeout = 10000;
 
type
  Tfmain = class(TForm)
    Label1: TLabel;
    edAddress: TEdit;
    Label2: TLabel;
    edPort: TEdit;
    btnConnect: TButton;
    Label3: TLabel;
    edRequestString: TEdit;
    Label4: TLabel;
    lbResponseStr: TLabel;
    dtnSend: TButton;
    procedure btnConnectClick(Sender: TObject);
    procedure dtnSendClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    Client: TTCPBlockSocket;
  public
    { Public declarations }
  end;
 
var
  fmain: Tfmain;
 
implementation
 
{$R *.dfm}
 
procedure Tfmain.btnConnectClick(Sender: TObject);
begin
  Client:=TTCPBlockSocket.Create;//создаем объект
  Client.RaiseExcept:=True;//показываем все исключения Winsock
  Client.Connect(edAddress.Text,edPort.Text);//пробуем соединиться с сервером
  ShowMessage(rsConnected);
end;
 
procedure Tfmain.dtnSendClick(Sender: TObject);
begin
  Client.SendString(edRequestString.Text);//отправляем строку на сервер
  lbResponseStr.Caption:=Client.RecvPacket(cReadTimeout)//пробуем получить ответ
end;
 
procedure Tfmain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Client.Free;
end;
 
end.

Теперь протестируем работу нашего клиента

Тестирование работы

1. Запускаем сервер («Server.exe») и жмем кнопку «Запустить».

2. Запускаем клиент («Client.exe») и заносим в поля «IP-адрес» и «Порт» адрес и номер порта сервера.

Настройка подключения к серверу

3. Жмем в клиенте кнопку «Подключить».

Подключение к серверу

4. В логе сервера должна появиться запись о новом подключении:

Информация о новом подключении клиента

5. Отправляем на сервер любую строку:

Результат работы

Как видно на последнем рисунке, наше приложение вполне справилось с поставленной целью, а мы научились создавать сервер TCP с использованием библиотеки Synapse.

Класс TDgramBlockSocket

TDgramBlockSocket – это класс реализующий датаграммный сокет.

В классе реализованы следующие методы:

procedure Connect(IP, Port: string); override;

function SendBuffer(Buffer: TMemory; Length: Integer): Integer; override;

function RecvBuffer(Buffer: TMemory; Length: Integer): Integer; override;

Класс TUDPBlockSocket

Класс, реализующий сокет UDP. Поддерживаемые возможности: IPv4, IPv6, unicasts, broadcasts, multicasts, SOCKS5 прокси.

Все методы чтения данных в этом классе используют метод TBlockSocket RecvBufferFrom, а все методы отправки данных – SendBufferTo. В связи с этим разработчики Synapse рекомендуют нам для чтения безопасно пользоваться методом RecvPacket, а для отправки данных – использовать любые методы, например SendString, SendByte и т.д.

Свойства класса:

property MulticastTTL: Integer

Методы класса:

procedure EnableBroadcast(Value: Boolean);

function SendBufferTo(Buffer: TMemory; Length: Integer): Integer; override;

function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; override;

procedure AddMulticast(MCastIP:string);

procedure DropMulticast(MCastIP:string);

procedure EnableMulticastLoop(Value: Boolean);

function GetSocketType: integer; override;

function GetSocketProtocol: integer; override;

Третий пример: чат

В качестве примера работы с сокетами UDP в Synapse мы реализуем небольшой чат для обмена сообщениями в локальной сети. А чтобы как можно более полно охватить возможности работы с TUDPBlockSocket, мы реализуем наш чат в двух вариантах – с использованием широковещательных (broadcast) и многоадресных (multicast) рассылок – обе эти формы передачи данных поддерживаются в Synapse. Но, прежде чем мы приступим к разработке программы, посвятим немного времени изучению вопроса маршрутизации пакетов в компьютерных сетях.

Итак, можно выделить следующие основные формы маршрутизации:

Unicast – метод передачи, при котором пакет передается одному адресату.

Broadcast (широковещание) — метод передачи данных, при котором пакет предназначен для приёма всеми участниками сети. Broadcast не поддерживается в IPv6 и вместо широковещания в таких сетях необходимо пользоваться многоадресной рассылкой (multicast)

Multicast — специальная форма широковещания, при которой сетевой пакет одновременно направляется определённому подмножеству адресатов — не одному (unicast), и не всем (broadcast).

Есть также и другие методы передачи, например, такие как anycast (передача пакета ближайшему), geocast (по географическому положению) и т.д. Но эти методы мы рассматривать не будем, т.к. это выходит за рамки изучения Synapse.

Графически Unicast, Multicast и Broadcast можно представить так:

Теперь, определившись с понятиями, попробуем реализовать наш чат.

Broadcast

Создаем новые проект Delphi (назовем его UDPChat) и на главную форму помещаем компоненты как показано на рисунке ниже:

Интерфейс чата

Наш будущий чат будет и клиентом и сервером одновременно. При этом надо учесть, что, если отправка сообщений участникам чата будет происходить только по требованию пользователя, то получение сообщений от других участников чата должно обеспечиваться непрерывно. То есть серверная часть нашей программы должна работать непрерывно в отдельной нити.

Участник чата может выполнить следующие операции:

• Войти в чат;
• Выйти из чата;
• Сменить свой ник;
• Отправить сообщение всем участникам, включая и себя самого.

Чтобы наша читающая нить могла различить, какую именно операцию производит участник чата, создадим такой тип данных:

TMessageType = (smNone, smEnter, smLeave, smChangeNick, smSend);

Теперь определимся с форматом сообщений, которые будут посылаться нашей программой. Пусть это будет строка следующего вида:

операция:ник_участника:текст

Получив такую строку, мы сможем однозначно определить, кто из участников произвел действие и, какое это действие.
Теперь приступим к разработке нити. Добавляем в секцию uses модуль blcksock и создаем такие типы данных:

type
  //событие, описывающее действия участника чата
  TOnMessage = procedure (Sender: TObject; ASysMessage: TMessageType; const UserIP, UserName, LogMessage: string) of object;
  //событие, возникающее при ошибке работы нити
  TOnError = procedure (Sender: TObject; ErrorMsg: string)of object;
  TUDPReader = class(TThread)
  private
    FSocket: TUDPBlockSocket;
    FOnMessage: TOnMessage;
    FOnError:TOnError;
    procedure DoMessage(const AMessage: string);
  protected
    procedure Execute;override;
  public
    property OnMessage:TOnMessage read FOnMessage write FOnMessage;
    property OnError:TOnError read FOnError write FOnError;
end;

Здесь метод DoMessage получает строку, отправленную участником чата, и вызывает событие OnMessage следующим образом:

procedure TUDPReader.DoMessage(const AMessage: string);
var Operation: TMessageType;
    UserName: string;
    S:String;
begin
  //operation:nick:message
  S:=AMessage;
  Operation:=TMessageType(StrToIntDef(Copy(AMessage,1,1),0));
  Delete(S,1,2);
  UserName:=copy(S,1,pos(':',S)-1);
  Delete(S,1,Length(UserName)+1);
  if Assigned(FOnMessage) then
    FOnMessage(Self,Operation,FSocket.GetRemoteSinIP,UserName,S);
end;

Метод Execute потока выглядит следующим образом:

procedure TUDPReader.Execute;
var S: string;
begin
  FSocket:=TUDPBlockSocket.Create;
  try
    FSocket.EnableReuse(True);//включаем режим повторного использования адреса
    FSocket.Bind(FSocket.LocalName,cPort);//привязываем сокет к адресу
    if FSocket.LastError<>0 then //во время привязки произошла ошибка
      begin
        if Assigned(FOnError) then
          FOnError(Self,FSocket.LastErrorDesc);
        Exit;
      end;
    while not Terminated do
      begin
        S:=FSocket.RecvPacket(cReadTimeout); //пробуем получить пакет
        if S<>'' then
          DoMessage(S); //пакет получен - обрабатываем
      end;
  finally
    FSocket.Free;
  end;
end;

То есть, как и говорилось выше, наша нить ничего не отправляет, только получает данные и генерирует события OnMessage или, если возникла ошибка, то OnError.
Теперь напишем код основной программы. Начнем с процедуры отправки нового сообщения участникам чата. Задаем следующие константы:

const
  cBroadcastIP = '255.255.255.255';
  cPort = '24401';
 
procedure Tfmain.SendMessage(MessageType: TMessageType; MessageText: string; IP:string);
const cMess = '%d:%s:%s';
var s: string;
    SendSock: TUDPBlockSocket;
begin
  if MessageType=smNone then Exit;
  S:=Format(cMess,[ord(MessageType),edName.Text,MessageText]);
   SendSock:=TUDPBlockSocket.Create;
  try
    SendSock.createsocket;
    if IP='' then //broadcast
      begin
        SendSock.EnableBroadcast(True);
        SendSock.Connect(cBroadcastIP,cPort);
      end
    else
      SendSock.Connect(IP,cPort);//unicast
    SendSock.SendString(s);
    if SendSock.LastError<>0 then
       raise Exception.Create(SendSock.LastErrorDesc);
  finally
    SendSock.Free;
  end;
end;

В этой процедуре мы реализовали сразу два метода передачи данных – unicast

SendSock.Connect(IP,cPort);//unicast
SendSock.SendString(s);

и broadcast

if IP='' then //broadcast
 begin
   SendSock.EnableBroadcast(True);
   SendSock.Connect(cBroadcastIP,cPort);
 End
 …
 SendSock.SendString(s);

Для чего нам в чате unicast? Во-первых, если нам потребуется добавить в программу возможность приватных бесед (один-на-один), то unicast тут подойдет самым наилучшим образом. Во-вторых, когда в Сети появляется новый участник чата, то:

1. новичок должен сообщить всем о своем присутствии
2. все участники должны сообщить только новичку о том, что они есть в Сети.

Опять же, как видите, может пригодиться unicast.

Теперь приступим к обработчикам событий потока. Обработчик ошибок самый простой – выводит в лог сообщение об ошибке:

procedure Tfmain.OnError(Sender: TObject; ErrorMsg: string);
begin
  memLog.Lines.Add('Ошибка: '+ErrorMsg)
end;

Обработчик новых сообщений, в зависимости от типа операции, должен выполнять различные действия:

procedure Tfmain.OnMessage(Sender: TObject; ASysMessage: TMessageType;
  const UserIP, UserName, LogMessage: string);
var
  I: Integer;
  S: string;
begin
  S:=UserName+'('+UserIP+')';
  case ASysMessage of
    smEnter:begin
             if liUsers.Items.IndexOf(S)0 then
                        begin
                          liUsers.Items.Insert(i+1,S);
                          liUsers.Items.Delete(i);
                        end;
                  end;
    smSend: memLog.Lines.Add(UserName+': '+LogMessage);
  end;
end;

Теперь нам осталось только правильно запустить нить, написать обработчики события OnClick двух кнопок и послать сообщения о входе и выходе из чата.
Запуск потока будем осуществлять в момент создания формы приложения:

procedure Tfmain.FormCreate(Sender: TObject);
begin
  Reader:=TUDPReader.Create(True);
  Reader.OnMessage:=OnMessage;
  Reader.OnError:=OnError;
  Reader.Start;
end;

Сообщать о своем присутствии будем в момент активации формы:

procedure Tfmain.FormActivate(Sender: TObject);
begin
   SendMessage(smEnter);//говорим всем, что мы пришли
end;

Сообщаем все о смене ника (обработчик OnClick кнопки «Ok»):

procedure Tfmain.btnChangeNickClick(Sender: TObject);
begin
  SendMessage(smChangeNick);//говорим всем, что сменили ник
end;

Отправляем сообщение в чат (обработчик OnClick кнопки «Отправить»):

procedure Tfmain.btnSendClick(Sender: TObject);
begin
  SendMessage(smSend,edMessage.Text);//говорим всем что-нибудь
end;

И в конце, перед закрытием программы, останавливаем нить и говорим всем, что уходим:

procedure Tfmain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Reader.Terminate;
  reader.WaitFor;
  Reader.Free;
  SendMessage(smLeave); //говорим всем, что уходим
end;

Теперь можно протестировать работу нашего чата. Так как у нас в потоке включается режим повторного использования адреса, то можете запускать прямо у себя на компьютере несколько копий приложения. Но при этом учитывайте, что поиск пользователя в списке проводится по IP, т.е. список пользователей во всех копиях программы будут выглядеть так:

Запуск нескольких копий чата на одном компьютере

Теперь можете попробовать отправить сообщение, сменить ник или вообще закрыть одну копию программы и посмотреть, как эти все операции будут выполняться:

Результат работы чата

Как видите, наш чат работает. Теперь попробуем реализовать этот же чат, но вместо broadcast использовать многоадресную передачу данных (multicast). Результат работы чата при этом практически не изменится.

Multicast

Итак, в случае multicast’а, пакет должен быть отправлен определенному кругу получателей. Чтобы добавить сокет в группу получателей необходимо выполнить метод AddMulticast, чтобы удалиться из группы – DropMulticast.

При работе с Multicast следует учитывать, что технология IP Multicast использует адреса с 224.0.0.0 до 239.255.255.255. То есть для отправки и получения сообщений группы, нам необходимо выполнять Connect на один из адресов этого диапазона.

Теперь приступим к разработке нашего чата. Для этого возьмите предыдущий проект (чат с использованием broadcast) и скопируйте его в любую удобную для вас директорию. Теперь откройте скопированный проект и добавьте на главную форму компонент TCheckBox как показано на рисунке ниже:

Чат с Multicast

Выбор флажка «Принимать сообщения» будет добавлять наш «читающий» сокет (в потоке) в группу на получение multicast-пакетов и сообщать всем участникам чата о нашем присутствии. Для выполнения этих действий добавим в поток TUDPReader два метода как показано ниже:

TUDPReader = class(TThread)
  private
    ....
  protected
    procedure Execute;override;
  public
    procedure AddMulticast(const MIP: string);
    procedure DropMulticast(const MIP: string);
    ....
end;
 
procedure TUDPReader.AddMulticast(const MIP: string);
begin
  FSocket.AddMulticast(MIP);
end;
 
procedure TUDPReader.DropMulticast(const MIP: string);
begin
  FSocket.DropMulticast(MIP);
end;

Метод Execute нити переписываем следующим образом:

procedure TUDPReader.Execute;
var S: string;
begin
  FSocket:=TUDPBlockSocket.Create;
  try
    FSocket.EnableReuse(True);//включаем режим повторного использования
    FSocket.Bind(FSocket.LocalName,cPort);//привязываем сокет к адресу
    if FSocket.LastError<>0 then //во время привязки произошла ошибка
      begin
        if Assigned(FOnError) then
          FOnError(Self,FSocket.LastErrorDesc);
        Exit;
      end;
    while not Terminated do
      begin
        S:=FSocket.RecvPacket(cReadTimeout); //пробуем получить пакет
        if S<>'' then
          DoMessage(S); //пакет получен - обрабатываем
      end;
  finally
    FSocket.Free;
  end;
end;

Теперь добавим в модуль такую константу, определяющую IP-адрес для Multicast:

const
  cMulticastIP = '234.5.6.7';

И напишем обработчик OnClick флажка «Принимать сообщения» следующим образом:

procedure Tfmain.chkMulticastClick(Sender: TObject);
begin
  btnSend.Enabled:=chkMulticast.Checked;
  if chkMulticast.Checked then
    begin
      Reader.AddMulticast(cMulticastIP);
      SendMessage(smEnter);
    end
  else
    begin
      Reader.DropMulticast(cMulticastIP);
      SendMessage(smLeave);
    end;
end;

Осталось переписать метод SendMessage. В случае использования Multicast он будет выглядеть следующим образом:

procedure Tfmain.SendMessage(MessageType: TMessageType; MessageText: string; IP:string);
const cMess = '%d:%s:%s';
var s: string;
    SendSock: TUDPBlockSocket;
begin
  if MessageType=smNone then Exit;
  S:=Format(cMess,[ord(MessageType),edName.Text,MessageText]);
  SendSock:=TUDPBlockSocket.Create;
  try
    SendSock.createsocket;
    if IP='' then //Multicast
      SendSock.Connect(cMulticastIP,cPort)
    else
      SendSock.Connect(IP,cPort);//unicast
    SendSock.SendString(s);
    if SendSock.LastError<>0 then
       raise Exception.Create(SendSock.LastErrorDesc);
  finally
    SendSock.Free;
  end;
end;

Теперь можете сравнить проект с использованием Broadcast и только что измененный его вариант, ориентированный на применение Multicast. Вы увидите, что поменялось буквально 10 строк (ну и добавился 1 компонент без которого можно было бы обойтись). Для конечного пользователя работа чата будет точно такой же, как и в предыдущем варианте, но используемые технологии передачи данных – разные.
Можете запустить проект и проверить, что все операции работают, как и ранее.

На этом мы закончим наше знакомство с классом TUDPBlockSocket и перейдем к другим классам Synapse. Так как оставшиеся классы, реализующие работу с сокетами, являются реализацией либо «сырых» сокетов, то ниже ограничимся лишь описанием переопределенных методов этих классов, а их использование в Synapse рассмотрим чуть позднее, когда будем рассматривать клиенты для протоколов прикладного уровня.

Класс TICMPBlockSocket

Этот класс представляет собой «сырой» сокет для ICMP. В классе переопределены два метода:

function GetSocketType: integer; override;

function GetSocketProtocol: integer;

Одним из применений этого класса в Synapse является класс TPingSend, реализующий утилиту Ping в Delphi для диагностики Сети.

Класс TRAWBlockSocket

Реализация «сырого» сокета.

Методы класса:

function GetSocketType: integer; override;

function GetSocketProtocol: integer;

Класс TPGMMessageBlockSocket

Реализация сокета для протокола PGM.

Методы класса:

function GetSocketType: integer; override;

function GetSocketProtocol: integer;

Класс TPGMStreamBlockSocket

Реализация  сокета для протокола PGM.

Методы класса:

function GetSocketType: integer; override;

function GetSocketProtocol: integer;

Отладка работы сокетов в Synapse

Закончить изучение реализации сокетов в Synapse стоит с рассмотрения вопроса об отладке работы классов, реализующих сокеты. Для этой цели в Synapse имеется специальный модуль– synadbg.pas.

В этом модуле реализован класс:

type
  TSynaDebug = class(TObject)
    class procedure HookStatus(Sender: TObject; Reason: THookSocketReason; const Value: string);
    class procedure HookMonitor(Sender: TObject; Writing: Boolean; const Buff-er: TMemory; Len: Integer);
  end;

Используя методы класса Вы можете создавать лог работы сокета, который будет записан в файл с именем «имя_проекта.slog»
Для демонстрации работы с классом TSynaDebug попробуем записать лог работы нашего UDP-чата из последнего примера.
Итак, подключаем в секцию uses модуль synadbg и добавляем в проект следующие строки:

procedure Tfmain.SendMessage(MessageType: TMessageType; MessageText: string; IP:string);
...
begin
...
  SendSock:=TUDPBlockSocket.Create;
  try
    SendSock.OnStatus:=TSynaDebug.HookStatus;
    SendSock.OnMonitor:=TSynaDebug.HookMonitor;
    ....
  finally
    SendSock.Free;
  end;
end;

Теперь запустим чат и отправим одно или несколько сообщений. В результате в папке с проектом появится файл UDPChat.slog, содержащий следующую отладочную информацию:

20131105-020940.418 025704E0HR_ResolvingBegin: 234.5.6.7:24401
20131105-020940.422 025704E0HR_ResolvingEnd: 234.5.6.7:24401
20131105-020940.426 025704E0HR_SocketCreate: IPv4
20131105-020940.429 025704E0HR_Connect: 234.5.6.7:24401
20131105-020940.433 025704E0-> 4:edName:edMessage
20131105-020940.438 025704E0HR_WriteCount: 18
20131105-020940.443 025704E0HR_SocketClose:

В лог будет записываться каждое действие с сокетом, в т.ч. и сведения об ошибках. Если вам по каким-то причинам не хватит предоставленной информации, то Вы всегда можете написать собственные обработчики событий OnStatus и OnMonitor сокета, чтобы собрать недостающие данные.
На этом мы заканчиваем рассмотрение сокетов в Synapse и переходим к следующей части – работе с протоколами прикладного уровня, таким как HTTP, FTP, SMTP и т.д.

Вот такая получилась первая глава книги. И в заключении я хотел бы обратиться ко всем читателям блога с просьбой. Как вы могли заметить, прочитав эту главу, на многие типы сокетов Synapse нет примеров, а сама глава содержит больше справочной информации по свойствам и методам сокетов, чем примеров их использования. С какими-то сокетами мы вообще не имели дела, например, с TPGMMessageBlockSocket. На другие — просто не смогли подобрать пример, который будет достаточно короткий и отражал бы смысл работы с конкретным типом сокета. Поэтому, если у вас есть на руках готовые примеры по сокетам Synapse, и вам не жалко им поделиться с нами, пожалуйста, сбрасывайте их на мой почтовый ящик (vlad383@mail.ru). В тексте письма можете указать свои Ф.И.О., чтобы мы могли указать в книге чей это пример.

Или, если кнопка не отображается, то через копилку в сайдбаре (виджет «Поддержка блога»). В комментарии к платежу, опять же, можете указать Ф.И.О., адрес своего сайта, странички ВК и т.д.

Книжная полка

	Автор: Андрей Шкрыль Название: Разработка клиент-серверных приложений в Delphi Описание: Рассмотрены практические вопросы по разработке клиент-серверных приложений в среде Delphi 7 и Delphi 2005 с использованием СУБД MS SQL Server 2000, InterBase и Firebird. Приведена информация о теории построения реляционных баз данных и языке SQL. Освещены вопросы эксплуатации и администрирования СУБД.
	Автор: Антон Григорьев Название: О чем не пишут в книгах по Delphi Описание: Рассмотрены малоосвещенные вопросы программирования в Delphi. Описаны методы интеграции VCL и API. Показаны внутренние механизмы VCL и приведены примеры вмешательства в эти механизмы. Рассмотрено использование сокетов в Delphi: различные режимы их работы, особенности для протоколов TCP и UDP и др.