Отправка UDP сообщений Delphi 6 с использованием Win Socket Api

Для того чтобы сделать клиента который отправляет UDP сообщения на Delphi создайте новую форму и расположите на ней два поля ввода Edit и одну кнопку Button1. Так же создайте процедуру по событию создания формы, а так же по событию клика на размещённую кнопу. Вставьте коды указанных процедур теми что размещены в листингах ниже.

Так же в uses необходимо добавить WinSock, а так же в type для TForm1 в private написать FSendSocket: TSocket;

Код процедуры создания формы

procedure TForm1.FormCreate(Sender: TObject);
var WSAData: TWSAData; Addr: TSockAddr; AddrLen: integer;
begin
  WSAStartup($101, WSAData);//Инициализируем работу с Win Socket API
  FSendSocket:= socket(AF_INET,SOCK_DGRAM,IPPROTO_UDP);//Создаём UDP сокет для отправки сообщения
//  if FSendSocket = INVALID_SOCKET then ошибку создания сокета можно проверить так
  FillChar(Addr.sin_zero,SizeOf(Addr.sin_zero),0);//Заполняем нулями не используемые в адресе биты, это обычная ситуация при формировании адреса в Delphi при использовании Win Socket API
  Addr.sin_family:= AF_INET;//Указываем что адрес интернет семейства
  Addr.sin_addr.S_addr:= INADDR_ANY;//Указываем что адрес для отправки система может выбрать сама
  Addr.sin_port:= 0;//Если порт 0 то система может назначить любой
  bind(FSendSocket, Addr, SizeOf(Addr));//Запрашиваем у операционной системы привязку сокета
//Проверить ошибку можно так if bind(FSendSocket, Addr, SizeOf(Addr)) = SOCKET_ERROR then
  getsockname(FSendSocket, Addr, AddrLen);//Теперь когда сокет привязан запрашиваем информацию о адресе
//Проверить ошибку можно так  if getsockname(FSendSocket, Addr, AddrLen) = SOCKET_ERROR then
  Edit2.Text:= IntToStr(Addr.sin_port);//Присваиваем полю Edit2 порт присвоенный сокету системой
end;

Код процедуры нажатия на кнопку отправки сообщения

procedure TForm1.Button1Click(Sender: TObject);
var
  SendAddr: TSockAddr; Message: string; SendRes: Integer;
begin
  FillChar(SendAddr.sin_zero, SizeOf(SendAddr.sin_zero), 0);//Заполняем не используемую часть адреса на который будет отправляеться сообщение нулями
  SendAddr.sin_family := AF_INET;//Адрес семейства Интернет
  SendAddr.sin_addr.S_addr := inet_addr(PChar('192.168.3.13'));//Там можно присвоить SendAddr значение из строки
//Можно определить ошибку установки адреса так if SendAddr.sin_addr.S_addr = INADDR_NONE then
  SendAddr.sin_port := htons(7778);//Порт на который отправляется сообщение
  Message:= Edit1.Text;//Присваиваем переменной Message сообщение из Edit1 которое будем отправлять
  if Length(Message) = 0 then
    SendRes:= sendto(FSendSocket,Message,0,0,SendAddr,SizeOf(SendAddr))//Отправляем дейтаграмму нулевой длины
  else
    SendRes:= sendto(FSendSocket,Message[1],Length(Message),0,SendAddr,SizeOf(SendAddr));//Отправляем сообщение, содержащее строку
//Проверить ошибку можно так if SendRes < 0 then, отсутствие ошибки не означает что сообщение доставлено, поскольку это UDP
end;

Сервер принимающий сообщения по UDP

Код сервера, который может принять сообщения от выше написанного клиента, находится в следующих двух листингах. По идее серверу нужно ещё бы иметь возможность отправлять клиенту назад сообщения, вот только реализовать это почему то не получилось, в частности к коде проекта есть такая строка: SendRes:= sendto(FSocket,messageToSend,0,0,SendAddr,SizeOf(SendAddr)), она закомментирована поскольку при попытке отправки UDP сообщения через слушающий сокет возикает ошибка. Поэтому в текущей версии реализован лишь приём сообщений от клиентской программы.

Скачать исходник UDP сервера можно по этой ссылке.

Листинг Unit1

unit Unit1;
      
interface
      
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WinSock, Unit2;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure AddMessageToLog(const aMsg: string);
    procedure OnStopServer;
    { Public declarations }
  end;
      
var
  Form1: TForm1;
  ReceiveThread1: TReceiveThread;//Чтобы можно было обратиться из Button2Click хотя Creae вызывается и без этого
      
implementation
      
{$R *.dfm}
      
procedure TForm1.OnStopServer;
begin
      
end;
      
procedure TForm1.AddMessageToLog(const aMsg: string);
begin
  Memo1.Lines.Add(aMsg);
  Memo1.SelStart:= Length(Memo1.Text);
end;
      
procedure TForm1.FormCreate(Sender: TObject);
var
  WSAData: TWSAData;
//  Addr: TSockAddr; // Адрес, к которому привязывается сокет для отправки сообщений
//  AddrLen: Integer;
begin
  WSAStartup($101, WSAData);
//  if WSAStartup($101, WSAData) <> 0 then begin Application.Terminate; end;
  OnStopServer;
end;
      
procedure TForm1.Button1Click(Sender: TObject);
var
  ServerSocket: TSocket; // Сокет для приёма сообщений
  ServerAddr: TSockAddr; // Адрес, к которому привязывается сокет для приёма сообщений
begin
//Формирование адреса сокета для приёма сообщений
  FillChar(ServerAddr.sin_zero,SizeOf(ServerAddr.sin_zero),0);
  ServerAddr.sin_family:= AF_INET;
  ServerAddr.sin_addr.S_addr:= INADDR_ANY;
  ServerAddr.sin_port:= htons(StrToInt(Edit1.Text));
//Так можно проверить на ошибку if ServerAddr.sin_port = 0 then чьл делать при ошибку
      
  ServerSocket:= socket(AF_INET,SOCK_DGRAM,IPPROTO_UDP);
//Так можно проверить на ошибку if ServerSocket = INVALID_SOCKET then что делать если ошибка
  bind(ServerSocket,ServerAddr,SizeOf(ServerAddr));
//Там можно было проверить если ошибка при привязке if bind(ServerSocket, ServerAddr, SizeOf(ServerAddr)) = SOCKET_ERROR then что делать при ошибке
//Создание нити, которая будет получать сообщения.
  TReceiveThread.Create(ServerSocket);
  Button1.Enabled:= False;
end;
      
procedure TForm1.Button2Click(Sender: TObject);
begin
  ReceiveThread1.sendMessageToSender('Отправлено сообщение');
end;
      
end.

Листинг Unit2

unit Unit2;
      
interface
      
uses SysUtils, Classes, WinSock;
      
type
  TReceiveThread = class(TThread)
  private
    fLogMsg: string;
    toEditClientPort: integer;
    toEditClientIP: string;
    FSocket: TSocket;
    procedure DoLogMessage;//для вызова через Synchronize
    procedure EditSenderPort;
    procedure EditSenderIP;
  protected
    procedure Execute; override;
    procedure LogMessage(const Msg: string); // Вывод сообщения в лог главной формы
  public
    constructor Create(aServerSocket: TSocket);
    procedure sendMessageToSender(messageToSend: string);
  end;
      
implementation
      
uses Unit1;
      
      
constructor TReceiveThread.Create(aServerSocket: TSocket);
begin
  FSocket:= aServerSocket;
  inherited Create(False);//Вызываем темод родительского класса
end;
      
procedure TReceiveThread.Execute;
var
  Buffer: array[0..65506] of Byte; // Буфер для получения сообщения. Размер равен максимальному размеру UDP-дейтаграммы.
  RecvAddr: TSockAddr; // Адрес, с которого пришло сообщение
  RecvLen,AddrLen: integer;
  Msg: string;
begin
  // на каждой итерации цикла читается одна дейтаграмма
  repeat
    AddrLen := SizeOf(RecvAddr);
    // Получаем дейтаграмму
    RecvLen := recvfrom(FSocket, Buffer, SizeOf(Buffer), 0, RecvAddr, AddrLen);
    // если получаем ошибку при вызове recvfrom - завершаем работу нити.
    if RecvLen < 0 then
    begin
      Synchronize(Form1.OnStopServer);
      Break;
    end;
    SetLength(Msg, RecvLen);// Устанавливаем нужный размер строки
    if RecvLen > 0 then
      move(Buffer, Msg[1], RecvLen);//копируем в неё дейтаграмму из буфера
    LogMessage('Сообщение с адреса ' + inet_ntoa(RecvAddr.sin_addr) + ':' +
      IntToStr(ntohs(RecvAddr.sin_port)) + ': ' + Msg);
    toEditClientPort:= ntohs(RecvAddr.sin_port);
    toEditClientIP:= inet_ntoa(RecvAddr.sin_addr);
    Synchronize(EditSenderPort);
    Synchronize(EditSenderIP);
  until False;
  closesocket(FSocket);
end;
      
procedure TReceiveThread.LogMessage(const Msg: string);
begin
  fLogMsg:= Msg;
  Synchronize(DoLogMessage);
end;
      
procedure TReceiveThread.EditSenderPort;
begin
  Form1.Edit2.Text:= IntToStr(toEditClientPort);
end;
      
procedure TReceiveThread.EditSenderIP;
begin
  Form1.Edit3.Text:= toEditClientIP;
end;
      
procedure TReceiveThread.DoLogMessage;
begin
  Form1.AddMessageToLog(fLogMsg);
end;
      
procedure TReceiveThread.sendMessageToSender(messageToSend: string);//Переменную messageToSend нельзя передавать как const messageToSend: string иначе метод sendto её не примет(будет ошибка и придётся передавать другую string переменную которой присваивать значение переданной)
var
  SendAddr: TSockAddr;
  SendRes: integer;
begin
  // Формируем адрес назначения на основе того, что ввёл пользователь
  FillChar(SendAddr.sin_zero,SizeOf(SendAddr.sin_zero),0);
  SendAddr.sin_family:= AF_INET;
  SendAddr.sin_addr.S_addr:= inet_addr(PChar(Form1.Edit3.Text));
//Можно проверить установку адреса так  if SendAddr.sin_addr.S_addr = INADDR_NONE then
  SendAddr.sin_port:= htons(StrToInt(Form1.Edit2.Text));
//  if Length(messageToSend) = 0 then
//    SendRes:= sendto(FSocket,messageToSend,0,0,SendAddr,SizeOf(SendAddr))//Отправляем дейтаграмму нулевой длины
//  else
//    SendRes:= sendto(FSocket,messageToSend[1],Length(messageToSend),0,SendAddr,SizeOf(SendAddr));//Отправляем сообщение, содержащее строку
//Проверить ошибку можно так if SendRes < 0 then, отсутствие ошибки не означает что сообщение доставлено, поскольку это UDP
      
end;
      
end.

Код процедуры создания формы

Код процедуры нажатия на кнопку отправки сообщения

Сервер принимающий сообщения по UDP

Листинг Unit1

Листинг Unit2

Комментарии