Windows 11 und Bluetooth LE

[Graw]

Hallo,

ich suche nun schon lange nach einem passendem Beispiel für eine Bluetooth LE Verbindung mit Windows 11.

Ich will die Characteristics abfragen und die dazugehörenden Values.

Kann mir hier jemand weiterhelfen?

[himitsu]

Hast du die Delphi-Demos nicht installiert?
C:\Users\Public\Documents\Embarcadero\Studio\22.0\Samples\

Ich würde doch mal schauen, ob sich was findet.
Und dann hat Emba auch so einige Videos auf Youtube
und in der Hilfe sind zu einigen Kompnenten auch Demos verlinkt.

z.B.
C:\Users\Public\Documents\Embarcadero\Studio\22.0\Samples\Object Pascal\Multi-Device Samples\Device Sensors and Services\Bluetooth\...



oder Delphi neu installieren

oder Tools -> Platformen verwalten -> Samples anhaken und installieren

oder z.B. https://github.com/Embarcadero/RADStudio12Demos
RADStudio12Demos\Object Pascal\Multi-Device Samples\Device Sensors and Services\Bluetooth\Beacons\...

[Graw]

Hallo himitsu,

mit den Beispielen habe ich schon probiert.
Leider ist kein Beispiel unter Windows funktionstüchtig.

Mein Hauptaugenmerk liegt da auf "ExploreDevicesLE" und "BLEScanner".

Das Suchen der Geräte funktioniert noch.
Aber sobald ich bei ExploreDevicesLE auf Get klicke oder beim BLEScanner ein Device auswähle, frieren beide Anwendungen ein und müssen über den Taskmanager beendet werden.

Die neusten Versionen von github habe ich auch getestet.

[philipp.hofmann]

Ich habe ExploreDevicesLE gerade bei mir mal getestet, allerdings Windows 10. Da läuft es problemlos. War die Win32-Debug-Variante. Aber ich weiß, dass bei der Iteration durch Characteristics eines Service wichtig ist, dass dies nicht im Hauptthread passiert. Dies kann zu Hängenbleibern führen. Ich habe jetzt nicht gecheckt, wie das Beispiel es macht.

[Graw]

Das ist ja interessant.
Wenn auf Get geklickt wird, hängt es sich nicht auf?

Kann es an meiner Hardware liegen?

[philipp.hofmann]

Ja, beim Klick auf "Get services" hängt es sich nicht auf. Aber es kann gut sein, dass du einen Thread um die Funktion ServicesDiscovered bauen musst. Dies scheint mir in dem Beispiel falsch zu sein.

Probiere mal diese Anpassung:

Delphi-Quellcode:

procedure TFrDeviceExplorer.ServicesDiscovered(const Sender: TObject; const AServiceList: TBluetoothGattServiceList);
begin
  TThread.CreateAnonymousThread(
  procedure()
  var
  I: Integer;
  CharList: TBluetoothGattCharacteristicList;
  AChar: TBluetoothGattCharacteristic;
  J: Integer;
  CurrentRow: Integer;
  Options: string;
  ServiceItem, Characteristic, CharProps: TTreeViewItem;
  begin
    TvCharacteristics.Clear;
    for I := 0 to AServiceList.Count - 1 do
    begin
      ServiceItem := TTreeViewItem.Create(nil);
      ServiceItem.Parent := TvCharacteristics;
      ServiceItem.Tag := I;
      ServiceItem.IsExpanded := True;
      if AServiceList[I].UUIDName.IsEmpty then
        ServiceItem.Text := 'Unnamed'
      else
        ServiceItem.Text := AServiceList[I].UUIDName;
      CharList := AServiceList[I].Characteristics;
      for J := 0 to CharList.Count - 1 do
      begin
        AChar := CharList[J];
        TThread.Synchronize(nil, procedure begin
          Options := '';
          if TBluetoothProperty.Broadcast in AChar.Properties then Options := Options + 'Broadcast ';
          if TBluetoothProperty.ExtendedProps in AChar.Properties then Options := Options + 'ExtendedProps ';
          if TBluetoothProperty.Notify in AChar.Properties then Options := Options + 'Notify ';
          if TBluetoothProperty.Indicate in AChar.Properties then Options := Options + 'Indicate ';
          if TBluetoothProperty.Read in AChar.Properties then Options := Options + 'Read ';
          if TBluetoothProperty.Write in AChar.Properties then Options := Options + 'Write ';
          if TBluetoothProperty.WriteNoResponse in AChar.Properties then Options := Options + 'WriteNoResponse ';
          if TBluetoothProperty.SignedWrite in AChar.Properties then Options := Options + 'SignedWrite ';
          Characteristic := TTreeViewItem.Create(nil);
          Characteristic.Parent := ServiceItem;
          Characteristic.IsExpanded := False;
          if AChar.UUIDName.IsEmpty then
            Characteristic.Text := 'Unnamed'
          else
            Characteristic.Text := AChar.UUIDName;
          Characteristic.Tag := J;
          CharProps := TTreeViewItem.Create(nil);
          CharProps.Tag := -1;
          CharProps.Parent := Characteristic;
          CharProps.IsExpanded := True;
          CharProps.Text := GUIDToString(AChar.UUID);
          CharProps := TTreeViewItem.Create(nil);
          CharProps.Tag := -1;
          CharProps.Parent := Characteristic;
          CharProps.IsExpanded := True;
          CharProps.Text := Options;
        end);
        Application.ProcessMessages;
      end;
    end;
    tmAnimateFindServices.Enabled := False;
    PbServices.Value := 100;
  end).Start;
end;

D.h. übertragen auf das Beispiel müsste es