Delphi Synapse UDP клиент / сервер

Question

Мне нужно создать серверные и клиентские программы с синапсами по протоколу UDP.

Я создал серверную программу для прослушивания любых приходящих сообщений, подобных этому

procedure TForm1.Timer1Timer(Sender: TObject);
var
 resive:string;
begin
  InitSocket;
  resive:=UDPResiveSocket.RecvPacket(1000);
  if resive<>'' then Memo1.Lines.Add('>' + resive);

  DeInitSocket;
end;

procedure TForm1.InitSocket;
begin
  if UDPResiveSocket <> nil then
    DeInitSocket;

  UDPResiveSocket := TUDPBlockSocket.Create;
  UDPResiveSocket.CreateSocket;
  UDPResiveSocket.Bind('0.0.0.0','22401');
  UDPResiveSocket.AddMulticast('234.5.6.7');
  UDPResiveSocket.MulticastTTL := 1;
end;

procedure TForm1.DeInitSocket;
begin
  UDPResiveSocket.CloseSocket;
  UDPResiveSocket.Free;
  UDPResiveSocket := nil;
end;

Итак, я получаю всевходящие сообщения.Но я хочу отправить ответ от источника этих сообщений.

Как я могу это сделать?Мой метод хорош для сервера / клиента?

Answer 1

Мой код клиента / сервера UDP Echo. Первый сервер:

unit UE_Server;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,

  // synapse
  blcksock;

type

  { TUEServerThread }

  TUEServerThread = class(TThread)
  protected
    procedure Execute; override;
  end;

  TUEServer = class
  private
    FUEServerThread: TUEServerThread;
    function GetRunning: Boolean;
  public
    procedure Stop;
    procedure Start;
    property Running: Boolean read GetRunning;
  end;

implementation

{ TUEServer }

function TUEServer.GetRunning: Boolean;
begin
  Result := FUEServerThread <> nil;
end;

procedure TUEServer.Start;
begin
  FUEServerThread := TUEServerThread.Create(False);
end;

procedure TUEServer.Stop;
begin
  if FUEServerThread <> nil then
  begin
    FUEServerThread.Terminate;
    FUEServerThread.WaitFor;
    FreeAndNil(FUEServerThread);
  end;
end;

{ TUEServerThread }

procedure TUEServerThread.Execute;
var
  Socket: TUDPBlockSocket;
  Buffer: string;
  Size: Integer;
begin
  Socket := TUDPBlockSocket.Create;
  try
    Socket.Bind('0.0.0.0', '7');
    try
      if Socket.LastError <> 0 then
      begin
        raise Exception.CreateFmt('Bind failed with error code %d', [Socket.LastError]);
        Exit;
      end;

      while not Terminated do
      begin
        // wait one second for new packet
        Buffer := Socket.RecvPacket(1000);

        if Socket.LastError = 0 then
        begin
          // just send the same packet back
          Socket.SendString(Buffer);
        end;

        // minimal sleep
        if Buffer = '' then
          Sleep(10);
      end;

    finally
      Socket.CloseSocket;
    end;
  finally
    Socket.Free;
  end;
end;

end.

Тогда клиент:

unit UE_Client;

{$mode objfpc}{$H+}

interface

uses
  {$IFDEF WINDOWS}Windows,{$ENDIF}Classes, SysUtils, DateUtils,

  // synapse
  blcksock;

const
  cReceiveTimeout = 2000;
  cBatchSize = 100;

type
  { TUEClient }

  TUEClient = class
  private
    FSocket: TUDPBlockSocket;
    FResponseTime: Int64;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Disconnect;
    function Connect(const Address: string): Boolean;
    function SendEcho(const Message: string): string;
    property ReponseTime: Int64 read FResponseTime;
  end;

  { TUEAnalyzer }

  { TUEAnalyzerThread }

  TUEAnalyzerThread = class(TThread)
  private
    FAddress: string;
    FBatchDelay: Cardinal;
    FDropedPackets: Cardinal;
    FAverageResponse: Extended;
    FCriticalSection: TRTLCriticalSection;
    function GetAverageResponse: Extended;
    function GetDropedPackets: Cardinal;
  protected
    procedure Execute; override;
  public
    destructor Destroy; override;
    constructor Create(const Address: string; const BatchDelay: Cardinal);
    property DropedPackets: Cardinal read GetDropedPackets;
    property AverageResponse: Extended read GetAverageResponse;
  end;

  TUEAnalyzer = class
  private
    FAddress: string;
    FBatchDelay: Cardinal;
    FAnalyzerThread: TUEAnalyzerThread;
    function GetAverageResponse: Extended;
    function GetDropedPackets: Cardinal;
    function GetRunning: Boolean;
  public
    procedure StopAnalyzer;
    procedure StartAnalyzer;
    property Running: Boolean read GetRunning;
    property Address: string read FAddress write FAddress;
    property DropedPackets: Cardinal read GetDropedPackets;
    property AverageResponse: Extended read GetAverageResponse;
    property BatchDelay: Cardinal read FBatchDelay write FBatchDelay;
  end;

implementation

{ TUEAnalyzerThread }

function TUEAnalyzerThread.GetAverageResponse: Extended;
begin
  EnterCriticalsection(FCriticalSection);
  try
    Result := FAverageResponse;
  finally
    LeaveCriticalsection(FCriticalSection);
  end;
end;

function TUEAnalyzerThread.GetDropedPackets: Cardinal;
begin
  EnterCriticalsection(FCriticalSection);
  try
    Result := FDropedPackets;
  finally
    LeaveCriticalsection(FCriticalSection);
  end;
end;

procedure TUEAnalyzerThread.Execute;
var
  UEClient: TUEClient;
  Connected: Boolean;
  SendString: string;
  SendCounter: Int64;
  SumResponse: Cardinal;
  SumDropedPackets: Cardinal;
begin
  UEClient := TUEClient.Create;
  try
    Connected := UEClient.Connect(FAddress);
    try
      if not Connected then
      begin
        raise Exception.CreateFmt('Could not connect UPD client to address %s', [FAddress]);
        Exit;
      end;

      SumDropedPackets := 0;
      FAverageResponse := 0;
      FDropedPackets := 0;
      SumResponse := 0;
      SendCounter := 1;

      while not Terminated do
      begin
        SendString := IntToStr(SendCounter);

        if not (UEClient.SendEcho(SendString) = SendString) then
          Inc(SumDropedPackets);

        Inc(SumResponse, UEClient.ReponseTime);
        Inc(SendCounter);

        if (SendCounter mod cBatchSize) = 0 then
        begin
          EnterCriticalsection(FCriticalSection);
          try
            FAverageResponse := SumResponse / cBatchSize;
            FDropedPackets := SumDropedPackets;
          finally
            LeaveCriticalsection(FCriticalSection);
          end;

          // sleep for specified batch time
          Sleep(FBatchDelay * 1000);
          SumDropedPackets := 0;
          SumResponse := 0;
        end;

        // minimal sleep
        Sleep(10);
      end;
    finally
      UEClient.Disconnect;
    end;
  finally
    UEClient.Free;
  end;
end;

destructor TUEAnalyzerThread.Destroy;
begin
  {$IFDEF MSWINDOWS}
    DeleteCriticalSection(FCriticalSection)
  {$ELSE}
    DoneCriticalSection(FCriticalSection)
  {$ENDIF};

  inherited Destroy;
end;

constructor TUEAnalyzerThread.Create(const Address: string; const BatchDelay: Cardinal);
begin
  {$IFDEF MSWINDOWS}
    InitializeCriticalSection(FCriticalSection)
  {$ELSE}
    InitCriticalSection(FCriticalSection)
  {$ENDIF};

  FBatchDelay := BatchDelay;
  FreeOnTerminate := True;
  FAddress := Address;

  inherited Create(False);
end;

{ TUEAnalyzer }

procedure TUEAnalyzer.StartAnalyzer;
begin
  FAnalyzerThread := TUEAnalyzerThread.Create(FAddress, FBatchDelay);
end;

function TUEAnalyzer.GetRunning: Boolean;
begin
  Result := FAnalyzerThread <> nil;
end;

function TUEAnalyzer.GetAverageResponse: Extended;
begin
  Result := FAnalyzerThread.AverageResponse;
end;

function TUEAnalyzer.GetDropedPackets: Cardinal;
begin
  Result := FAnalyzerThread.DropedPackets;
end;

procedure TUEAnalyzer.StopAnalyzer;
begin
  if Running then
  begin
    FAnalyzerThread.Terminate;
    FAnalyzerThread := nil;
  end;
end;

{ TUEClient }

constructor TUEClient.Create;
begin
  FSocket := TUDPBlockSocket.Create;
end;

destructor TUEClient.Destroy;
begin
  FreeAndNil(FSocket);

  inherited Destroy;
end;

procedure TUEClient.Disconnect;
begin
  FSocket.CloseSocket;
end;

function TUEClient.Connect(const Address: string): Boolean;
begin
  FSocket.Connect(Address, '7');
  Result := FSocket.LastError = 0;
end;

function TUEClient.SendEcho(const Message: string): string;
var
  StartTime: TDateTime;
begin
  Result := '';
  StartTime := Now;
  FSocket.SendString(Message);

  if FSocket.LastError = 0 then
  begin
    Result := FSocket.RecvPacket(cReceiveTimeout);
    FResponseTime := MilliSecondsBetween(Now, StartTime);

    if FSocket.LastError <> 0 then
    begin
      FResponseTime := -1;
      Result := '';
    end;
  end;
end;

end.

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

Answer 2

Простой клиент-сервер в двух программах

клиент отправляет две строки "Hello world" и "exit"

сервер ожидает сообщения клиента и останавливается после отправки клиентом "exit"

написать на свободном паскале (Лазарь)

клиент

    unit Unit1;

    {$mode objfpc}{$H+}

    interface

    uses

  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,

   //ADD
   blcksock;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private

    procedure OnStatus(Sender: TObject; Reason: THookSocketReason; const Value: string );
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }
 procedure TForm1.OnStatus(Sender: TObject; Reason: THookSocketReason; const Value: string);
var
  sReason : String;
begin
  case Reason of
    HR_ResolvingBegin : sReason := 'HR_ResolvingBegin';
    HR_ResolvingEnd : sReason := 'HR_ResolvingEnd';
    HR_SocketCreate : sReason := 'HR_SocketCreate';
    HR_SocketClose : sReason := 'HR_SocketClose';
    HR_Bind : sReason := 'HR_Bind';
    HR_Connect : sReason := 'HR_Connect';
    HR_CanRead : sReason := 'HR_CanRead';
    HR_CanWrite : sReason := 'HR_CanWrite';
    HR_Listen : sReason := 'HR_Listen';
    HR_Accept : sReason := 'HR_Accept';
    HR_ReadCount : sReason := 'HR_ReadCount';
    HR_WriteCount : sReason := 'HR_WriteCount';
    HR_Wait : sReason := 'HR_Wait';
    HR_Error : sReason := 'HR_Error';
  end;
  Memo1.Lines.Add( sReason + ': ' + Value );
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  UDP: TUDPBlockSocket;
  s:string;
begin
  UDP := TUDPBlockSocket.Create;
  try
         UDP.OnStatus := @OnStatus;
         //send to server
    s:='Hello world from client';
   UDP.Connect( '127.0.0.1', '12345' );
    UDP.SendString('------'+s+'--------');
    memo1.Append(s);

    //for server stop send string "exit"
    s:='exit';
    UDP.SendString(s);
    memo1.Append('---');
    memo1.Append(s);
    memo1.Append('---');

    UDP.CloseSocket;
  finally
    UDP.Free;
  end;

  end;

end.

SERVER

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,

 //ADD
   blcksock;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    procedure OnStatus(Sender: TObject; Reason: THookSocketReason; const Value: string );
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }
 procedure TForm1.OnStatus(Sender: TObject; Reason: THookSocketReason; const Value: string);
var
  sReason : String;
begin
  case Reason of
    HR_ResolvingBegin : sReason := 'HR_ResolvingBegin';
    HR_ResolvingEnd : sReason := 'HR_ResolvingEnd';
    HR_SocketCreate : sReason := 'HR_SocketCreate';
    HR_SocketClose : sReason := 'HR_SocketClose';
    HR_Bind : sReason := 'HR_Bind';
    HR_Connect : sReason := 'HR_Connect';
    HR_CanRead : sReason := 'HR_CanRead';
    HR_CanWrite : sReason := 'HR_CanWrite';
    HR_Listen : sReason := 'HR_Listen';
    HR_Accept : sReason := 'HR_Accept';
    HR_ReadCount : sReason := 'HR_ReadCount';
    HR_WriteCount : sReason := 'HR_WriteCount';
    HR_Wait : sReason := 'HR_Wait';
    HR_Error : sReason := 'HR_Error';
  end;
  Memo1.Append( sReason + ': ' + Value );
end;


procedure TForm1.Button1Click(Sender: TObject);
var
 Sock:TUDPBlockSocket;
 size:integer;
 buf:string;
begin
 Sock:=TUDPBlockSocket.Create;
 try
 //On status show error and other
//enable on status if you can more seen
 //sock.OnStatus := @OnStatus;
 sock.CreateSocket;
 //create server
 sock.bind('127.0.0.1','12345');


   //send string to this server in this program(not client)
   sock.Connect( '127.0.0.1', '12345' );
    sock.SendString('test send string to sever');


 if sock.LastError<>0 then exit;

  //shutdown while client send "exit"
  while buf<>'exit' do
 begin
  //get data client
 buf := sock.RecvPacket(1000);
 Memo1.Append(buf);

 sleep(1);

 end;



 sock.CloseSocket;
 finally
 sock.free;
 end;
end;

end.