Delphi突触UDP客户端/服务器

Question

我需要使用UDP协议创建带有synapse的服务器和客户端程序.

我创建了服务器程序来收听这样的任何消息

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.

代码是用免费的pascal编写的,但在Delphi中同样有效.客户端单元实际上是一个线分析器,用于计算平均响应时间和丢弃的数据包.它是检查您的互联网线路到某个服务器的质量的理想选择.您将echo服务器放在客户端的服务器部分和客户端上.