Servidor UDP sencillo

Este es un ejemplo de servidor UDP pequeño y ligero, sin grandes pretensiones. Su funcionamiento es sencillo, al ejecutar el programa se pone a escuchar por el puerto 61978 a la espera de recibir un comando, cuando lo recibe crea un nuevo hilo de ejecución que se encarga de procesar el comando y, si es necesario, enviar una respuesta.

Los comandos que recibe deben ser lineas de texto con el siguiente formato:

[Uid] comando parametros

Donde "comando" se refiere a la orden que debe ejecutar el servidor y "parámetros" a la lista de parámetros, separados por espacios, que se le pasan a ese comando. En cuanto a "Uid" es un identificador único (un número entero mayor de cero) que sera agregado al principio de la respuesta que envía el servidor, de tal forma que podemos emparejar un comando con su respuesta. El "Uid" es opcional y si no se envía la respuesta tampoco ira encabezada por ningún identificador.

Algunos ejemplos de comandos son:

time
date
random
echo "Hola mundo"
1234 echo "Hola mundo"
delay 5 echo "Han pasado 5 segundos"
quit

El código fuente es el siguiente (es una aplicación de consola):

program udpsrv;
 
{$APPTYPE CONSOLE}
 
uses Windows, Sysutils, Classes, Winsock;
 
 
type
  // Esta clase procesa los comandos
  TProcess = class(TThread)
  private
    FAddress: TSockaddr;
    FCmdLine: AnsiString;
    FSocket: TSocket;
    FTerminated: PBoolean;
    FMutex: THandle;
  protected
    procedure Execute; override;
  public
    constructor Create(CmdLine: AnsiString; Socket: TSocket;
      Addr: TSockaddr; Term: PBoolean);
    destructor Destroy; override;
  end;
 
const
  CR = #13;
  LF = #10;
  CRLF = CR + LF;
  BUFFER_SIZE = 64 * 1024; // 64 Kilobytes
 
{ TProcess }
 
constructor TProcess.Create(CmdLine: AnsiString; Socket: TSocket;
  Addr: TSockaddr; Term: PBoolean);
begin
  FAddress:= Addr;
  FCmdLine:= Trim(CmdLine);
  FSocket:= Socket;
  FTerminated:= Term;
  // Creamos un mutex para evitar que dos threads utilicen el socket a la vez
  FMutex:= CreateMutex(nil,FALSE,
    PAnsiChar('{2471216C-2028-4163-AFC9-B0238E5B26EC}/' + IntToHex(Socket,8)));
  // Si no podemos crear el mutex anulamos todo
  if FMutex = 0 then
    Abort;
  // Al terminar liberamos el objeto
  FreeOnTerminate:= TRUE;
  inherited Create(FALSE);
end;
 
destructor TProcess.Destroy;
begin
  // Cerramos el mutex
  if FMutex <> 0 then
    CloseHandle(FMutex);
end;
 
procedure TProcess.Execute;
var
  i: Integer;
  Params: TStringList;
  Uid: int64;
  Resp: AnsiString;
begin
  Params:= TStringList.Create;
  try
    Params.Delimiter:= #32;
    Params.QuoteChar:= '"';
    Params.StrictDelimiter:= TRUE;
    // Separamos cada uno de los parametros
    Params.DelimitedText:= FCmdLine;
 
    // Uid por defecto
    Uid:= -1;
    // Respuesta por defecto
    Resp:= EmptyStr;
 
    // Implementamos algunos comandos basicos (hora, fecha, echo, quit, etc ...)
    if Params.Count > 0 then
    begin
      // Si mandamos un Uid obtenemos su valor y lo separamos
      if TryStrToInt64(Params[0],Uid) then
        Params.Delete(0);
      if Params.Count > 0 then
        while TRUE do
        begin
          // Terminamos
          if AnsiSameText(Params[0],'QUIT') then
            FTerminated^:= TRUE
          // Fecha
          else if AnsiSameText(Params[0],'DATE') then
            Resp:= FormatDateTime('dd/mm/yyyy', Date) + CRLF
          // Hora
          else if AnsiSameText(Params[0],'TIME') then
            Resp:= FormatDateTime('hh:nn:ss', Time) + CRLF
          // Caracteres aleatorios
          else if AnsiSameText(Params[0],'RANDOM') then
          begin
            Resp:= EmptyStr;
            while Length(Resp) < 32  do
              Resp:= Resp + Chr(Random(94) + 33);
            Resp:= Resp + CRLF;
          // Echo
          end else if AnsiSameText(Params[0],'ECHO') then
          begin
            if Params.Count > 1 then
              Resp:= Params[1] + CRLF;
          // Delay (Retrasa otro comando X segundos)
          end else if AnsiSameText(Params[0],'DELAY') then
          begin
            if Params.Count > 2 then
            begin
              if TryStrToInt(Params[1],i) and (i<=60) then
              begin
                // Esperamos
                Sleep(i*1000);
                // Borramos los dos primeros parametros
                Params.Delete(0);
                Params.Delete(0);
                // Reconstruimos la linea de comandos
                FCmdLine:= Params.DelimitedText;
                // Volmemos a ejecutar el bucle
                Continue;
              end;
            end;
          // Podemos añadir los comandos que queramos
          end else if AnsiSameText(Params[0],'TUCOMANDO') then
          begin
            Resp:= 'TURESPUESTA' + CRLF;
          end;
          // Salimos del bucle
          break;
        end;
    end;
 
    // Si hay respuesta y no hemos terminado
    if (Resp <> EmptyStr) and not FTerminated^ then
      // Esperamos a tener el control del socket
      if WaitForSingleObject(FMutex, INFINITE) = WAIT_OBJECT_0 then
      try
        // Añadimos el Uid a la respuesta si es mayor de cero
        if Uid > 0 then
          Resp:= IntToStr(Uid) + #32 + Resp;
        // Enviamos la respuesta
        Sendto(FSocket,PAnsiChar(Resp)^,Length(Resp),0,FAddress,SizeOf(FAddress));
      finally
        // Cedemos el control del socket
        ReleaseMutex(FMutex);
      end;
  finally
    Params.Free;
  end;
 
end;
 
procedure UDPLoop(Port: Word; Terminated: PBoolean);
var
  S: TSocket;
  Addr: TSockaddr;
  AddrSize: Integer;
  FDSet: TFDSet;
  TimeVal: TTimeVal;
  Buffer: PAnsiChar;
  i: Integer;
begin
  // Creamos un socket
  S:= Winsock.Socket(AF_INET, SOCK_DGRAM, IPPROTO_IP);
  if S = INVALID_SOCKET then
    Exit;
  with Addr do
  begin
    sin_family:= AF_INET;
    sin_port:= htons(Port);
    sin_addr.s_addr:= Inet_Addr(PChar('0.0.0.0'));
  end;
  // Lo ponemos a la escucha
  if Bind(S, Addr, SizeOf(Addr)) = SOCKET_ERROR then
  begin
    // Si no podemos, cerramos el socket
    CloseSocket(S);
    // Y terminamos
    Exit;
  end;
  // Reservamos espacio para almacenar los mensajes
  GetMem(Buffer,BUFFER_SIZE);
  try
    // Bucle
    while not Terminated^ do
    begin
      TimeVal.tv_sec:= 0;
      TimeVal.tv_usec:= 500;
      FD_ZERO(FDSet);
      FD_SET(S, FDSet);
      // Comprobamos si ha recibido algun mensaje
      if Select(0, @FDSet, nil, nil, @TimeVal) > 0 then
      begin
        AddrSize:= Sizeof(Addr);
        FillChar(Buffer^,BUFFER_SIZE,#0);
        // Copiamos el mensaje en el buffer
        i:= Recvfrom(S,Buffer^,BUFFER_SIZE,0,sockaddr_in(Addr),AddrSize);
        if i <> SOCKET_ERROR then
          // Creamos un nuevo thread para procesar el mensaje
          TProcess.Create(Copy(AnsiString(Buffer),1,i),S,Addr,Terminated);
      end;
      Sleep(10);
    end;
  finally
    // Liberamos el buffer
    FreeMem(Buffer);
  end;
  // Cerramos el socket
   CloseSocket(S);
end;
 
 
var
  WSAData: TWSAData;
  Terminated: Boolean;
begin
  Randomize;
  FillChar(WSAData,SizeOf(WSAData),0);
  if WSAStartup(MAKEWORD(1, 1), WSADATA) = 0 then
  try
    try
      Terminated:= FALSE;
      // Ejectamos el bucle del servidor
      UDPLoop(61978,@Terminated);
    except
      //
    end;
  finally
    WSACleanup();
  end;
end.

Para enviar los comandos se necesita otra aplicación, yo recomiendo ncat http://nmap.org/ncat/

C:\Users\Seoane>ncat -u 127.0.0.1 61978
date
20/05/2012
time
21:09:57
echo "Hola mundo"
Hola mundo
123 echo "con uid"
123 con uid
quit

Para demostrar el funcionamiento del servidor se han implementado algunos comandos básicos, pero como se puede ver en el código es muy sencillo añadir nuevos comandos. Por ejemplo aquí dejo el mismo código de antes pero añadiendo 3 comandos que permiten controlar el volumen de los altavoces (Subir, Bajar y Mute):

program udpsrv;
 
{$APPTYPE CONSOLE}
 
uses Windows, Sysutils, Classes, Winsock;
 
 
type
  // Esta clase procesa los comandos
  TProcess = class(TThread)
  private
    FAddress: TSockaddr;
    FCmdLine: AnsiString;
    FSocket: TSocket;
    FTerminated: PBoolean;
    FMutex: THandle;
  protected
    procedure Execute; override;
  public
    constructor Create(CmdLine: AnsiString; Socket: TSocket;
      Addr: TSockaddr; Term: PBoolean);
    destructor Destroy; override;
  end;
 
const
  CR = #13;
  LF = #10;
  CRLF = CR + LF;
  BUFFER_SIZE = 64 * 1024; // 64 Kilobytes
 
  VK_VOLUME_MUTE = $AD;
  VK_VOLUME_DOWN = $AE;
  VK_VOLUME_UP = $AF;
 
procedure Pulsar(Key: Byte);
begin
 keybd_event(Key, 0, 0, 0);
 keybd_event(Key, 0, KEYEVENTF_KEYUP, 0);
end;
 
procedure SubirVolumen;
begin
  Pulsar(VK_VOLUME_UP);
end;
 
procedure BajarVolumen;
begin
  Pulsar(VK_VOLUME_DOWN);
end;
 
procedure Mute;
begin
  Pulsar(VK_VOLUME_MUTE);
end;
 
{ TProcess }
 
constructor TProcess.Create(CmdLine: AnsiString; Socket: TSocket;
  Addr: TSockaddr; Term: PBoolean);
begin
  FAddress:= Addr;
  FCmdLine:= Trim(CmdLine);
  FSocket:= Socket;
  FTerminated:= Term;
  // Creamos un mutex para evitar que dos threads utilicen el socket a la vez
  FMutex:= CreateMutex(nil,FALSE,
    PAnsiChar('{2471216C-2028-4163-AFC9-B0238E5B26EC}/' + IntToHex(Socket,8)));
  // Si no podemos crear el mutex anulamos todo
  if FMutex = 0 then
    Abort;
  // Al terminar liberamos el objeto
  FreeOnTerminate:= TRUE;
  inherited Create(FALSE);
end;
 
destructor TProcess.Destroy;
begin
  // Cerramos el mutex
  if FMutex <> 0 then
    CloseHandle(FMutex);
end;
 
procedure TProcess.Execute;
var
  i: Integer;
  Params: TStringList;
  Uid: int64;
  Resp: AnsiString;
begin
  Params:= TStringList.Create;
  try
    Params.Delimiter:= #32;
    Params.QuoteChar:= '"';
    Params.StrictDelimiter:= TRUE;
    // Separamos cada uno de los parametros
    Params.DelimitedText:= FCmdLine;
 
    // Uid por defecto
    Uid:= -1;
    // Respuesta por defecto
    Resp:= EmptyStr;
 
    // Implementamos algunos comandos basicos (hora, fecha, echo, quit, etc ...)
    if Params.Count > 0 then
    begin
      // Si mandamos un Uid obtenemos su valor y lo separamos
      if TryStrToInt64(Params[0],Uid) then
        Params.Delete(0);
      if Params.Count > 0 then
        while TRUE do
        begin
          // Terminamos
          if AnsiSameText(Params[0],'QUIT') then
            FTerminated^:= TRUE
          // Fecha
          else if AnsiSameText(Params[0],'DATE') then
            Resp:= FormatDateTime('dd/mm/yyyy', Date) + CRLF
          // Hora
          else if AnsiSameText(Params[0],'TIME') then
            Resp:= FormatDateTime('hh:nn:ss', Time) + CRLF
          // Caracteres aleatorios
          else if AnsiSameText(Params[0],'RANDOM') then
          begin
            Resp:= EmptyStr;
            while Length(Resp) < 32  do
              Resp:= Resp + Chr(Random(94) + 33);
            Resp:= Resp + CRLF;
          // Echo
          end else if AnsiSameText(Params[0],'ECHO') then
          begin
            if Params.Count > 1 then
              Resp:= Params[1] + CRLF;
          // Delay (Retrasa otro comando X segundos)
          end else if AnsiSameText(Params[0],'DELAY') then
          begin
            if Params.Count > 2 then
            begin
              if TryStrToInt(Params[1],i) and (i<=60) then
              begin
                // Esperamos
                Sleep(i*1000);
                // Borramos los dos primeros parametros
                Params.Delete(0);
                Params.Delete(0);
                // Reconstruimos la linea de comandos
                FCmdLine:= Params.DelimitedText;
                // Volmemos a ejecutar el bucle
                Continue;
              end;
            end;
          // Podemos añadir los comandos que queramos
          end else if AnsiSameText(Params[0],'SUBIR') then
          begin
            SubirVolumen;
            Resp:= 'OK' + CRLF;
          end else if AnsiSameText(Params[0],'BAJAR') then
          begin
            BajarVolumen;
            Resp:= 'OK' + CRLF;
          end else if AnsiSameText(Params[0],'MUTE') then
          begin
            Mute;
            Resp:= 'OK' + CRLF;
          end;
          // Salimos del bucle
          break;
        end;
    end;
 
    // Si hay respuesta y no hemos terminado
    if (Resp <> EmptyStr) and not FTerminated^ then
      // Esperamos a tener el control del socket
      if WaitForSingleObject(FMutex, INFINITE) = WAIT_OBJECT_0 then
      try
        // Añadimos el Uid a la respuesta si es mayor de cero
        if Uid > 0 then
          Resp:= IntToStr(Uid) + #32 + Resp;
        // Enviamos la respuesta
        Sendto(FSocket,PAnsiChar(Resp)^,Length(Resp),0,FAddress,SizeOf(FAddress));
      finally
        // Cedemos el control del socket
        ReleaseMutex(FMutex);
      end;
  finally
    Params.Free;
  end;
 
end;
 
procedure UDPLoop(Port: Word; Terminated: PBoolean);
var
  S: TSocket;
  Addr: TSockaddr;
  AddrSize: Integer;
  FDSet: TFDSet;
  TimeVal: TTimeVal;
  Buffer: PAnsiChar;
  i: Integer;
begin
  // Creamos un socket
  S:= Winsock.Socket(AF_INET, SOCK_DGRAM, IPPROTO_IP);
  if S = INVALID_SOCKET then
    Exit;
  with Addr do
  begin
    sin_family:= AF_INET;
    sin_port:= htons(Port);
    sin_addr.s_addr:= Inet_Addr(PChar('0.0.0.0'));
  end;
  // Lo ponemos a la escucha
  if Bind(S, Addr, SizeOf(Addr)) = SOCKET_ERROR then
  begin
    // Si no podemos, cerramos el socket
    CloseSocket(S);
    // Y terminamos
    Exit;
  end;
  // Reservamos espacio para almacenar los mensajes
  GetMem(Buffer,BUFFER_SIZE);
  try
    // Bucle
    while not Terminated^ do
    begin
      TimeVal.tv_sec:= 0;
      TimeVal.tv_usec:= 500;
      FD_ZERO(FDSet);
      FD_SET(S, FDSet);
      // Comprobamos si ha recibido algun mensaje
      if Select(0, @FDSet, nil, nil, @TimeVal) > 0 then
      begin
        AddrSize:= Sizeof(Addr);
        FillChar(Buffer^,BUFFER_SIZE,#0);
        // Copiamos el mensaje en el buffer
        i:= Recvfrom(S,Buffer^,BUFFER_SIZE,0,sockaddr_in(Addr),AddrSize);
        if i <> SOCKET_ERROR then
          // Creamos un nuevo thread para procesar el mensaje
          TProcess.Create(Copy(AnsiString(Buffer),1,i),S,Addr,Terminated);
      end;
      Sleep(10);
    end;
  finally
    // Liberamos el buffer
    FreeMem(Buffer);
  end;
  // Cerramos el socket
   CloseSocket(S);
end;
 
 
var
  WSAData: TWSAData;
  Terminated: Boolean;
begin
  Randomize;
  FillChar(WSAData,SizeOf(WSAData),0);
  if WSAStartup(MAKEWORD(1, 1), WSADATA) = 0 then
  try
    try
      Terminated:= FALSE;
      // Ejectamos el bucle del servidor
      UDPLoop(61978,@Terminated);
    except
      //
    end;
  finally
    WSACleanup();
  end;
end.

Y para hacer las cosas mas sencillas aun, podemos crear un programa que nos permita enviar los comando al pulsar un botón. Algo como esto:

El código del programa lo podemos resumir en esta cuatro funciones:

uses Winsock;
 
procedure EnviarMensaje(Servidor: AnsiString; Mensaje: AnsiString);
var
 WSAData: TWSAData;
 S: TSocket;
 SockAddr: TSockAddrIn;
begin
  FillChar(WSAData,SizeOf(WSAData),0);
  if WSAStartup(MAKEWORD(1, 1), WSADATA) = 0 then
  try
    S:= Socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP);
    if S <> INVALID_SOCKET then
    begin
      SockAddr.sin_family:= AF_INET;
      SockAddr.sin_addr.S_addr:= Inet_Addr(PAnsiChar(Servidor));
      SockAddr.sin_port:= htons(61978);
      Sendto(S,PAnsiChar(Mensaje)^,Length(Mensaje),0,SockAddr,SizeOf(SockAddr));
      Closesocket(S);
    end;
  finally
    WSACleanup();
  end;
end;
 
 
procedure TfrmMain.btnMasClick(Sender: TObject);
begin
  EnviarMensaje(txtServidor.Text,'SUBIR');
end;
 
procedure TfrmMain.btnMenosClick(Sender: TObject);
begin
  EnviarMensaje(txtServidor.Text,'BAJAR');
end;
 
procedure TfrmMain.btnMuteClick(Sender: TObject);
begin
  EnviarMensaje(txtServidor.Text,'MUTE');
end;

Como veis el servidor se puede adaptar para realizar multitud de tareas, desde controlar el volumen hasta apagar el ordenador de forma remota. Por cierto, si no queréis que se muestre la pantalla negra de la consola solo tenéis que comentar o eliminar la linea {$APPTYPE CONSOLE} y el servidor permanecerá oculto mientras se ejecuta. Seguro que así se os ocurren mas posibilidades, como volver loco a vuestro compañero de trabajo jugando con el volumen de sus altavoces, jejeje

Comentarios

Hola Domingo,
Como siempre, y como nos tienes acostumbrados, ¡te pasas!
Tus ejemplos aportan un buen rato más para molestar a amigos del curro, y también para llevarlo a cosas más prácticas... ¡como molestar al jefe! XD jaja. Fuera de bromas, esto se tiene que ir a la biblioteca de código que seguro nos va a servir a más de uno.

Saludos,