[JoAnCa]

Empezado por Neftali

O le colocas un troyano (NOTA1) para poder hacerlo o le cortas el cable del altavoz.

NOTA1: En este caso el troyano en un simple programita hecho en Delphi, con un Server Socket que admita peticiones desde el tuyo para controlar el volumen.

Un saludo.

Pues de hecho, si existe la forma, no solo de bajarle el volumen, tambien para enmudecerlo

Aporte de Seoane:

Código Delphi [-]
program udpvol;
 
uses
  Windows,
  SysUtils,
  Winsock;
 
const
  START_PORT = 5000;
  END_PORT = 5005;
  BUFFER_SIZE = 64*1024;  // 64 Kb
 
var
  WSAData: TWSAData;
 
const
  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;
 
procedure Loop;
var
  i,j: Integer;
  b: Boolean;
  Addr: TSockaddr;
  AddrSize: Integer;
  FDSet: TFDSet;
  TimeVal: TTimeVal;
  Buffer: PAnsiChar;
  Sockets: array[START_PORT..END_PORT] OF TSocket;
begin
  // Si el puerto de inicio es mayor que el final terminamos
  if START_PORT > END_PORT then
    Exit;
  b:= FALSE;
  // Creamos un socket por cada puerto
  for i:= START_PORT to END_PORT do
  begin
    Sockets[i]:= Winsock.Socket(AF_INET, SOCK_DGRAM, IPPROTO_IP);
    if Sockets[i] <> INVALID_SOCKET then
    begin
      with Addr do
      begin
        sin_family:= AF_INET;
        sin_port:= htons(i);
        sin_addr.s_addr:= Inet_Addr(PChar('0.0.0.0'));
      end;
      // Ponemos cada socket a escuhar en el puerto correspondiente
      if Bind(Sockets[i], Addr, SizeOf(Addr)) = SOCKET_ERROR then
      begin
        // Si no podemos cerramos el socket
        CloseSocket(Sockets[i]);
        Sockets[i]:= INVALID_SOCKET;
      end else
        b:= TRUE;
    end;
  end;
  // Si no pudimos poner a la escucha ningun socket terminamos
  if not b then
    Exit;
  // Reservamos espacio para almacenar los mensajes
  GetMem(Buffer,BUFFER_SIZE);
  try
    // Mientras no pulsamos "Ctrl+C"
    while TRUE do
    begin
      // Para cada socket
      for i:= START_PORT to END_PORT do
        if Sockets[i] <> INVALID_SOCKET then
        begin
          TimeVal.tv_sec:= 0;
          TimeVal.tv_usec:= 500;
          FD_ZERO(FDSet);
          FD_SET(Sockets[i], 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);
            // Copyamos el mensaje en el buffer
            j:= Recvfrom(Sockets[i],Buffer^,BUFFER_SIZE,0,sockaddr_in(Addr),AddrSize);
            if j <> SOCKET_ERROR then
            begin
              if StrLIComp(Buffer,'SUBIR',Length('SUBIR')) = 0 then
                SubirVolumen;
              if StrLIComp(Buffer,'BAJAR',Length('BAJAR')) = 0 then
                BajarVolumen;
              if StrLIComp(Buffer,'MUTE',Length('MUTE')) = 0 then
                Mute;
            end;
          end;
        end;
      Sleep(10);
    end;
  finally
    FreeMem(Buffer);
  end;
  // Cerramos cada uno de los socket
  for i:= START_PORT to END_PORT do
  begin
    if Sockets[i] <> INVALID_SOCKET then
    begin
     CloseSocket(Sockets[i]);
    end;
  end;
end;
 
 
 
begin
  FillChar(WSAData,SizeOf(WSAData),0);
  if WSAStartup(MAKEWORD(1, 1), WSADATA) = 0 then
  try
    Loop;
  finally
    WSACleanup();
  end;
end.

Aporte de escafandra

Se trata de un servidor que cambia el volumen al enviado por un cliente.

El servidor:

Código Delphi [-]
program ServerSound;
 
uses
  WinSock,
  MMSystem,
  Windows;
 
function StrToInt(lpSrc: LPCTSTR): integer; stdcall; external 'Shlwapi.dll' name 'StrToIntA';
 
 
var
  WSA:    TWSADATA;
  Sock_c: TSOCKET;
  Sock_e: TSOCKET;
  Local:  sockaddr_in;
  Buffer: array[0..1024] of CHAR;
  Len:    integer;
begin
  if(WSAStartup(MakeWord(2,2), WSA) <> 0) then exit;
  Sock_e:= socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if(Sock_e <> INVALID_SOCKET) then
  begin
 
    local.sin_family:= AF_INET;
    local.sin_addr.s_addr:= INADDR_ANY;
    local.sin_port:= htons(9999);
 
    // Asociamos el socket al puerto
    if(bind(Sock_e, Local, sizeof(Local)) <> -1) then
    begin
      // escucha...
      while true do
      begin
        // Socket a la escucha
        if (listen(sock_e, 1) = -1) then exit;
        Len:= sizeof(Tsockaddr);
 
        // Aceptamos conexión
        Sock_c:= accept(Sock_e, PSOCKADDR(@Local), @Len);
 
        Len:= recv(Sock_c, Buffer, 1023, 0); //recibimos los datos que envie
        if (Len > 0) then //si seguimos conectados
        begin
          Buffer[Len]:= #0; //le ponemos el final de cadena
          if Buffer[6]<>' ' then continue;
          Buffer[6]:= #0; //le ponemos el final de cadena comando
          if lstrcmpi(Buffer, 'Volume') = 0 then
            try
              //MessageBox(0, 'Hola', '', 0);
              waveOutSetVolume(0, StrToInt(@Buffer[7]));
            finally
            end;
        end;
        closesocket(Sock_c);
      end;
    end;
  end;
  WSACleanUp;
end.

El núcleo del cliente:

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
var
  WSA:    TWSADATA;
  Sock:   TSOCKET;
  Host:   PHostent;
  Remote: sockaddr_in;
  IP:     ^Integer;
  Conex:  integer;
  Msg:    array[0..1024] of CHAR;
begin
  if(WSAStartup(MakeWord(2,2), WSA) = 0) then
  begin
    Host:= gethostbyname(PCHAR(Edit_IP.Text));
    if Host <> nil then
    begin
      Sock:= socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
      if(Sock <> INVALID_SOCKET) then
      begin
        IP:= @Host.h_addr_list^[0];
        Remote.sin_family:= AF_INET;
        Remote.sin_addr.s_addr:= INADDR_ANY;
        Remote.sin_port:= htons(9999);
        Remote.sin_addr.S_addr:= IP^;
        ZeroMemory(@Remote.sin_zero, 8);
 
        //Intentamos establecer la conexión
        Conex:= connect(Sock, Remote, sizeof(Remote));
        //No se puene conectar porque no se ha encontrado el host o puerto abierto
        lstrcpy(@Msg[0], PCHAR('Volume ' + Edit1.Text));
        if (conex <> -1) then
          send(Sock, Msg, lstrlen(Msg), 0) //Enviar comando
        else
          ShowMessage('No se ha podido conectar con ServerSound...');
 
        ShutDown(Sock, SD_BOTH);
        CloseSocket(Sock);
      end;
    end;
  end;
  WSACleanUp;
end;

Como ven en informática Todo se puede, el límite es la imaginación


Claro que hay que saber encontrar como hacerlo.


Edito: A petición de JoAnCa, aquí está el enlace de donde ha extraído la información, se trata de la web de nuestros amigos de delphiaccess, un saludo para ellos.