Delphi 10.1 Berlin で、iOS / Android Bluetooth LE (BLE) Serial 通信 (2017/04/05)

 ※2017/04/05 iOS のサンプルコードを追加しました。

 浅草ギ研のBLE モジュール BLESerial3 を使って、Android からシリアル通信を試してみました。
 Bluetooth Classic と違って、iOS からでも使用できます。
 ※ボーレートは、9600bps 固定です。ロット(100個)単位であれば、変更可能だそうです。
 RS232C へのレベル変換は、マイコンキットドットコム の MK-205 を使用しました。
 PLC と通信する場合は、通信設定、データ数の制限から、上位リンクではなく、無手順通信を使うしかないようです。

 ※送信、受信は、1 パケット 20 バイト以内と、制限があります。
  Delphi Android で、多くのデータを送信する場合は、BeginReliableWrite および ExecuteReliableWrite を使うようですが、
  うまく動きませんでした。
  http://docwiki.embarcadero.com/Libraries/Seattle/ja/System.Bluetooth.Components.TBluetoothLE.BeginReliableWrite

  送信は、15 バイトごとに区切って、20 msec の遅延で繰り返すと、何とか送信できます。

 

 ・KEYENCE KV へ送信してみました
  制御する場合は、無手順通信を使用します。

 


■ iOS (2017/04/05)

unit Unit1;

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.Controls.Presentation, FMX.StdCtrls,
  System.Bluetooth.Components, FMX.ScrollBox, FMX.Memo;

type
  TForm1 = class(TForm)
    BluetoothLE1: TBluetoothLE;
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure BluetoothLE1ServicesDiscovered(const Sender: TObject;
      const AServiceList: TBluetoothGattServiceList);
    procedure BluetoothLE1DiscoverLEDevice(const Sender: TObject;
      const ADevice: TBluetoothLEDevice; Rssi: Integer;
      const ScanResponse: TScanResponse);
    procedure BluetoothLE1EndDiscoverDevices(const Sender: TObject;
      const ADeviceList: TBluetoothLEDeviceList);
    procedure BluetoothLE1Connect(Sender: TObject);
    procedure BluetoothLE1CharacteristicRead(const Sender: TObject;
      const ACharacteristic: TBluetoothGattCharacteristic;
      AGattStatus: TBluetoothGattStatus);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { private 宣言 }
    fBleSerialDevice : TBluetoothLEDevice;
    fBleSerialService : TBluetoothGattService;
  public
    { public 宣言 }
  end;

var
  Form1: TForm1;

const
  // BLESerial サービス UUID
  BleSerialService: TBluetoothUUID =   '{FEED0001-C497-4476-A7ED-727DE7648AB1}';
  // BLESerial 受信 UUID (Notify)
  BleSerialRx :  TBluetoothUUID =      '{FEEDAA03-C497-4476-A7ED-727DE7648AB1}';
  // BLESerial 送信 UUID (write without response)
  BleSerialTx: TBluetoothUUID =        '{FEEDAA02-C497-4476-A7ED-727DE7648AB1}';

implementation

{$R *.fmx}

// 受信
procedure TForm1.BluetoothLE1CharacteristicRead(const Sender: TObject;
  const ACharacteristic: TBluetoothGattCharacteristic;
  AGattStatus: TBluetoothGattStatus);
var
  s : string;
begin
  // 受信した文字列
  s := ACharacteristic.GetValueAsString(0, true);
  Memo1.Lines.Add('read:'+s);
end;

procedure TForm1.BluetoothLE1Connect(Sender: TObject);
begin
  Memo1.Lines.Add('Connect');
end;

// BLESerial を発見
procedure TForm1.BluetoothLE1DiscoverLEDevice(const Sender: TObject;
  const ADevice: TBluetoothLEDevice; Rssi: Integer;
  const ScanResponse: TScanResponse);
begin
  Memo1.Lines.Add(ADevice.DeviceName);
  if Pos('BLESerial_', ADevice.DeviceName) > 0 then begin
    // デバイスを保持
    fBleSerialDevice := ADevice;
    // 検索を終了
    BluetoothLE1.CancelDiscovery;
  end;
end;

// BLE デバイスの検索終了
procedure TForm1.BluetoothLE1EndDiscoverDevices(const Sender: TObject;
  const ADeviceList: TBluetoothLEDeviceList);
begin
  if fBleSerialDevice <> nil then begin
    if not fBleSerialDevice.DiscoverServices then begin
      ShowMessage('サービスは使用できません.');
    end;
  end
  else begin
    ShowMessage('BLESerial が見つかりません.');
  end;
end;

// サービスを発見
procedure TForm1.BluetoothLE1ServicesDiscovered(const Sender: TObject;
  const AServiceList: TBluetoothGattServiceList);
var
  i :integer;
  RxCharact: TBluetoothGattCharacteristic;
begin
  if AServiceList.Count > 0 then begin
    // サービスを探す
    for i := 0 to AServiceList.Count -1 do begin
      // サービスを保持
      fBleSerialService := AServiceList[i];
      break;
    end;
    if fBleSerialService <> nil then begin
      // キャラクリスティックを取得
      for i := 0 to fBleSerialService.Characteristics.Count -1 do begin
        // SerialRx の UUID
        if fBleSerialService.Characteristics[i].UUID = BleSerialRx then begin
          RxCharact := fBleSerialService.Characteristics[i];
          break;
        end;
      end;
      if RxCharact <> nil then begin
        // Notify の受信要求
        fBleSerialDevice.SetCharacteristicNotification(RxCharact, true);
      end;
    end;
  end;
end;

// BLESerial を探す
procedure TForm1.Button1Click(Sender: TObject);
begin
  fBleSerialDevice := nil;
  fBleSerialService := nil;
  // BLESerial の GUID を指定して検索
  BluetoothLE1.DiscoverDevices(1000, [BleSerialService]);
end;

// 送信
procedure TForm1.Button2Click(Sender: TObject);
var
  s : string;
  TxCharact : TBluetoothGattCharacteristic;
begin
  if (fBleSerialDevice <> nil) and fBleSerialDevice.IsConnected then begin
    TxCharact := fBleSerialService.GetCharacteristic(BleSerialTx);
    if TxCharact <> nil then begin
      // 送信文字列
      s := 'ABCDEFGH';
      TxCharact.SetValueAsString(s, true);
      if fBleSerialDevice.WriteCharacteristic(TxCharact) then begin
        ShowMessage('送信しました : ' + s);
      end;
    end;
  end
  else begin
    ShowMessage('接続されていません.');
  end;
end;

// 切断
procedure TForm1.Button3Click(Sender: TObject);
begin
  if (fBleSerialDevice <> nil) and fBleSerialDevice.IsConnected then begin
    if fBleSerialDevice.Disconnect then begin
      ShowMessage('切断しました.');
      fBleSerialDevice := nil;
      fBleSerialService := nil;
    end;
  end
  else begin
    ShowMessage('接続されていません.');
  end;
end;

end.

■ Android (2017/03/10)

unit AndBLETestUnit1;

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.ScrollBox, FMX.Memo, FMX.Controls.Presentation,
  FMX.StdCtrls, System.Bluetooth.Components, FMX.Edit;

type
  TForm1 = class(TForm)
    BluetoothLE1: TBluetoothLE;
    Memo1: TMemo;
    Button3: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Timer1: TTimer;

    procedure BluetoothLE1Connect(Sender: TObject);
    procedure BluetoothLE1CharacteristicRead(const Sender: TObject;
      const ACharacteristic: TBluetoothGattCharacteristic;
      AGattStatus: TBluetoothGattStatus);
    procedure BluetoothLE1EndDiscoverServices(const Sender: TObject;
      const AServiceList: TBluetoothGattServiceList);
    procedure BluetoothLE1CharacteristicWrite(const Sender: TObject;
      const ACharacteristic: TBluetoothGattCharacteristic;
      AGattStatus: TBluetoothGattStatus);
    procedure BluetoothLE1DescriptorWrite(const Sender: TObject;
      const ADescriptor: TBluetoothGattDescriptor;
      AGattStatus: TBluetoothGattStatus);
    procedure Button3Click(Sender: TObject);
    procedure BluetoothLE1EndDiscoverDevices(const Sender: TObject;
      const ADeviceList: TBluetoothLEDeviceList);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { private 宣言 }
  public
    { public 宣言 }
  end;

var
  Form1: TForm1;
  GBleSerialService : TBluetoothGattService;
  GBleSerialDevice : TBluetoothLEDevice;
  GTmCount : integer;
  GSuccessCount : integer;

const
  // BLESerial サービス UUID
  UUID_BLESERIAL_SERVICE = '{FEED0001-C497-4476-A7ED-727DE7648AB1}';
  // BLESerial 受信 UUID (Notify)
  UUID_BLESERIAL_RX      = '{FEEDAA03-C497-4476-A7ED-727DE7648AB1}';
  // BLESerial 送信 UUID (write without response)
  UUID_BLESERIAL_TX      = '{FEEDAA02-C497-4476-A7ED-727DE7648AB1}';
  // キャラクタリスティック設定 UUID
  // Notification の UUID
  CLIENT_CHARACTERRISTIC_CONFIG  = '{00002902-0000-1000-8000-00805f9b34fb}';

implementation

{$R *.fmx}

// 受信
procedure TForm1.BluetoothLE1CharacteristicRead(const Sender: TObject;
  const ACharacteristic: TBluetoothGattCharacteristic;
  AGattStatus: TBluetoothGattStatus);
var
  s : string;
begin
  // 受信した文字列
  s := ACharacteristic.GetValueAsString(0,True);
  Memo1.Lines.Add('Read:' + s);
end;

// 送信後
procedure TForm1.BluetoothLE1CharacteristicWrite(const Sender: TObject;
  const ACharacteristic: TBluetoothGattCharacteristic;
  AGattStatus: TBluetoothGattStatus);
var
  s : string;
begin
  // 送信した文字列
  s := ACharacteristic.GetValueAsString(0, True);
  Memo1.Lines.Add('Write:' + s);
end;

// 接続
procedure TForm1.BluetoothLE1Connect(Sender: TObject);
begin
  Timer1.Enabled := False;
  Label3.Text := 'Connect ... ';
  Application.ProcessMessages;
end;

// Notification の有効化
procedure TForm1.BluetoothLE1DescriptorWrite(const Sender: TObject;
  const ADescriptor: TBluetoothGattDescriptor;
  AGattStatus: TBluetoothGattStatus);
begin
  if (TBluetoothGattStatus.Success = AGattStatus) then begin
    Inc(GSuccessCount);
    if GSuccessCount >= 2 then begin
      Label3.Text := 'Connect Success';
      Application.ProcessMessages;
      // ShowMessage('操作可能です');
    end;
  end;
end;

// BLE デバイスの検索終了
procedure TForm1.BluetoothLE1EndDiscoverDevices(const Sender: TObject;
  const ADeviceList: TBluetoothLEDeviceList);
var
  i : integer;
begin
  GBleSerialDevice := nil;
  if ADeviceList.Count > 0 then begin
    for i := 0 to Pred(ADeviceList.Count) do begin
      if Pos('BLESerial_', ADeviceList[i].DeviceName) > 0 then begin
        GBleSerialDevice := ADeviceList[i];
        Label2.Text := ADeviceList[i].DeviceName + ' (' + ADeviceList[i].Address + ')';
        Application.ProcessMessages;
        Break;
      end;
    end;
  end;
  if GBleSerialDevice <> nil then begin
    // サービスを検索
    GBleSerialDevice.DiscoverServices;
  end;
end;

procedure TForm1.BluetoothLE1EndDiscoverServices(const Sender: TObject;
  const AServiceList: TBluetoothGattServiceList);
var
  i: integer;
  AService : TBluetoothGattService;
  ACharact: TBluetoothGattCharacteristic;
  ADescriptor : TBluetoothGattDescriptor;
  AData :TBytes;
begin
  // サービスの一覧取得終了
  if AServiceList.Count > 0 then begin
    for i := 0 to Pred(AServiceList.Count) do begin
      if AServiceList[i].UUID.ToString = UUID_BLESERIAL_SERVICE then begin
        // シリアルサービスを取得
        AService := AserviceList[i];
        GBleSerialService := AserviceList[i];
        Break;
      end;
    end;
  end;
  if AService <> nil then begin
    // RX にNotificate をセット
    // キャラクタリスティックを取得
    ACharact := AService.GetCharacteristic(StringToGUID(UUID_BLESERIAL_RX));
    if ACharact = nil then begin
      // 再取得
      for i := 0 to Pred(AService.Characteristics.Count) do begin
        if AService.Characteristics[i].UUID.ToString = UUID_BLESERIAL_RX then begin
          ACharact := AService.Characteristics[i];
          Break;
        end;
      end;
    end;
    if ACharact <> nil then begin
      // Notify の受信要求(iOS では、不要らしい)
      GBleSerialDevice.SetCharacteristicNotification(ACharact, True);
      // GATT に RX の Notify を設定
      ADescriptor := ACharact.GetDescriptor(StringToGUID(CLIENT_CHARACTERRISTIC_CONFIG));

      SetLength(AData, 2);
      AData[0] := $01;
      AData[1] := $00;

      // Notification の有効化
      ADescriptor.SetValue(AData);
      GBleSerialDevice.WriteDescriptor(ADescriptor);
      // DescriptorWrite イベントが2回無いと通信出来ない
      // 実際に有効になるまで、時間がかかる
      Timer1.Enabled := False;
    end;
  end;
end;

// 文字列送信
procedure TForm1.Button3Click(Sender: TObject);
var
  ACharact: TBluetoothGattCharacteristic;
begin
  if (GBleSerialDevice <> nil) and GBleSerialDevice.IsConnected then begin
    ACharact := GBleSerialService.GetCharacteristic(StringToGUID(UUID_BLESERIAL_TX));
    if ACharact <> nil then begin
      ACharact.SetValueAsString(Edit1.Text, True);
      GBleSerialDevice.WriteCharacteristic(ACharact);
    end;
  end;
end;

// 終了処理
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if (GBleSerialDevice <> nil) and GBleSerialDevice.IsConnected then begin
    GBleSerialDevice.Disconnect;
    GBleSerialDevice := nil;
    GBleSerialService := nil;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Label1.Text := '';
  Label2.Text := '';
  Label3.Text := '';
  Memo1.Lines.Clear;
  GSuccessCount := 0;
  BluetoothLE1.Enabled := True;
  // 端末の名称
  Label1.Text := BluetoothLE1.GetCurrentAdapter.AdapterName;
  // BLE デバイスを検索
  BluetoothLE1.DiscoverDevices(1000);
  GTmCount := 0;
  Timer1.Enabled := True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Inc(GTmCount);
  Label3.Text := IntToStr(GTmCount * 10) + ' msec';
  if GTmCount > 200 then begin
    Timer1.Enabled := False;
    ShowMessage('接続失敗');
  end;
end;

end.