德尔福蓝牙 LE 心率配置文件访问

Question

我遵循德尔福测试项目，从实现 心率服务。所以。。。人们会认为非常适合测试项目。

不幸的是，当涉及到发现每个服务 蓝牙1.发现服务(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

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

Answer 1

在搜索德国德尔菲网站后，我发现了不少类似的问题。简而言之，德尔福 10.3 不能正确支持这一点(不再需要配对(，并且已经提交了 QC。希望在 10.4 中有所改变。

更新： 我编辑了System.Win.BluetoothWinRT，以便"无配对"状态也可以按照Microsoft蓝牙的C#实现来查询服务。

1( 将 TWinRTBluetoothLEDevice.CheckInitializeded 更改为

// 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;

和部分 DoDiscovery Service 到

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.DoGetFeatures和 TWinRTBluetoothGattCharacteristic.DoGetDescriptors functions.

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;