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,
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,