delphiclientararat-synapse

Delphi synapse UDP client/server


I need to create server and client programs with synapse using UDP protocol.

I have created the server program to listen to any coming messages like this

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;

So i get all incoming messages. But i want to send a response from the source of this messages.

How can i do that? Does my method is good for server/client?


Solution

  • My UDP Echo client / server code. First the server:

    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.
    

    Then the client:

    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.
    

    The code is written in free pascal, but works equally well in Delphi. The client unit is actually a line analyzer that calculates average response times and dropped packets. It is ideal to check the quality of your internet line to a certain server. You put the echo server to the server part and client on the client side.