2012-03-20 3 views
2

UDP 프로토콜을 사용하여 시냅스로 서버 및 클라이언트 프로그램을 만들어야합니다.델파이 시냅스 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; 

그래서 내가 들어오는 모든 메시지를 얻을 원하는 들어오는 메시지를들을 수있는 서버 프로그램을 만들었습니다. 하지만이 메시지의 출처에서 응답을 보내려고합니다.

어떻게 할 수 있습니까? 내 방법은 서버/클라이언트에 좋은가요?

답변

6

내 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. 

코드는 무료 파스칼로 작성하지만, 델파이에서 동일하게 작동합니다. 클라이언트 장치는 실제로 평균 응답 시간과 누락 된 패킷을 계산하는 회선 분석기입니다. 특정 서버에 대한 인터넷 회선의 품질을 확인하는 것이 이상적입니다. 클라이언트 측 서버 부분과 클라이언트에 에코 서버를 배치합니다.

는 는
2
두 프로그램

간단한 클라이언트 - 서버

클라이언트 두 개의 문자열에 "Hello World"와 "종료"클라이언트 메시지

서버 대기를 보내고 클라이언트 보낸 후 중지 "종료"

는 는

는에 쓰기 무료 파스칼 (나사로)

클라이언트

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. 

서버

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.