1

En Delphi, tengo claro como

Buscar dispositivos, emparejarlos, ver los emparejados y desemparejarlos. También es sencillo, conectar con una impresora Bluetooth y por socket mandarle cosas a imprimir. Pero no encuentro nada sobre lo siguiente

Una cosa es ver los dispositivos emparejados y otra los conectados. Centrándonos en los altavoces. Tengo tres dispositivos emparejados

ALTAVOZ1 Emparejado

ALTAVOZ2 Emparejado

ALTAVOZ3 Música Conectada

y el sonido se escucha por el ALTAVOZ3

Quiero poder desde Delphi, cambiar y que en vez de ser ALTAVOZ3 el que tenga 'Música conectada' sea ALTAVOZ2 por ejemplo. Yo puedo cargar en un TMEMO los dispositivos Emparejados y me saldrá ALTAVOZ1 ALTAVOZ2 ALTAVOZ3

Pero quiero saber cual de los tres está en modo 'Musica Conectada' y cómo puedo cambiarlo.

Gracias

    uses
     System.Bluetooth, System.Bluetooth.Components, System.Classes, 
     System.SysUtils, Vcl.Dialogs, System.UITypes;

    Var
    FSocket: TBluetoothSocket;
    FBluetoothManager: TBluetoothManager;
    FDiscoverDevices: TBluetoothDeviceList;
    FPairedDevices: TBluetoothDeviceList;
    FAdapter: TBluetoothAdapter;
// Inicializa Componentes y devuelve la lista de dispositivos
procedure Conectar(Var Device1: TStringList; Var Res: Boolean);
begin
   Device1:= TStringList.Create;
    FBluetoothManager := TBluetoothManager.Current;
    FAdapter := FBluetoothManager.CurrentAdapter;
    if ManagerConnected then Begin
      PairedDevices(Device1);
      Res:= True;
    End;
end;
// Buscar Dsipositivos emparejados
procedure PairedDevices(Var Device2: TStringList);
var I: Integer;
begin
  Device2:= TStringList.Create;
  if ManagerConnected then begin
    FPairedDevices := FBluetoothManager.GetPairedDevices;
    if FPairedDevices.Count > 0 then for I:= 0 to FPairedDevices.Count - 1 
  do  Device2.Add(FPairedDevices[I].DeviceName)
      else Device2.Add('No Paired Devices');
  End else Device2.Add('No Paired Devices');
end;
// Comprueba si esta activo el Bluetooh
function ManagerConnected:Boolean;
begin
    FBluetoothManager := TBluetoothManager.Current;
    FAdapter := FBluetoothManager.CurrentAdapter;
  if FBluetoothManager.ConnectionState = 
 TBluetoothConnectionState.Connected then Result := True else Result:= 
False;
end;
{ Esta funcion es la que curiosamente me conecta el dispositivo y lo hace, a pesar de que FSocket.Connect da error. Pero luego no tengo ningún control para poder desconectar y conectarme a otro dispositivo.
Los servicios que tiene son
 A2DP SNK Service
 A2DP SRC Service
 A/V Remote Control
 A/V Remote Control Target
y activo el FSocket dando la UUID del primer servicio
} 
function ConnectDisp(ANomeDevice: String): Boolean;
Var lDevice: TBluetoothDevice;
    LServices: TBluetoothServiceList;
    Estado: TBluetoothDeviceState;
    i: Integer; Dv: Boolean;
begin
    Result := False;
    lDevice := ObtenerDevice(ANomeDevice);
    if (Assigned(LDevice)) then Begin
      if NOT (Assigned(FSocket)) then Begin
        LServices := LDevice.GetServices;
        FSocket := LDevice.CreateClientSocket(LServices[0].UUID, True);
      End;
      Try
        FSocket.Connect;
      Except

      End;
    End;
end;
// Esta función realmente no hace nada. No funciona
Function DesConnectDisp: Boolean;
Begin
    if (Assigned(FSocket)) then Begin
      FreeAndNil(FSocket);
    //  FSocket.Close;

    End;
End;
// Requerido por ConectarImpresora
function ObtenerDevice(ANomeDevice: String): TBluetoothDevice;
var
  lDevice: TBluetoothDevice;
begin
  Result := nil;
  for lDevice in FBluetoothManager.GetPairedDevices do if lDevice.DeviceName = ANomeDevice then Result := lDevice;
end;
1
  • Agrega el codigo que hayas realizados. tu pregunta me parece que es muy grande y deberias acotarla. Commented el 25 ene. 2021 a las 23:56

1 respuesta 1

1

En esta dirección

https://itectec.com/superuser/scripting-connecting-disconnecting-a-paired-bluetooth-device/

está la solución en el programa btcom.exe.

El tratamiento más o menos es:

Uses  System.Bluetooth, ShellApi, Winapi.Messages, AdvPanel;
//------------------------------------------------------------------------------
// ************** Procedimiento que Escanea Dispositivos Bluetooth *************
//------------------------------------------------------------------------------
procedure TForm1.DiscoveryD;
Var i: Integer;
begin
  FBluetoothManager := TBluetoothManager.Current;
  FAdapter := FBluetoothManager.CurrentAdapter;
  if FBluetoothManager.ConnectionState = TBluetoothConnectionState.Connected then Begin
    FPairedDevices := FBluetoothManager.GetPairedDevices;
  end;
end;
//------------------------------------------------------------------------------
// ************** Gestion de la selección de elementos *************************
//------------------------------------------------------------------------------
procedure TForm1.b01click(Sender: TObject);
Var i, n, w: Integer; iUID: String;
begin
 If BotonAltavoz.Down Then Begin
    i := (Sender as TAdvPanel).Tag;
    if FBluetoothManager.ConnectionState = TBluetoothConnectionState.Connected  then Begin
      iUID:= FPairedDevices[i].Address;
      n:= 0;
      if (Sender As TAdvPanel).ColorTo = BotonCogido then Begin  // BotonCogido esta en verde que significa que está activo
        EjecutaExterno(iUID, '110B', '-r'); // Desactivo los servicios
        EjecutaExterno(iUID, '110E', '-r');
        DiscoveryD; // Al parar los servicios, debo volver a leer los dispositivos emparejados, ya que cambia el orden
        w:= Damei(iUID);
        while (FPairedDevices[w].State = TBluetoothDeviceState.Connected) AND (n < 15) do begin
         Sleep(2000);
         DiscoveryD;
         w:= Damei(iUID);
         Inc(n);
        end;
      End Else Begin // Si el color no es BotonCogido Activo los servicios
        EjecutaExterno(iUID, '110E', '-c');
        EjecutaExterno(iUID, '110B', '-c');
        DiscoveryD;
        w:= Damei(iUID);
        while (FPairedDevices[w].State = TBluetoothDeviceState.Paired) AND (n < 15) do begin
         Sleep(2000);
         DiscoveryD;
         w:= Damei(iUID);
         Inc(n);
        end;
End;

      if NOT (N < 15) then Begin
        PanelMensaje.Caption:= '***** ERROR GESTIONANDO BLUETOOTH *****';
        Sleep(5000);
      End;
End;

//------------------------------------------------------------------------------
// ************** Ejecuta BTCOM para gestionar el BLUETOOTH ********************
//------------------------------------------------------------------------------
procedure TForm1.EjecutaExterno(DEVICE_ADDRESS, SERVICE_UUID, BTCOM_TIPE: STring);
var h: HWND; Folder, Comando, Parametros: String;
begin
    Folder := ExtractFilePath(Application.ExeName);
    Comando:= 'BtCom.exe';
    Parametros:= BTCOM_TIPE + ' -b"' + DEVICE_ADDRESS + '" -s' + SERVICE_UUID;
    ShellExecute(Handle, 'Open', PWideChar(Comando), PWideChar(Parametros), PWideChar(Folder), SW_HIDE);
    sleep(3000);
    h := FindWindow(nil, 'BtCom'); // Hago un bucle esperando que termine el programa Btcom
    while h <> 0 do Begin
      Sleep(3000);
      h := FindWindow(nil, 'BtCom');
    End;
end;


//------------------------------------------------------------------------------
// ************** Calcula el componente BLUETOOTH según su dirección MAC *******
//------------------------------------------------------------------------------
function  TForm1.Damei(Id: String): Integer;
VAr i: Integer;
Begin
  Result:= -1;
  for I := 0 to FPairedDevices.Count -1 do Begin
    if FPairedDevices.Items[i].address = Id then Begin
      Result:= I;
      Exit;
    End;
  End;
End;

Y esto me permite conectar y desconectar los diferentes altavoces inalámbricos que tengo emparejados. En

i := (Sender as TAdvPanel).Tag; 

TAdvPanel corresponde a un componente de TMSSoftware.

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.