Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Ответ
 
Опции темы
Старый 19.09.2017, 12:17   #1
PTyTb32
Форумчанин
 
Регистрация: 06.10.2013
Сообщений: 156
Репутация: 17

icq: 418328851
Счастье BlueTooth на Android

Привет, в этой теме опишу рабочий способ связать Android и Arduino средствами Bluetooth. Во первых логика самой программы такова, что она формирует кадр который мы и будем отправлять. Кадр из себя представляет 3 значения, 2 разделителя и окончание строки. Выглядит кадр вот так r/g/ae, где r - значение от 0 до 179 соответствует ползунку руля, g - значение от 0 до 179 соответствует ползунку газа, a - значения от 0 до 8 для управления 3-я каналами aux, и e - конец строки.
Начнем с класса
Код:

TServerConnectionTH = class(TThread)
  private
    { Private declarations }
    FServerSocket: TBluetoothServerSocket;
    FSocket: TBluetoothSocket;
    FData: TBytes;
  protected
    procedure Execute; override;
    procedure UpdateText;
  public
    { Public declarations }
    constructor Create(ACreateSuspended: Boolean);
    destructor Destroy; override;
  end;

дальше в приват класса формы (основной) добавляем это
Код:

    FBluetoothManager: TBluetoothManager;
    FDiscoverDevices: TBluetoothDeviceList;
    FPairedDevices: TBluetoothDeviceList;
    FAdapter: TBluetoothAdapter;
    FData: TBytes;
    FSocket: TBluetoothSocket;
    ItemIndex: Integer;
    ServerConnectionTH: TServerConnectionTH;
    procedure PairedDevices;
    procedure SendData(TextData:string);
    function ManagerConnected: Boolean;

Затем добавляем пару констант и переменных

Код:

Const
  ServiceName = 'SerialPort';
  ServiceGUI = '{00001101-0000-1000-8000-00805f9b34fb}';//не меняйте этот номер

var
  Form1: TForm1;
  ToSend: TBytes;
  LDevice: TBluetoothDevice;

после описываем тот класс что мы добавили первым

Код:


constructor TServerConnectionTH.Create(ACreateSuspended: Boolean);
begin
  inherited;
end;

destructor TServerConnectionTH.Destroy;
begin
  FSocket.Free;
  FServerSocket.Free;
  inherited;
end;

procedure TServerConnectionTH.Execute;
var
  ASocket: TBluetoothSocket;
  Msg: string;
begin
  while not Terminated do
    try
      ASocket := nil;
      while not Terminated and (ASocket = nil) do
        ASocket := FServerSocket.Accept(100);
      if (ASocket <> nil) then
      begin
        FSocket := ASocket;
        while not Terminated do
        begin
          FData := ASocket.ReadData;
          if Length(FData) > 0 then
            Synchronize(
              procedure
              begin

              end);
          sleep(100);
        end;
      end;
    except
      on E: Exception do
      begin
        Msg := E.Message;
        Synchronize(
          procedure
          begin

          end);
      end;
    end;
end;

procedure TServerConnectionTH.UpdateText;
begin
  if Length(FData) > 0 then
  begin

  end;
end;

и еще такие процедуры

Код:

function TForm1.ManagerConnected: Boolean;
begin
  if FBluetoothManager.ConnectionState = TBluetoothConnectionState.Connected
  then
  begin
    result := True;
  end
  else
  begin
    result := False;
  end
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  try
    FBluetoothManager := TBluetoothManager.Current;
    if ManagerConnected then
    begin
      PairedDevices;

    end;
  except
    on E: Exception do
    begin
      ShowMessage(E.Message);
    end;
  end;
end;

Дальше читаем внимательно!

Создаем процедуру PairedDevices, запоминаем ее, она даст нам список сопряженных устройств, потом нам понадобится индекс устройства!

Код:

procedure TForm1.PairedDevices;
var
  i: Integer;
begin
  ComboboxPaired.Clear;
  FPairedDevices := FBluetoothManager.GetPairedDevices;
  if FPairedDevices.Count > 0 then
    for i := 0 to FPairedDevices.Count - 1 do
      ComboboxPaired.Items.Add(FPairedDevices[i].DeviceName)
  else
    ComboboxPaired.Items.Add('No Paired Devices');
end;

теперь в обработку выбора (это немного не правильно, но мне так было удобнее), после выбора из комбобокса мы сразу подключимся

Код:

procedure TForm1.ComboboxPairedChange(Sender: TObject);
begin

  if (ServerConnectionTH = nil) and ManagerConnected then
  begin
    FAdapter := FBluetoothManager.CurrentAdapter;
    ServerConnectionTH := TServerConnectionTH.Create(True);
    ServerConnectionTH.FServerSocket := FAdapter.CreateServerSocket(ServiceName,
      StringToGUID(ServiceGUI), False);
    ServerConnectionTH.Start;
    if (FSocket = nil) or (ItemIndex <> ComboboxPaired.ItemIndex) then
    begin
      if ComboboxPaired.ItemIndex > -1 then
      begin
        LDevice := FPairedDevices[ComboboxPaired.ItemIndex] as TBluetoothDevice;
        FSocket := LDevice.CreateClientSocket(StringToGUID(ServiceGUI), False);
        if FSocket <> nil then
        begin
          ItemIndex := ComboboxPaired.ItemIndex;
          FSocket.Connect;
        end;
      end;
    end;
  end;
end;

и вот мы подключены, теперь нам нужна процедура отправки сообщения

Код:

procedure TForm1.SendData(TextData:string);
begin

  if ComboboxPaired.ItemIndex <= -1 then
    exit;

  if not FSocket.Connected then
  begin
    Label6.Text := 'ОШИБКА';
    exit;
  End;
  ToSend := TEncoding.UTF8.GetBytes(TextData);
  FSocket.SendData(ToSend);

end;

на этом пожалуй все. кому есть что добавить не стесняемся, а кто поможет сделать нормальное переподключение в случае ошибки отправки сообщения тому огромное спасибо! и еще я пока не придумал как изменить скорость работы Serial порта, то есть он по умолчанию работает на скорости 9600 bod (или как там эти единицы измерения), а мне надо к примеру больше.

У меня все-таки получилось засунуть все это в один модуль и теперь это управляется в 3 действия

Код:

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, easybluetooth, //Добавляем модуль, не забываем положить pas файл к проекту
  FMX.ListBox, FMX.Edit, FMX.Controls.Presentation, FMX.StdCtrls;

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;// сюда положим список устройств
    Button1: TButton;//это кнопка отправки
    Edit1: TEdit;//текст который будем отправлять
    Button2: TButton;//кнопка получения списка устройств
    procedure ComboBox1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  a:TServerConnectionTH;//создаем экземпляр класса
implementation

{$R *.fmx}
{$R *.LgXhdpiPh.fmx ANDROID}

procedure TForm1.Button1Click(Sender: TObject);
begin
a.SendData(edit1.Text);//отправляем сообщение
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
a:=TServerConnectionTH.Create(true);//инициализируем модуль
a.PairedDevices(ComboBox1);//получаем список сопряженных устройств
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
a.Connect(combobox1.ItemIndex);//подключаемся к выбранному устройству
end;

end.

и сам модуль:
EasyBlueTooth.zip

Последний раз редактировалось PTyTb32; 19.09.2017 в 15:34.
PTyTb32 вне форума   Ответить с цитированием
Старый 05.10.2017, 21:55   #2
Metalist280
Новичок
 
Регистрация: 25.09.2010
Сообщений: 1
Репутация: 10
По умолчанию

Спасибо за код. Как я понимаю, отправляется именно строковое значение. А что нужно переделать, чтоб можно было отправлять byte?
Metalist280 вне форума   Ответить с цитированием
Старый 02.11.2017, 14:29   #3
PTyTb32
Форумчанин
 
Регистрация: 06.10.2013
Сообщений: 156
Репутация: 17

icq: 418328851
По умолчанию

Цитата:
Сообщение от Metalist280 Посмотреть сообщение
А что нужно переделать, чтоб можно было отправлять byte?
вообще строковое значение переводится в Byte вот тут:
Код:

ToSend := TEncoding.UTF8.GetBytes(TextData);

PTyTb32 вне форума   Ответить с цитированием
Старый 25.10.2018, 21:32   #4
SERG1980
Профессионал
 
Аватар для SERG1980
 
Регистрация: 28.03.2007
Сообщений: 1,814
Репутация: 717
По умолчанию

Всем привет. Сижу бьюсь уже неделю с блютусом на андроиде. Всё работает нормально, но как только доходит до строчки
Код:

 ASocket := FServerSocket.Accept(100);

приложение на телефоне просто вылетает. Не могу понять в чём дело. Кто нибудь работал с блютузом? Подскажите в сём может быть дело?
SERG1980 вне форума   Ответить с цитированием
Старый 23.12.2018, 17:37   #5
YuriKo
Новичок
 
Регистрация: 22.12.2018
Сообщений: 2
Репутация: 10
По умолчанию

Цитата:
Сообщение от SERG1980 Посмотреть сообщение
Всем привет. Сижу бьюсь уже неделю с блютусом на андроиде. Всё работает нормально, но как только доходит до строчки
Код:

 ASocket := FServerSocket.Accept(100);

приложение на телефоне просто вылетает. Не могу понять в чём дело. Кто нибудь работал с блютузом? Подскажите в сём может быть дело?
Здравствуйте! Только начал осваивать это дело. Есть рабочие варианты обмена данными в обе стороны?
YuriKo вне форума   Ответить с цитированием
Старый 23.12.2018, 18:23   #6
YuriKo
Новичок
 
Регистрация: 22.12.2018
Сообщений: 2
Репутация: 10
По умолчанию

Пример рабочий, проверил. А как получать данные?
YuriKo вне форума   Ответить с цитированием
Старый 26.12.2018, 15:30   #7
PTyTb32
Форумчанин
 
Регистрация: 06.10.2013
Сообщений: 156
Репутация: 17

icq: 418328851
По умолчанию

Цитата:
Сообщение от YuriKo Посмотреть сообщение
Пример рабочий, проверил. А как получать данные?
едва помню эту приложуху, возможно где то есть исходники..

если первый бит будет содержать в себе количество бит за ним, то можно так
Код:

countByte:=FSocket.readbyte();
for i:=0 to countByte-1 do
stroka:=stroka+FSocket.readbyte();

если получится так или как то еще отпиши тут, мало ли кому еще понадобится))
PTyTb32 вне форума   Ответить с цитированием
Старый 28.01.2019, 13:55   #8
divdiv
Новичок
 
Регистрация: 14.10.2018
Сообщений: 1
Репутация: 10
По умолчанию

Ниже описано, как получать данные по Bluetooth( двусторонняя связь):

Пример PTyTb32 это переделанный, упрощенный варианта оригинального примера ClBluetooth(classic Bluetooth Basic App) от Embarcadero. Упрощенный вариант мне помог разобраться с тем, как это работает, из него убрано куча ненужностей оригинального варианта, за что PTyTb32 большой Спасибо!

Вообще приём данных уже заложен в пример(ы) - в потоке в процедуре TServerConnectionTH.Execute, строчка ASocket := FServerSocket.Accept(100); означает, что в течении 100 мсек происходит запрос входных данных, и в случае получения данные мы должны получать ссылку на сокет из которого 5 строчками ниже происходит чтение данных FData := ASocket.ReadData и т.д. Но в ASocket всегда nil. Не работает.

Моё решение:
1. Открываем оригинальный пример ClBluetooth.dproj
2. меняем
Код:

Const
  ServiceName = 'Basic Text Server';
  ServiceGUI = '{B62C4E8D-62CC-404B-BBBF-BF3E3BBB1378}';

на
Код:

Const
  ServiceName = 'SerialPort';
  ServiceGUI = '{00001101-0000-1000-8000-00805f9b34fb}';

можно не менять, но тогда на устройстве к которому подключаемся должен быть такой же UUID
3. В манифесте разрешаем Bluetooth
4. на форму добавляем таймер
Код:

Timer1: TTimer;

и по умолчанию его выключаем Timer1.enabled=false и настраиваем на срабатывание Timer1.Interval=3000 /в идеале значение лучше подобрать под себя в диапазоне 500-3000. На событие onTimer назначаем procedure TForm1.Timer1Timer(Sender: TObject);
5. добавляем следующий код
Код:

procedure TForm1.Timer1Timer(Sender: TObject);
var
  ToSend: TBytes;
  LDevice: TBluetoothDevice;
  LData: TBytes;
  s:string;
begin
  if (FSocket = nil) or (ItemIndex <> ComboboxPaired.ItemIndex) then
  begin
    if ComboboxPaired.ItemIndex > -1 then
    begin
      LDevice := FPairedDevices[ComboboxPaired.ItemIndex] as TBluetoothDevice;
      DisplayR.Lines.Add(GetServiceName(ServiceGUI));
      DisplayR.GoToTextEnd;
      FSocket := LDevice.CreateClientSocket(StringToGUID(ServiceGUI), False);
      if FSocket <> nil then
      begin
        ItemIndex := ComboboxPaired.ItemIndex;
        try
        FSocket.Connect;
        except
        on E : Exception do
              begin
               //ShowMessage(E.ClassName+' поднята ошибка, с сообщением2 : '+E.Message);
               Timer1.Enabled:=False;
               Fsocket:=nil; exit;
            end;
        end ;
        LData := FSocket.ReceiveData;
        s:=utf8toansi(StringOf(ldata));
        DisplayR.Lines.Add(s);
        DisplayR.GoToTextEnd;
      end
      else
        ShowMessage('Out of time -15s-');
    end
    else
      ShowMessage('No paired device selected');
  end
  else
  begin
   if fsocket.Connected then
   begin
    Try
    LData := FSocket.ReceiveData;
    except
    on E : Exception do
      begin fsocket:=nil;  //end
      //Timer1.Enabled:=False;
      //ShowMessage(E.ClassName+' поднята ошибка, с сообщением : '+E.Message);
      exit;
      end;
    end;
   if length(ldata)>0 then
     begin
      s:=utf8toansi(StringOf(ldata));
      DisplayR.Lines.Add(s);
      DisplayR.GoToTextEnd;
     end
   end;
  end;
 end;

6. Добавляем на форму кнопку Button1: TButton;
7. Создаём реакцию на нажатие данной кнопки:
Код:

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled:=True;
end;

Работает приём и отправка данных, как под Android, так и под Win32. Решение с таймером,конечно, не академичное и наверняка при определенных условиях даст сбой. Полагаю, что решить всё отдельным потоком возможно, только в отличии от оригинального примера, в поток нужно убирать всё взаимодействие по bluetooth. И отправку данных осуществлять через отправку сообщения из основного потока/формы в bluetooth-поток, с адресом отправляемых данных, а при получении данных в обратную сторону bluetooth-поток отправляет сообщение основному потоку/форме. Т.к. в bluetooth-потоке будет обработчик событий, то необходимость в таймере отпадет, нужно лишь приостанавливать поток через sleep(100). В коде использованы 2-е конструкции try..except, которые решают ситуацию с обрывом Bluetooth соединения, причем нижняя конструкция фактически осуществляет переподключение, если соединение восстановлено в течении ~15 секунд.
divdiv вне форума   Ответить с цитированием
Старый Сегодня, 01:36   #9
edge89
Новичок
 
Регистрация: 16.02.2019
Сообщений: 1
Репутация: 10
По умолчанию

Товарищ divdiv, ваш вариант рабочий, спасибо. Но работает коряво и с фризами жуткими. Фризы по секунд 10, наверное. я не уверен, что правильно понял про строчку ASocket := FServerSocket.Accept(100); но если правильно, то тут замечание: FServerSocket.Accept(100); задаёт таймаут в миллисекундах на получение сокета, к входным данным отношения не имеет.

Очень большой интервал таймера. Вы предлагаете до 3 секунд. Это слишком много, да и фризит на чтении из буфера ещё дольше.
В поток запихнуть чтение входных данных не получилось у меня. либо виснет, либо вообще никак не реагирует. И вообще, судя по другим форумам, не только у меня не получилось.

Обнаружилось, что если в буфере что-то есть, то на LData := FSocket.ReceiveData; ничего не подвисает и не фризит. как только буфер пустой, ReceiveData как будто ждёт определенное время, а не появится ли там чего, потому и фризы. Оказалось, вот как дело обстоит:
"function ReceiveData(ATimeout: Cardinal): TBytes; overload;
Читает массив байтов, отправленных удаленным устройством. ATimeout - максимальное время ожидания данных. Если по истечении времени данных нет, возвращаемое значение (TBytes) будет пустым."


Меняем ваше LData := FSocket.ReceiveData; на LData := FSocket.ReceiveData(0); - профит! Ничего не фризит, всё отлично работает. И интервал таймеру можно и 10мс поставить.
Странно, что в интернетах столько мучеников с этой проблемой, и никто документацию почитать не догадался. Ну и жаль, что в поток запихнуть не получилось.

Последний раз редактировалось edge89; Сегодня в 01:45.
edge89 вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
XE8 + Android: не запрашивает доступ к Bluetooth mosq Мобильные ОС (Android, iOS, Windows Phone) 0 14.06.2017 12:21
FM Bluetooth PTyTb32 Компоненты Delphi 0 08.01.2017 03:27
bluetooth Drago56 C/C++ Сетевое программирование 0 26.02.2016 00:36
BlueTooth GBAXA Работа с сетью в Delphi 1 19.12.2010 14:53
BlueTooth subsonic Общие вопросы Delphi 4 24.07.2008 16:19


03:37.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru