Ver Mensaje Individual
  #22  
Antiguo 12-04-2017
Avatar de escafandra
[escafandra] escafandra is offline
Miembro Premium
 
Registrado: nov 2007
Posts: 2.195
Reputación: 20
escafandra Tiene un aura espectacularescafandra Tiene un aura espectacular
Es posible tener varios servidores escuchando en la misma máquina por el mismo puerto, no es una situación común pero no es un imposible. Para esto está el Multicast.

Te pongo un ejemplo de servidor socket multicast en un thread para poder compaginarlo con una app de ventanas:
Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, WinSock;

type
  TServer = class(TThread)
  private
  protected
    procedure Execute; override;
  public
  end;


  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    Server: TServer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}



//---------------------------------------------------------------------------
// Establecer y ejecutar Timeout en winsock recv / recvfrom
// retorna como winSock.Select
//  -1: si error
//   0: fuera de tiempo
// > 0: Datos listos para leer
function TimeoutSocket(Sock: WinSock.TSOCKET; TimeOut: integer): integer;
var
  FDSet: WinSock.TFDSET;
  TimeVal: WinSock.TTIMEVAL;
begin
  TimeVal.tv_sec:= TimeOut div 1000;
  TimeVal.tv_usec:= TimeOut mod 1000;
  FD_ZERO(FDSet);
  FD_SET(Sock, FDSet);
  Result:= WinSock.Select(0, @FDSet, nil, nil, @TimeVal)
end;


procedure TServer.Execute;
const
  BufferSize = 1024;
  Port = 9090;
var
  WSA: WinSock.TWSADATA;
  Sock: WinSock.TSOCKET;
  Addr: WinSock.sockaddr_in;
  Buffer: array[0..BufferSize-1] of AnsiChar;
  Len, AddrSize: integer;
  dwTime: DWORD;
  ValMulticast: AnsiCHAR;
begin
  if (WinSock.WSAStartup(MakeWord(2, 2), WSA) <> 0) then exit;
  Sock := WinSock.socket(AF_INET, SOCK_DGRAM, IPPROTO_IP);
  if (Sock <> INVALID_SOCKET) then
  begin
    dwTime:= 1000;
    ValMulticast:= #1;
    setsockopt(Sock, SOL_SOCKET, SO_RCVTIMEO, PCHAR(@dwTime), sizeof(dwTime));
    setsockopt(Sock, SOL_SOCKET, SO_REUSEADDR, @ValMulticast, sizeof(ValMulticast));
    setsockopt(Sock, IPPROTO_IP, IP_MULTICAST_LOOP, 0, 1);
    Addr.sin_family := AF_INET;
    Addr.sin_addr.s_addr := INADDR_ANY;
    Addr.sin_port := WinSock.htons(Port);
    AddrSize := sizeof(Addr);

    // Asociamos el socket al puerto y a escuchar
    if (bind(Sock, Addr, AddrSize) <> -1) then
    begin
      // Bucle de escucha...
      while not Terminated do
      begin
        Len := 0;

        // Comprobamos si ha recibido algun mensaje que leer
        if TimeoutSocket(Sock, 500) > 0 then
        begin
          ZeroMemory(@Buffer[0], BufferSize);
          Len := WinSock.recvfrom(Sock, Buffer, BufferSize-1, 0, Addr, AddrSize);
          // Leemos el paquete enviado
          if (Len > 0) and (Len < BufferSize) then
          begin
            Windows.Beep(1000, 100);
            MessageBox(0, Buffer, 'Eureka',0);
          end;
        end;
      end;
    end;
    WinSock.closesocket(Sock);
  end;
  WinSock.WSACleanUp;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Server:= TServer.Create(false);
end;

end.

Este servidor se pone a la escucha en el puerto 9090 y podemos tener varios en ejecución.

Ahora el cliente debe enviar mensajes UDP al Broadcast por el puerto 9090, para ello debemos calcular esa dirección. Te pongo un ejemplo de cliente que envía un mensaje a todos los servidores a la vez, estén o no en la misma máquina:
Código Delphi [-]
unit Unit2;

interface

uses
  Windows, WinSock, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm2 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

TMIB_IPADDRROW = packed record
  dwAddr: DWORD;
  dwIndex: DWORD;
  dwMask: DWORD;
  dwBCastAddr: DWORD;
  dwReasmSize: DWORD;
  unused1: SmallInt;
  wType: SmallInt;
end;

TMIB_IPADDRTABLE = record
  dwNumEntries: DWORD;
  table: array[0..0] of TMIB_IPADDRROW;
end;
PMIB_IPADDRTABLE = ^TMIB_IPADDRTABLE;


function GetIpAddrTable(IpAddrTable: PMIB_IPADDRTABLE; pdwSize: PULONG;
  Order: BOOL): DWORD; stdcall; external 'iphlpapi.dll' name 'GetIpAddrTable';

var
  Form2: TForm2;

implementation

{$R *.dfm}
function GetCurrentIP: DWORD;
var
  Wsa: WSADATA;
  Name: array[0..255] of char;
  hostinfo: PHOSTENT;
begin
  Result:= 0;
  FillChar(Wsa, SizeOf(WSAData), 0);
  if WSAStartup(MAKEWORD(2, 2), Wsa) = 0 then
  begin
    if gethostname(Name, SizeOf(Name)) = 0 then
    begin
      hostinfo:= gethostbyname(Name);
      if hostinfo <> nil then
        Result:= PDWORD(hostinfo^.h_addr_list^)^;
    WSACleanup;
    end;
  end;
end; 
 
function GetBrodcastAddress: String;
var
  pIPAddrTable: PMIB_IPADDRTABLE;
  dwSize: DWORD;
  i: integer;
  BroadCastInAddr: IN_ADDR;
begin
  BroadCastInAddr.S_addr:= 0;
  dwSize:= 0;
  GetIpAddrTable(nil, @dwSize, true);
  GetMem(pIPAddrTable, dwSize);
  if pIPAddrTable<>nil then
  begin
    if GetIpAddrTable(pIPAddrTable, @dwSize, true) = NO_ERROR then
      for i:=0 to  pIPAddrTable^.dwNumEntries-1 do
      begin
        if GetCurrentIP = pIPAddrTable^.table[i].dwAddr then
        begin
          BroadCastInAddr.S_addr:= pIPAddrTable^.table[i].dwAddr or not pIPAddrTable^.table[i].dwMask;
          break;
        end;
      end;
    FreeMem(pIPAddrTable);
  end;
  Result:= inet_ntoa(BroadCastInAddr);
end;

procedure SendUDP(Msg: AnsiString; IP: String; Port: WORD);
var
 Wsa: WSADATA;
 S: TSocket;
 Addr: WinSock.sockaddr_in;
 Host: PHostent;
 IPAddr: ^integer;
begin
  if WSAStartup(MAKEWORD(2, 2), Wsa) = 0 then
  try
    S:= Socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP);
    if S <> INVALID_SOCKET then
    begin
      Host:= gethostbyname(PAnsiCHAR(IP));
      IPAddr:= @Host.h_addr_list^[0];
      Addr.sin_family:= AF_INET;
      Addr.sin_addr.S_addr:= IPAddr^;
      Addr.sin_port:= htons(Port);
      Sendto(S, PAnsiChar(Msg)^, Length(Msg), 0, Addr, SizeOf(sockaddr_in));
     end;
  finally
    WSACleanup();
  end;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  SendUDP('Hola', GetBrodcastAddress, 9090);
end;

end.

Probado en Win10 y compilado con Delphi 7


Espero que resuelva tu duda y en general la duda que originó ente hilo.


Saludos.
Responder Con Cita