Delphi 蓝牙 LE 心率配置文件访问

Question

我正在关注 Delphi 测试项目以从蓝牙设备读取数据，该设备实现 心率服务。所以...对于测试项目来说，这是一个完美的选择。

不幸的是，在发现每个服务时 Bluetooth1.DiscoverServices(adev) 抛出设备需要配对的异常。 此外，如果我不发出命令，蓝牙 LE 设备的服务数组为空 （仅填写广告列表）。

所以...我无法配对此设备，而且据我所知，我不需要在 BT LE 中进行配对 - 那么为什么会出现这种异常，否则我该如何获得服务呢？

此外，永远不会调用 OnEndDiscoverDevices - 只有当我取消发现过程时才会调用该事件

这里是完整的代码：

unit ufrmBTLETest;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Bluetooth, Vcl.StdCtrls,
  System.Bluetooth.Components, Vcl.ComCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    BTLE: TBluetoothLE;
    memLog: TMemo;
    tvDevices: TTreeView;
    timCancel: TTimer;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure BTLEDiscoverLEDevice(const Sender: TObject;
      const ADevice: TBluetoothLEDevice; Rssi: Integer;
      const ScanResponse: TScanResponse);
    procedure BTLEServicesDiscovered(const Sender: TObject;
      const AServiceList: TBluetoothGattServiceList);
    procedure BTLEServiceAdded(const Sender: TObject;
      const AService: TBluetoothGattService;
      const AGattStatus: TBluetoothGattStatus);
    procedure BTLEEndDiscoverDevices(const Sender: TObject;
      const ADeviceList: TBluetoothLEDeviceList);
    procedure BTLEEndDiscoverServices(const Sender: TObject;
      const AServiceList: TBluetoothGattServiceList);
    procedure timCancelTimer(Sender: TObject);
    procedure tvDevicesClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

uses
  System.StrUtils, System.Generics.Collections;

{$R *.dfm}

const HRSERVICE: TBluetoothUUID = '{0000180D-0000-1000-8000-00805F9B34FB}';
      HRMEASUREMENT_CHARACTERISTIC: TBluetoothUUID  = '{00002A37-0000-1000-8000-00805F9B34FB}';


function bytesToStr( aval : TBytes ) : string;
var i : integer;
begin
     for i := 0 to Length(aval) do
         Result := Result + IntToHex(aval[i], 2);
end;

procedure TForm1.BTLEDiscoverLEDevice(const Sender: TObject;
  const ADevice: TBluetoothLEDevice; Rssi: Integer;
  const ScanResponse: TScanResponse);
var
  i: Integer;
  arr : TArray<TPair<TScanResponseKey, TBytes>>;

begin
     memLog.Lines.Add('Discovered: ' + ADevice.Identifier);
     memLog.Lines.Add('Name: ' + ADevice.DeviceName);

     arr := scanResponse.ToArray;
     for i := 0 to Length(arr) - 1 do
     begin
          memLog.Lines.Add(Format('Resp %d, %d, %s',[i, Integer(arr[i].Key), BytesToSTr( arr[i].Value )]));
     end;
end;

procedure TForm1.BTLEEndDiscoverDevices(const Sender: TObject;
  const ADeviceList: TBluetoothLEDeviceList);
var i, j: Integer;
    ti : TTreeNode;
    aDev : TBluetoothLEDevice;
    ser : TBluetoothGattService;
begin
     for i := 0 to ADeviceList.Count - 1 do
     begin
          aDev := ADeviceList[i];
          if true then //aDev.DeviceName = 'medilogHR' then
          begin
               ti := tvDevices.Items.AddChild(nil, ifthen( aDev.DeviceName = '', aDev.Identifier, aDev.DeviceName));
          end;
     end;
end;

procedure TForm1.BTLEEndDiscoverServices(const Sender: TObject;
  const AServiceList: TBluetoothGattServiceList);
begin
     memLog.Lines.Add('Services ended:' + AServiceList.Count.ToString);
end;

procedure TForm1.BTLEServiceAdded(const Sender: TObject;
  const AService: TBluetoothGattService;
  const AGattStatus: TBluetoothGattStatus);
begin
     memlog.Lines.Add('Service added: ' + AService.UUIDName);
     memLog.Lines.Add('Gatt: ' + IntToStr(Integer(agattStatus)));
end;

procedure TForm1.BTLEServicesDiscovered(const Sender: TObject;
  const AServiceList: TBluetoothGattServiceList);
begin
     memLog.Lines.Add('Service Discovered');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     tvDevices.Items.Clear;
     timCancel.Interval := 18000;
     if BTLE.DiscoverDevices(timCancel.Interval, [HRSERVICE]) then 
        timCancel.Enabled := True;
end;

procedure TForm1.Button2Click(Sender: TObject);
const
  HeartRateService: TGUID = '{0000180D-0000-1000-8000-00805F9B34FB}';
var
  ABLEAdvertisedDataFilter: TBluetoothLEScanFilter;
  ABLEAdvertisedDataFilterList: TBluetoothLEScanFilterList;
begin
  ABLEAdvertisedDataFilter:= TBluetoothLEScanFilter.Create;
  ABLEAdvertisedDataFilterList:= TBluetoothLEScanFilterList.Create;
  ABLEAdvertisedDataFilter.ServiceUUID:= HeartRateService; 
  ABLEAdvertisedDataFilterList.Add(ABLEAdvertisedDataFilter);

  timCancel.Interval := 18000;
  btle.CurrentManager.StartDiscovery(18000,ABLEAdvertisedDataFilterList);
  timCancel.Enabled := True;
end;

procedure TForm1.timCancelTimer(Sender: TObject);
begin
     timCancel.Enabled := False;
     btle.CancelDiscovery;

end;

procedure TForm1.tvDevicesClick(Sender: TObject);
var aDev : TBluetoothLEDevice;
    j : integer;
    scanResp : TScanResponse;
    arr : TArray<TPair<TScanResponseKey, TBytes>>;
begin
     if tvDevices.Items.Count > 0 then
     begin
          for aDev in btle.CurrentManager.AllDiscoveredDevices do
          begin
               if aDev.Paired then
               begin
                    timcancel.enabled := True;
                    aDev.DiscoverServices;
               end
               else
               begin
                    arr := aDev.AdvertisedData.ToArray;
                    for j := 0 to Length(arr) - 1 do
                    begin
                          memlog.Lines.Add(IntToStr( integer(arr[j].Key) )+ ': ' + bytesToStr(arr[j].Value));
                    end;                                                   
               end;
          end;
     end;
end;

end.

表单数据：

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 415
  ClientWidth = 514
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 8
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Scan'
    TabOrder = 0
    OnClick = Button1Click
  end
  object memLog: TMemo
    Left = 16
    Top = 272
    Width = 490
    Height = 135
    Lines.Strings = (
      'memLog')
    TabOrder = 1
  end
  object tvDevices: TTreeView
    Left = 16
    Top = 39
    Width = 490
    Height = 227
    Indent = 19
    TabOrder = 2
    OnClick = tvDevicesClick
  end
  object Button2: TButton
    Left = 112
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Button2'
    TabOrder = 3
    OnClick = Button2Click
  end
  object BTLE: TBluetoothLE
    Enabled = True
    OnDiscoverLEDevice = BTLEDiscoverLEDevice
    OnServicesDiscovered = BTLEServicesDiscovered
    OnEndDiscoverDevices = BTLEEndDiscoverDevices
    OnEndDiscoverServices = BTLEEndDiscoverServices
    OnServiceAdded = BTLEServiceAdded
    Left = 440
    Top = 40
  end
  object timCancel: TTimer
    Enabled = False
    OnTimer = timCancelTimer
    Left = 384
    Top = 40
  end
end

我正在使用 Delphi 10.3 更新 3 我在这里的基本误解是什么？

Answer 1

在搜索了德国 Delphi 网站后，我发现了很多类似的问题。简而言之，Delphi 10.3 不支持正确（不再需要配对）并且已经提交了 QC。希望在 10.4 中有所改变。

更新： 我编辑了 System.Win.BluetoothWinRT，使得“无配对”状态也可以按照微软蓝牙文件示例的 c# 实现来查询服务。

1) 将 TWinRTBluetoothLEDevice.CheckInitialized 更改为

  // the exception was the old code...
  if FId = 0 then
    begin
      //raise EBluetoothDeviceException.Create(SBluetoothLEDeviceNotPaired);

      if TAsyncOperation<IAsyncOperation_1__IBluetoothLEDevice>.Wait(
        TBluetoothLEDevice.Statics.FromBluetoothAddressAsync(FAddress), LBLEDeviceAsyncOp) = AsyncStatus.Completed then
      begin
        FBluetoothLEDevice := LBLEDeviceAsyncOp.GetResults;
        FClosed := False;
        if DeviceName = '' then
          FDeviceName := FBluetoothLEDevice.Name.ToString;
        FConnectionStatusChangeDelegate := TConnectionStatusChangeEventHandler.Create(Self);
        FBluetoothLEDevice.add_ConnectionStatusChanged(FConnectionStatusChangeDelegate);
exit;
      end;

以及 DoDiscoverService 的一部分

var
  I: Integer;
  LGattService: GenericAttributeProfile_IGattDeviceService;
  dev3 : IBluetoothLEDevice3;
  res3 : IAsyncOperation_1__GenericAttributeProfile_IGattDeviceServicesResult;
  serviceRes : GenericAttributeProfile_IGattDeviceServicesResult;
  LGattServices: IVectorView_1__GenericAttributeProfile_IGattDeviceService;
begin
  Result := True;
  FServices.Clear;
  CheckInitialized;
  if FID = 0 then
  begin
      dev3 := fBluetoothLEDevice as IBluetoothLEDevice3;

      if dev3 = nil then
         raise EBluetoothDeviceException.Create(SBluetoothLEDeviceNotPaired);

      if TAsyncOperation<IAsyncOperation_1__GenericAttributeProfile_IGattDeviceServicesResult>.Wait(

         dev3.GetGattServicesAsync(BluetoothCacheMode.Uncached), res3 ) = AsyncStatus.Completed then 
      begin
           serviceRes := res3.GetResults;

           LGattServices := serviceRes.Services;

           for I := 0 to LGattServices.Size - 1 do
           begin
                LGattService := LGattServices.GetAt(I);
                FServices.Add(TWinRTBluetoothGattService.Create(Self, LGattService, TBluetoothServiceType.Primary));
           end;
      end; 
  end

在 TWinRTBluetoothGattService.DoGetCharacteristics 和 TWinRTBluetoothGattCharacteristic.DoGetDescriptors 函数。

DoGetCharacteristics 函数的扩展：

var
  I: Integer;
  LGattCharacteristics: IVectorView_1__GenericAttributeProfile_IGattCharacteristic;
  charactRes : GenericAttributeProfile_IGattCharacteristicsResult;
  service3 : GenericAttributeProfile_IGattDeviceService3;
  characteristics3 : IAsyncOperation_1__GenericAttributeProfile_IGattCharacteristicsResult;
begin
  CheckNotClosed;
  FCharacteristics.Clear;

  if FDevice.FId = 0 then
  begin
       service3 := FGattService as GenericAttributeProfile_IGattDeviceService3;

       if TAsyncOperation<IAsyncOperation_1__GenericAttributeProfile_IGattCharacteristicsResult>.Wait(
                        service3.GetCharacteristicsAsync(BluetoothCacheMode.Uncached), characteristics3 ) = AsyncStatus.Completed then 
       begin
            charactRes := characteristics3.GetResults;    
            LGattCharacteristics := charactRes.Characteristics;
            if LGattCharacteristics.Size > 0 then
               for I := 0 to LGattCharacteristics.Size - 1 do
                   FCharacteristics.Add(TWinRTBluetoothGattCharacteristic.Create(Self, LGattCharacteristics.GetAt(I)));
       end;
  end

//old code

对 dogetdescriptors 函数的扩展（注意这个函数不能完美地执行必要的检查...）

var
  LGattDescriptors: IVectorView_1__GenericAttributeProfile_IGattDescriptor;
  I: Integer;
  characteristic3 : GenericAttributeProfile_IGattCharacteristic3;
  descriptorRes3 : IAsyncOperation_1__GenericAttributeProfile_IGattDescriptorsResult;
  descrRes : GenericAttributeProfile_IGattDescriptorsResult;
begin
  FDescriptors.Clear;
  LGattDescriptors := (FGattCharacteristic as GenericAttributeProfile_IGattCharacteristic2).GetAllDescriptors;
  if LGattDescriptors.Size > 0 then
  begin
       for I := 0 to LGattDescriptors.Size - 1 do
           FDescriptors.Add(TWinRTBluetoothGattDescriptor.Create(Self, LGattDescriptors.GetAt(I)));
  end
  else
  begin
       characteristic3 := FGattCharacteristic as GenericAttributeProfile_IGattCharacteristic3;

       if TAsyncOperation<IAsyncOperation_1__GenericAttributeProfile_IGattDescriptorsResult>.Wait(
                        characteristic3.GetDescriptorsAsync(BluetoothCacheMode.Uncached), descriptorRes3 ) = AsyncStatus.Completed then 
       begin
            descrRes := descriptorRes3.GetResults;    
            LGattDescriptors := descrRes.Descriptors;
            for I := 0 to LGattDescriptors.Size - 1 do
                FDescriptors.Add(TWinRTBluetoothGattDescriptor.Create(Self, LGattDescriptors.GetAt(I)));
       end;

  end;
  Result := FDescriptors;
end;