Delphi synapse UDP client/server - delphi

Question

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?

Answer 1

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.

Answer 2

Simple client-server in two program
client send two string "Hello world" and "exit"
server wait for client message and stop after client send "exit"
write on free pascal(Lazarus)
client
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.