2 UDP server auf demselben Port ?

[joachimd]

Zitat von th_bone:

gibt es einen Weg 2 UDP server (auf einem Rechner) zu erlauben über den selben Port lauschen ?

Du darfst den Port nicht exklusiv binden. Ich habe mal sowas für die Notification in ADS in eine Komponente (Komponente kapselt einen Empfangs-Thread) gepackt. Die kannst Du Dir für Deine Zwecke abändern. Verantwortlich ist in CreateSocket das SO_REUSEADDR.

Delphi-Quellcode:

unit AdsNotify;

interface

uses
  SysUtils, Classes, winsock, windows;

type

  ESocketError = class(EOSError);
  TrcLog = procedure(s:string) of object;
  TrcNotifyEvent = procedure (Sender:TObject;tables:string) of object;

  TReceiveThread = class(TThread)
  private
    { Private declarations }
    fPort:integer;
    FOnReceive: TrcNotifyEvent;
    FOnLog: TrcLog;
    procedure SetOnLog(const Value: TrcLog);
    procedure SetOnReceive(const Value: TrcNotifyEvent);
  protected
    procedure Execute; override;
    procedure DoReceive;
    procedure Log(s:string);
  public
    msg:string;
    constructor Create(Port:integer);
    property OnReceive:TrcNotifyEvent read FOnReceive write SetOnReceive;
    property OnLog:TrcLog read FOnLog write SetOnLog;
  end;

  tAdsNotify = class(TComponent)
  private
    FPort: integer;
    FOnNotification: TrcNotifyEvent;
    rcThread:TReceiveThread;
    procedure SetPort(const Value: integer);
    procedure SetOnNotification(const Value: TrcNotifyEvent);
    { Private declarations }
  protected
    { Protected declarations }
    procedure DoNotification;
  public
    { Public declarations }
    constructor Create(Owner:TComponent; Port:integer=0);  reintroduce;
  published
    { Published declarations }
    property Port:integer read FPort write SetPort;
    property OnNotification:TrcNotifyEvent read FOnNotification write SetOnNotification;
  end;

resourcestring
  SSocketError = 'Socket Error.  Code: %d.' + sLineBreak + '%s';
  SUnkSocketError = 'A call to a socket function failed';

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Advantage', [tAdsNotify]);
end;

{ tAdsNotify }

constructor tAdsNotify.Create(Owner: TComponent; Port: integer=0);
begin
  inherited Create(Owner);
  rcThread:=nil;
  SetPort(Port);
end;

procedure tAdsNotify.DoNotification;
var
  tables:string;
begin
  if assigned(rcThread)
    then begin
      tables:=rcThread.msg;
      rcthread.msg:='';
      if assigned(FOnNotification)
      then FOnNotification(self,tables);
    end;
end;

procedure tAdsNotify.SetOnNotification(const Value: TrcNotifyEvent);
begin
  FOnNotification := Value;
  if assigned(rcThread)
    then rcThread.OnReceive:=OnNotification;
end;

procedure tAdsNotify.Setport(const Value: integer);
begin
  if assigned(rcThread)
    then begin
      rcThread.Terminate;
    end;
  Fport := Value;
  if FPort>0
    then begin
      rcThread:=TReceiveThread.Create(FPort);
      rcThread.OnReceive:=OnNotification;
      rcThread.FreeOnTerminate:=true;
      rcThread.Resume;
    end;
end;

{ TReceiveThread }

procedure RaiseSocketError(E: Integer);
var
  Error: ESocketError;
begin
  if E <> 0 then
    Error := ESocketError.CreateResFmt(@SSocketError, [E, SysErrorMessage(E)])
  else
    Error := ESocketError.CreateRes(@SUnkSocketError);
  Error.ErrorCode := E;
  raise Error;
end;

procedure RaiseLastSocketError;
begin
  RaiseSocketError(WSAGetLastError);
end;

procedure InitWinSock;
var
  Data: TWSAData;
  E: Integer;
begin
  E := WSAStartup(1, Data);
  if E <> 0 then
    RaiseSocketError(E);
end;

function MachineName: String;
var
  Buf: array[0..MAX_COMPUTERNAME_LENGTH] of Char;
  Len: Cardinal;
begin
  Len := SizeOf(Buf);
  if GetComputerName(Buf, Len) then
    SetString(Result, Buf, Len)
  else
    Result := '?';
end;


function CreateSocket(port:integer):TSocket;
var
  Sock: TSocket;
  Opt: Integer;
  LocalAddr:TSockAddr;
begin
  InitWinSock;
  Sock := socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP);
  if Sock = INVALID_SOCKET then
    RaiseLastSocketError;
  Opt := 1;
  if setsockopt(Sock, SOL_SOCKET, SO_REUSEADDR, @Opt, SizeOf(Opt)) <> 0 then
    RaiseLastSocketError;
  LocalAddr.sin_family := AF_INET;
  LocalAddr.sin_port := htons(port);
  LocalAddr.sin_addr.S_addr := INADDR_ANY;
  if bind(Sock, LocalAddr, SizeOf(LocalAddr)) <> 0 then
    RaiseLastSocketError;
  result:=sock;
end;

function Receive(var Sock:TSocket;var s:string;var PeerAddr:TSockAddr):boolean;
var
  PeerAddrLen: Integer;
  MsgBuf: array[0..511] of Char;
  MsgLen: Integer;
begin
  PeerAddrLen := SizeOf(PeerAddr);
  MsgLen := recvfrom(Sock, MsgBuf, SizeOf(MsgBuf), 0, PeerAddr, PeerAddrLen);
  if MsgLen>0
    then begin
      SetString(s, MsgBuf, MsgLen);
      result:=true;
    end
    else begin
      result:=false;
    end;
end;




constructor TReceiveThread.Create(Port: integer);
begin
  inherited Create(true);
  fPort:=Port;
end;

procedure TReceiveThread.DoReceive;
begin
  if assigned(FOnReceive)
    then begin
      FOnReceive(self, msg);
      msg:='';
    end;
end;

procedure TReceiveThread.Execute;
var
  Sock: TSocket;
  PeerAddr: TSockAddr;
  PeerAddrLen: Integer;
  MsgBuf: array[0..511] of Char;
  MsgLen: Integer;
begin
  try
    Sock:=CreateSocket(fport);
    while not Suspended do
      begin
        PeerAddrLen := SizeOf(PeerAddr);
        MsgLen := recvfrom(Sock, MsgBuf, SizeOf(MsgBuf), 0, PeerAddr, PeerAddrLen);
        if MsgLen > 0
          then begin
            SetString(msg, MsgBuf, MsgLen);
            DoReceive;
          end;
      end;
  except
    on E:Exception do log(e.Message);
  end;
end;

procedure TReceiveThread.Log(s: string);
begin

end;

procedure TReceiveThread.SetOnLog(const Value: TrcLog);
begin
  FOnLog := Value;
end;

procedure TReceiveThread.SetOnReceive(const Value: TrcNotifyEvent);
begin
  FOnReceive := Value;
end;

end.