powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Delphi 10.2, BluetoothLE, не работает SubscribeToCharacteristic
6 сообщений из 6, страница 1 из 1
Delphi 10.2, BluetoothLE, не работает SubscribeToCharacteristic
    #39470235
t-vadim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Имеется BluetoothLE устройство с сервисом UsrUartSvcUUID:TBluetoothUUID= '{0003cdd0-0000-1000-8000-00805f9b0131}';
и характеристиками
UsrUartNotifyChrUUID:TBluetoothUUID='{0003cdd1-0000-1000-8000-00805f9b0131}'; // Получение данных из UART BluetoothLE модуля
UsrUartWriteChrUUID:TBluetoothUUID= '{0003cdd2-0000-1000-8000-00805f9b0131}'; // Запись данных в UART BluetoothLE модуля

У характеристики UsrUartNotifyChrUUID есть еще дескриптор
UsrDesc: TBluetoothUUID = '{20003D9C-0000-0000-0000-000020002902}';
Нужно читать и писать данные из/в UART(а) BluetoothLE модуля.
Взял пример BLEScanner и немного модифицировал его. С записью в UART BluetoothLE модуля проблем не возникло, а вот с чтением данных почему-то не получилось. Проблема еще осложняется тем, что у меня нет исходников модулей System.Bluetooth, System.Bluetooth.Components, а функции типа SubscribeToCharacteristic не возвращают код ошибки, чтобы можно было понять что пошло не так и почему событие BLECharacteristicRead не происходит.

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
//---------------------------------------------------------------------------

// This software is Copyright (c) 2015 Embarcadero Technologies, Inc.
// You may only use this software if you are an authorized licensee
// of an Embarcadero developer tools product.
// This software is considered a Redistributable as defined under
// the software license agreement that comes with the Embarcadero Products
// and is subject to that software license agreement.

//---------------------------------------------------------------------------

unit Unit6;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  System.Bluetooth, FMX.StdCtrls, System.Bluetooth.Components, FMX.Layouts,
  FMX.ListBox, FMX.Controls.Presentation, FMX.Edit, FMX.ScrollBox, FMX.Memo;

type
  TFormMaim = class(TForm)
    Panel1: TPanel;
    LBoxDevice: TListBox;
    BLE: TBluetoothLE;
    BtnScan: TButton;
    BtnStopScan: TButton;
    Timer1: TTimer;
    ProgressBar1: TProgressBar;
    LBoxCharacteristics: TListBox;
    MemoLog: TMemo;
    EdSend: TEdit;
    BtnSend: TButton;
    procedure BtnScanClick(Sender: TObject);
    procedure BtnStopScanClick(Sender: TObject);
    procedure BLEDiscoverLEDevice(const Sender: TObject;
      const ADevice: TBluetoothLEDevice; Rssi: Integer;
      const ScanResponse: TScanResponse);
    procedure Timer1Timer(Sender: TObject);
    procedure BLEEndDiscoverDevices(const Sender: TObject;
      const ADeviceList: TBluetoothLEDeviceList);
    procedure FormShow(Sender: TObject);
    procedure BLEServicesDiscovered(const Sender: TObject;
      const AServiceList: TBluetoothGattServiceList);
    procedure LBoxDeviceItemClick(const Sender: TCustomListBox;
      const Item: TListBoxItem);
    procedure Log(const aMsg:String);
    procedure GChrLog(const aMsg:String);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure BLECharacteristicRead(const Sender: TObject;
      const ACharacteristic: TBluetoothGattCharacteristic;
      AGattStatus: TBluetoothGattStatus);
    procedure BLECharacteristicReadRequest(const Sender: TObject;
      const ACharacteristic: TBluetoothGattCharacteristic;
      var AGattStatus: TBluetoothGattStatus);
    procedure BLECharacteristicSubscribed(const Sender: TObject;
      const AClientId: string;
      const ACharacteristic: TBluetoothGattCharacteristic);
    procedure BtnSendClick(Sender: TObject);
  private
    Scanning: Boolean;
    ScanningStart: DWORD;
    { Private declarations }
  public
    { Public declarations }
  end;

const
  ScanningTime = 1500; // in msecs
  UsrUartSvcUUID:TBluetoothUUID=      '{0003cdd0-0000-1000-8000-00805f9b0131}';
  UsrUartNotifyChrUUID:TBluetoothUUID='{0003cdd1-0000-1000-8000-00805f9b0131}';
  UsrUartWriteChrUUID:TBluetoothUUID= '{0003cdd2-0000-1000-8000-00805f9b0131}';
var
  FormMaim: TFormMaim;
  ApplicationClose:Boolean=false;

implementation

{$R *.fmx}

var
 SelectedDev:TBluetoothLEDevice;
 UsrUartGatSvc:TBluetoothGattService;
 UsrUartGatNotifyChar:TBluetoothGattCharacteristic;
 UsrUartGatWriteChar:TBluetoothGattCharacteristic;

procedure TFormMaim.BLECharacteristicRead(const Sender: TObject;
  const ACharacteristic: TBluetoothGattCharacteristic;
  AGattStatus: TBluetoothGattStatus);
begin
 Log('R>'+ACharacteristic.ToString);
end;

procedure TFormMaim.BLECharacteristicReadRequest(const Sender: TObject;
  const ACharacteristic: TBluetoothGattCharacteristic;
  var AGattStatus: TBluetoothGattStatus);
begin
 Log('RR>'+ACharacteristic.ToString);
end;

procedure TFormMaim.BLECharacteristicSubscribed(const Sender: TObject;
  const AClientId: string; const ACharacteristic: TBluetoothGattCharacteristic);
begin
 Log('CS>'+ACharacteristic.UUIDName);
end;

procedure TFormMaim.BLEDiscoverLEDevice(const Sender: TObject;
  const ADevice: TBluetoothLEDevice; Rssi: Integer;
  const ScanResponse: TScanResponse);
var
 DevName: string;
 i:Integer;
begin
  if ApplicationClose then
   Exit;

  for i:=0 to BLE.DiscoveredDevices.Count - 1 do
  begin
    DevName:=BLE.DiscoveredDevices[i].DeviceName;
    if DevName = '' then
     DevName:='Unknown';
    if i >= LBoxDevice.Items.Count then
     LBoxDevice.Items.Add('');
    LBoxDevice.Items[i]:=Format('%d: %s - %s [%d]', [i+1, DevName, BLE.DiscoveredDevices[i].Identifier, Rssi]);
  end;
end;

procedure TFormMaim.BLEEndDiscoverDevices(const Sender: TObject;
  const ADeviceList: TBluetoothLEDeviceList);
begin
 if ApplicationClose then
  Exit;

  if Scanning then
    ProgressBar1.Value := ProgressBar1.Max;
  Timer1.Enabled := False;
  Scanning := False;
end;

procedure TFormMaim.BLEServicesDiscovered(const Sender: TObject;
  const AServiceList: TBluetoothGattServiceList);
var
  ServInd, CharInd, DescInd: Integer;
  GatChar:TBluetoothGattCharacteristic;
begin
  if AServiceList.Count > 0 then
  begin
    for ServInd:=0 to AServiceList.Count - 1 do
    begin
      GChrLog(Format('s%.2d - %s:%s',[(ServInd + 1), AServiceList[ServInd].UUIDName,AServiceList[ServInd].UUID.ToString]));
      for CharInd:=0 to AServiceList[ServInd].Characteristics.Count - 1 do
      begin
       GatChar:=AServiceList[ServInd].Characteristics[CharInd];
       GChrLog(Format('--c%.2d> - %s:%s',[CharInd+1, GatChar.UUIDName, GatChar.UUID.ToString]));
       for DescInd:=0 to GatChar.Descriptors.Count - 1 do
        GChrLog(Format('----d%.2d> - %s:%s',[DescInd+1, GatChar.Descriptors[DescInd].UUIDName, GatChar.Descriptors[DescInd].UUID.ToString]));
      end

    end;
  end
  else
   GChrLog('- Not allow access or no services');

  UsrUartGatSvc:=BLE.GetService(SelectedDev, UsrUartSvcUUID);
  if Assigned(UsrUartGatSvc) then
  begin
   UsrUartGatWriteChar:=BLE.GetCharacteristic(UsrUartGatSvc, UsrUartWriteChrUUID);
   UsrUartGatNotifyChar:=BLE.GetCharacteristic(UsrUartGatSvc, UsrUartNotifyChrUUID);

   //*************************************************************************************
   //*************************************************************************************
   // Проблема здесь !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
   SelectedDev.SetCharacteristicNotification(UsrUartGatNotifyChar, true);
   BLE.SubscribeToCharacteristic(SelectedDev, UsrUartGatNotifyChar);
   //*************************************************************************************
   //*************************************************************************************

  end;

  LBoxDevice.Enabled := True;
end;

procedure TFormMaim.BtnScanClick(Sender: TObject);
begin
  if not Scanning then
  begin
    LBoxDevice.Clear;
    ScanningStart := TThread.GetTickCount;
    ProgressBar1.Value := 0;
    if not BLE.DiscoverDevices(ScanningTime{, [UsrServiceUUID]}) then
    begin
     Log('Error start scan!');
     Exit;
    end;
    Timer1.Enabled := True;
    Scanning := True;
  end;
end;

procedure TFormMaim.BtnSendClick(Sender: TObject);
begin
 UsrUartGatWriteChar.SetValueAsString(EdSend.Text);
 BLE.WriteCharacteristic(SelectedDev, UsrUartGatWriteChar);
end;

procedure TFormMaim.BtnStopScanClick(Sender: TObject);
begin
  Timer1.Enabled := False;
  Scanning := False;
  BLE.CancelDiscovery;
end;

procedure TFormMaim.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 ApplicationClose:=true;
end;

procedure TFormMaim.FormShow(Sender: TObject);
begin
  Scanning := False;
end;

procedure TFormMaim.GChrLog(const aMsg: String);
begin
 LBoxCharacteristics.Items.Add(aMsg);
end;

procedure TFormMaim.LBoxDeviceItemClick(const Sender: TCustomListBox;
  const Item: TListBoxItem);
begin
  LBoxDevice.Enabled := False;

  BtnStopScanClick(Sender);
  LBoxCharacteristics.Clear;
  GChrLog('- Discovering services -->');

  SelectedDev:=BLE.DiscoveredDevices[LBoxDevice.ItemIndex];

  TThread.CreateAnonymousThread(procedure begin
    if not SelectedDev.DiscoverServices then
      TThread.Synchronize(nil, procedure begin
        GChrLog('- Discover services not allow');
        LBoxDevice.Enabled := True;
      end);
  end).Start;
end;

procedure TFormMaim.Log(const aMsg: String);
begin
 MemoLog.Lines.Add(aMsg);
end;

procedure TFormMaim.Timer1Timer(Sender: TObject);
var
  LElapsed: DWORD;
begin
  LElapsed := TThread.GetTickCount - ScanningStart;
  ProgressBar1.Value := ProgressBar1.Max * LElapsed.ToSingle/ScanningTime;
end;

end.



Варианты которые пробовал делать для подписки:
1)
Код: pascal
1.
 SelectedDev.SetCharacteristicNotification(UsrUartGatNotifyChar, true); 


2)
Код: pascal
1.
 BLE.SubscribeToCharacteristic(SelectedDev, UsrUartGatNotifyChar);



3)
Код: pascal
1.
2.
3.
// Комбинация предыдущих двух
     SelectedDev.SetCharacteristicNotification(UsrUartGatNotifyChar, true);
     BLE.SubscribeToCharacteristic(SelectedDev, UsrUartGatNotifyChar);


4)
Код: pascal
1.
2.
3.
4.
// Перед вызовом второго и третьего варианта добавлял 
UsrUartGatNotifyChar.Descriptors[0].Indication:=true; //<-- здесь возникала проблема т.к. дескриптор с таким UUID '{20003D9C-0000-0000-0000-000020002902}' считается как Unknown, а если DescriptorKind = Unknown, то запись запрещена. Вот если бы 
дескриптор начинался с  $00002902 вот тогда бы было счастье)  
SelectedDev.WriteDescriptor(UsrUartGatNotifyChar.Descriptors[0]);



Приложение запускал как под windows 10, так и на телефоне с android 5.0. В обоих случаях запись в UART BluetoothLE модуля работает, а чтение нет. Если в GooglePlay взять BLEScaner, то он спокойно работает с этим модулем, т.е. пишет и читает из него данные и подписка у него работает нормально. Также, если взять Android studio и в нем воспользоваться стандартным примером для работы с ble модулями, то он тоже прекрасно читает данные из этого модуля, но я не знаток Java).

Как в Delphi реализовать подписку на получение событий?
...
Рейтинг: 0 / 0
Delphi 10.2, BluetoothLE, не работает SubscribeToCharacteristic
    #39470240
t-vadim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Добавлю, что приведенные выше варианты для подписки вызывались внутри метода
procedure TFormMaim.BLEServicesDiscovered(const Sender: TObject;
const AServiceList: TBluetoothGattServiceList);
...
Рейтинг: 0 / 0
Delphi 10.2, BluetoothLE, не работает SubscribeToCharacteristic
    #39470452
misha mike
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BLE-юниты очень забагованы. Там есть все: от непоправленной кривой копи-пасты до дедлоков. Могу дать результаты своих правок (D10.2), с которыми оно хоть как-то работает, в т.ч. и подписка.
...
Рейтинг: 0 / 0
Delphi 10.2, BluetoothLE, не работает SubscribeToCharacteristic
    #39470531
t-vadim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
misha mike,
То, что они забагованы - я понял, и похоже не только они. Интересно взглянуть на результаты правок (e-mail в профиле)

А пока склоняюсь в сторону android studio.
...
Рейтинг: 0 / 0
Delphi 10.2, BluetoothLE, не работает SubscribeToCharacteristic
    #39470603
misha mike
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Там далеко не все косяки исправлены, но у меня работало.
...
Рейтинг: 0 / 0
Delphi 10.2, BluetoothLE, не работает SubscribeToCharacteristic
    #39470625
t-vadim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
misha mike,
Благодарю за исходники bluetooth модулей! С ними проблема решилась за пару минут)

Проблема была в модуле System.Bluetooth в методе
function TBluetoothLEDevice.SetCharacteristicNotification(const ACharacteristic: TBluetoothGattCharacteristic;
Enable: Boolean): Boolean;

Там был жестко задан дескриптор '{00002902-0000-1000-8000-00805F9B34FB}', т.е. если у устройства есть характеристики, для которых предусмотрена подписка, и у данной характеристики есть указанный дескриптор, то все будет работать. А если производитель устройства применил другой дескриптор, то подписка работать не будет!

В моем случае я поступил просто: оставил проверку, что на характеристику можно подписаться т.е. у нее есть свойства Notify и(или) Indicate, а проверку соответствия дескриптора заменил проверкой того, что у характеристики есть хотя бы один дескриптор, причем не важно какой. После этого все заработало как надо.

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
function TBluetoothLEDevice.SetCharacteristicNotification(const ACharacteristic: TBluetoothGattCharacteristic; Enable: Boolean):Boolean;
begin
  Result := False;
  if [TBluetoothProperty.Notify, TBluetoothProperty.Indicate] * ACharacteristic.GetProperties <> [] then
  begin
    // This is to ensure that we have read the descriptors before querying.
    ACharacteristic.Descriptors;
    // We check that we have the Configurarion descriptor, and then we set the notification accordingly.
    if ACharacteristic.Descriptors.Count > 0 then
      Result := DoSetCharacteristicNotification(ACharacteristic, Enable);
  end;
end;



ps Для подписки достаточно просто вызвать метод SubscribeToCharacteristic, дополнительно вызывать SetCharacteristicNotification не нужно, а то в некоторых источниках указывалось на необходимость дополнительных танцев с бубнами, но похоже в версии 10.2 они не актуальны.
...
Рейтинг: 0 / 0
6 сообщений из 6, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Delphi 10.2, BluetoothLE, не работает SubscribeToCharacteristic
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]