Delphi XE7的蓝牙 Bluetooth

来源：互联网发布：淘宝3c证书编号是什么编辑：程序博客网时间：2024/05/17 01:37

Delphi XE7已经内建了蓝牙功能，提供了System.Bluetooth.pas单元

顾名思义，System表示XE7的蓝牙功能可以在Windows，Android，IOS系统内使用

System.Bluetooth单元中主要包含一下几个类

TBluetoothManager
TBluetoothDeviceList
TBluetoothAdapter
TBluetoothDevice
TBluetoothService
TBluetoothServiceList
TBluetoothSocket

TBluetoothManager是蓝牙管理器，用于蓝牙设备管理，包括发现蓝牙设备，获取配对设备，处理远程配对请求等功能

TBluetoothDeviceList是蓝牙设备列表，TBluetoothDeviceList = class(TObjectList<TBluetoothDevice>),可以通过TBluetoothManager.GetPairedDevices获得配对设备列表

TBluetoothAdapter本机蓝牙设备，实现配对、取消配对等功能，可通过TBluetoothManager.CurrentAdapter得到当前蓝牙设备

TBluetoothDevice远端蓝牙设备，每个远端设备可以提供若干个服务（TBluetoothService），

TBluetoothService远端蓝牙设备服务，包括服务名和UUID

  TBluetoothService = record    Name: string;    UUID: TBluetoothUUID;  end;

TBluetoothServiceList服务列表 = class(TList<TBluetoothService>);可通过TBluetoothDevice.GetServices获得远端设备服务列表

TBluetoothSocket蓝牙通讯套接字,通过 TBluetoothDevice.CreateClientSocket(StringToGUID(ServiceGUI), True/False)创建，下面是一个XE7自带的例子

unit Unit1;interfaceuses  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, System.Bluetooth,  FMX.Layouts, FMX.ListBox, FMX.StdCtrls, FMX.Memo, FMX.Controls.Presentation,  FMX.Edit, FMX.TabControl;type  TServerConnectionTH = class(TThread)  private    { Private declarations }    FServerSocket: TBluetoothServerSocket;    FSocket: TBluetoothSocket;    FData: TBytes;  protected    procedure Execute; override;  public    { Public declarations }    constructor Create(ACreateSuspended: Boolean);    destructor Destroy; override;  end;  TForm1 = class(TForm)    ButtonDiscover: TButton;    ButtonPair: TButton;    ButtonUnPair: TButton;    ButtonPairedDevices: TButton;    DisplayR: TMemo;    Edit1: TEdit;    Button2: TButton;    FreeSocket: TButton;    Labeldiscoverable: TLabel;    ComboBoxDevices: TComboBox;    ComboBoxPaired: TComboBox;    Panel1: TPanel;    TabControl1: TTabControl;    TabItem1: TTabItem;    TabItem2: TTabItem;    LabelNameSarver: TLabel;    ButtonServices: TButton;    ComboBoxServices: TComboBox;    PanelClient: TPanel;    LabelClient: TLabel;    ButtonConnectToRFCOMM: TButton;    PanelServer: TPanel;    ButtonCloseReadingSocket: TButton;    ButtonOpenReadingSocket: TButton;    LabelServer: TLabel;    procedure ButtonDiscoverClick(Sender: TObject);    procedure ButtonPairClick(Sender: TObject);    procedure ButtonUnPairClick(Sender: TObject);    procedure ButtonPairedDeviceClick(Sender: TObject);    procedure FormShow(Sender: TObject);    procedure ButtonOpenReadingSocketClick(Sender: TObject);    procedure ButtonConnectToRFCOMMClick(Sender: TObject);    procedure ButtonCloseReadingSocketClick(Sender: TObject);    procedure Button2Click(Sender: TObject);    procedure FormClose(Sender: TObject; var Action: TCloseAction);    procedure FreeSocketClick(Sender: TObject);    function ManagerConnected:Boolean;    function GetServiceName(GUID: string): string;    procedure ComboBoxPairedChange(Sender: TObject);    procedure ButtonServicesClick(Sender: TObject);  private    { Private declarations }    FBluetoothManager: TBluetoothManager;    FDiscoverDevices: TBluetoothDeviceList;    FPairedDevices: TBluetoothDeviceList;    FAdapter: TBluetoothAdapter;    FData: TBytes;    FSocket: TBluetoothSocket;    ItemIndex: Integer;    ServerConnectionTH: TServerConnectionTH;    procedure DevicesDiscoveryEnd(const Sender: TObject; const ADevices: TBluetoothDeviceList);    procedure PairedDevices;    procedure SendData;  public    { Public declarations }  end;Const  ServiceName = 'Basic Text Server';  ServiceGUI = '{B62C4E8D-62CC-404B-BBBF-BF3E3BBB1378}';var  Form1: TForm1;implementation{$R *.fmx}{$R *.NmXhdpiPh.fmx ANDROID}{$R *.LgXhdpiPh.fmx ANDROID}{$R *.SmXhdpiPh.fmx ANDROID}{$R *.Macintosh.fmx MACOS}{$R *.iPhone4in.fmx IOS}{$R *.Windows.fmx MSWINDOWS}procedure TForm1.ButtonPairClick(Sender: TObject);begin  if ManagerConnected then    if ComboboxDevices.ItemIndex > -1 then      FAdapter.Pair(FDiscoverDevices[ComboboxDevices.ItemIndex])    else      ShowMessage('No device selected');end;procedure TForm1.ButtonUnPairClick(Sender: TObject);begin  if ManagerConnected then    if ComboboxPaired.ItemIndex > -1 then      FAdapter.UnPair(FPairedDevices[ComboboxPaired.ItemIndex])    else      ShowMessage('No Paired device selected');end;procedure TForm1.ComboBoxPairedChange(Sender: TObject);begin  LabelNameSarver.Text := ComboBoxPaired.Items[ComboBoxPaired.ItemIndex];end;procedure TForm1.PairedDevices;var  I: Integer;begin  ComboboxPaired.Clear;  if ManagerConnected then  begin  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;end;procedure TForm1.ButtonPairedDeviceClick(Sender: TObject);begin  PairedDevices;  ComboboxPaired.DropDown;end;procedure TForm1.ButtonServicesClick(Sender: TObject);var  LServices: TBluetoothServiceList;  LDevice: TBluetoothDevice;  I: Integer;begin  ComboBoxServices.Clear;  if ManagerConnected then    if ComboboxPaired.ItemIndex > -1 then    begin      LDevice := FPairedDevices[ComboboxPaired.ItemIndex] as TBluetoothDevice;      LServices := LDevice.GetServices;      for I := 0 to LServices.Count - 1 do        ComboBoxServices.Items.Add(LServices[I].Name + ' --> ' + GUIDToString(LServices[I].UUID));      ComboBoxServices.ItemIndex := 0;      ComboBoxServices.DropDown;    end    else      ShowMessage('No paired device selected');end;procedure TForm1.FreeSocketClick(Sender: TObject);begin  FreeAndNil(FSocket);  DisplayR.Lines.Add('Client socket set free');  DisplayR.GoToLineEnd;end;procedure TForm1.Button2Click(Sender: TObject);begin  DisplayR.ReadOnly := False;  DisplayR.SelectAll;  DisplayR.DeleteSelection;  DisplayR.ReadOnly := True;end;function TForm1.GetServiceName(GUID: string): string;var  LServices: TBluetoothServiceList;  LDevice: TBluetoothDevice;  I: Integer;begin  LDevice := FPairedDevices[ComboboxPaired.ItemIndex] as TBluetoothDevice;  LServices := LDevice.GetServices;  for I := 0 to LServices.Count - 1 do  begin    if StringToGUID(GUID) = LServices[I].UUID then    begin      Result := LServices[I].Name;      break;    end;  end;end;procedure TForm1.ButtonConnectToRFCOMMClick(Sender: TObject);begin  if ManagerConnected then    try      SendData;    except      on E : Exception do      begin        DisplayR.Lines.Add(E.Message);        DisplayR.GoToTextEnd;        FreeAndNil(FSocket);      end;    end;end;function TForm1.ManagerConnected:Boolean;begin  if FBluetoothManager.ConnectionState = TBluetoothConnectionState.Connected then  begin    Labeldiscoverable.Text := 'Device discoverable as "'+FBluetoothManager.CurrentAdapter.AdapterName+'"';    Result := True;  end  else  begin    Result := False;    DisplayR.Lines.Add('No Bluetooth device Found');    DisplayR.GoToTextEnd;  endend;procedure TForm1.SendData;var  ToSend: TBytes;  LDevice: TBluetoothDevice;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;        FSocket.Connect;        ToSend := TEncoding.UTF8.GetBytes(Edit1.Text);        FSocket.SendData(ToSend);        DisplayR.Lines.Add('Text Sent');        DisplayR.GoToTextEnd;      end      else        ShowMessage('Out of time -15s-');    end    else      ShowMessage('No paired device selected');  end  else  begin    ToSend := TEncoding.UTF8.GetBytes(Edit1.Text);    FSocket.SendData(ToSend);    DisplayR.Lines.Add('Text Sent');    DisplayR.GoToTextEnd;  end;end;procedure TForm1.ButtonDiscoverClick(Sender: TObject);begin  ComboboxDevices.Clear;  if ManagerConnected then  begin    FAdapter := FBluetoothManager.CurrentAdapter;    FBluetoothManager.StartDiscovery(10000);    FBluetoothManager.OnDiscoveryEnd := DevicesDiscoveryEnd;  end;end;procedure TForm1.DevicesDiscoveryEnd(const Sender: TObject; const ADevices: TBluetoothDeviceList);var  I: Integer;begin  FDiscoverDevices := ADevices;  for I := 0 to ADevices.Count - 1 do    ComboboxDevices.Items.Add(ADevices[I].DeviceName + '  -> ' + ADevices[I].Address);  ComboboxDevices.ItemIndex := 0;end;procedure TForm1.ButtonOpenReadingSocketClick(Sender: TObject);begin  if (ServerConnectionTH = nil) and ManagerConnected then  begin    try      FAdapter := FBluetoothManager.CurrentAdapter;      ServerConnectionTH := TServerConnectionTH.Create(True);      ServerConnectionTH.FServerSocket := FAdapter.CreateServerSocket(ServiceName, StringToGUID(ServiceGUI), False);      ServerConnectionTH.Start;      DisplayR.Lines.Add(' - Service created: "'+ServiceName+'"');      DisplayR.GoToTextEnd;    except      on E : Exception do      begin        DisplayR.Lines.Add(E.Message);        DisplayR.GoToTextEnd;      end;    end;  end;end;procedure TForm1.ButtonCloseReadingSocketClick(Sender: TObject);begin  if ServerConnectionTH <> nil then  begin    ServerConnectionTH.Terminate;    ServerConnectionTH.WaitFor;    FreeAndNil(ServerConnectionTH);    DisplayR.Lines.Add(' - Service removed -');    DisplayR.GoToTextEnd;  endend;procedure TForm1.FormShow(Sender: TObject);begin  try    LabelServer.Text := ServiceName;    LabelClient.Text := 'Client of '+ServiceName;    FBluetoothManager := TBluetoothManager.Current;    FAdapter := FBluetoothManager.CurrentAdapter;    if ManagerConnected then    begin      PairedDevices;      ComboboxPaired.ItemIndex := 0;    end;  except    on E : Exception do    begin      ShowMessage(E.Message);    end;  end;end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);begin  if ServerConnectionTH <> nil then  begin    ServerConnectionTH.Terminate;    ServerConnectionTH.WaitFor;    FreeAndNil(ServerConnectionTH);  endend;{TServerConnection}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                Form1.DisplayR.Lines.Add(TEncoding.UTF8.GetString(FData));                Form1.DisplayR.GoToTextEnd;              end);          sleep(100);        end;      end;    except      on E : Exception do      begin        Msg := E.Message;        Synchronize(procedure          begin            Form1.DisplayR.Lines.Add('Server Socket closed: ' + Msg);            Form1.DisplayR.GoToTextEnd;          end);      end;    end;end;end.

窗体文件

object Form1: TForm1  Left = 0  Top = 0  Caption = 'Basic Classic Bluetooth Demo'  ClientHeight = 570  ClientWidth = 360  FormFactor.Width = 320  FormFactor.Height = 480  FormFactor.Devices = [Desktop]  OnClose = FormClose  OnShow = FormShow  DesignerMasterStyle = 3  object Panel1: TPanel    Align = Client    Size.Width = 360.000000000000000000    Size.Height = 570.000000000000000000    Size.PlatformDefault = False    TabOrder = 13    object TabControl1: TTabControl      Align = Client      FullSize = True      Size.Width = 360.000000000000000000      Size.Height = 570.000000000000000000      Size.PlatformDefault = False      TabHeight = 49.000000000000000000      TabIndex = 0      TabOrder = 1      TabPosition = Bottom      object TabItem1: TTabItem        CustomIcon = <          item          end>        IsSelected = True        Size.Width = 180.000000000000000000        Size.Height = 49.000000000000000000        Size.PlatformDefault = False        TabOrder = 0        Text = 'Bluetooth settings'        object ButtonDiscover: TButton          Position.X = 4.000000000000000000          Position.Y = 59.000000000000000000          Size.Width = 158.000000000000000000          Size.Height = 31.000000000000000000          Size.PlatformDefault = False          TabOrder = 0          Text = 'Discover devices'          OnClick = ButtonDiscoverClick        end        object ButtonPair: TButton          Position.X = 191.000000000000000000          Position.Y = 59.000000000000000000          Size.Width = 78.000000000000000000          Size.Height = 31.000000000000000000          Size.PlatformDefault = False          TabOrder = 1          Text = 'Pair'          OnClick = ButtonPairClick        end        object ButtonPairedDevices: TButton          Position.X = 4.000000000000000000          Position.Y = 140.000000000000000000          Size.Width = 158.000000000000000000          Size.Height = 31.000000000000000000          Size.PlatformDefault = False          TabOrder = 2          Text = 'Paired Devices'          OnClick = ButtonPairedDeviceClick        end        object ButtonUnPair: TButton          Position.X = 277.000000000000000000          Position.Y = 67.000000000000000000          Size.Width = 80.000000000000000000          Size.Height = 22.000000000000000000          Size.PlatformDefault = False          TabOrder = 3          Text = 'UnPair'          OnClick = ButtonUnPairClick        end        object ComboBoxDevices: TComboBox          Position.X = 4.000000000000000000          Position.Y = 92.000000000000000000          Size.Width = 352.000000000000000000          Size.Height = 32.000000000000000000          Size.PlatformDefault = False          TabOrder = 4        end        object ComboBoxPaired: TComboBox          Position.X = 4.000000000000000000          Position.Y = 173.000000000000000000          Size.Width = 352.000000000000000000          Size.Height = 32.000000000000000000          Size.PlatformDefault = False          TabOrder = 5          OnChange = ComboBoxPairedChange        end        object ButtonServices: TButton          Position.X = 4.000000000000000000          Position.Y = 221.000000000000000000          Size.Width = 158.000000000000000000          Size.Height = 31.000000000000000000          Size.PlatformDefault = False          TabOrder = 6          Text = 'Services'          OnClick = ButtonServicesClick        end        object ComboBoxServices: TComboBox          Position.X = 4.000000000000000000          Position.Y = 254.000000000000000000          Size.Width = 352.000000000000000000          Size.Height = 32.000000000000000000          Size.PlatformDefault = False          TabOrder = 7        end      end      object TabItem2: TTabItem        CustomIcon = <          item          end>        IsSelected = False        Size.Width = 180.000000000000000000        Size.Height = 49.000000000000000000        Size.PlatformDefault = False        TabOrder = 0        Text = 'Service demo'        object PanelClient: TPanel          Position.Y = 134.000000000000000000          Size.Width = 360.000000000000000000          Size.Height = 153.000000000000000000          Size.PlatformDefault = False          TabOrder = 0          object Button2: TButton            Position.X = 4.000000000000000000            Position.Y = 115.000000000000000000            Size.Width = 73.000000000000000000            Size.Height = 25.000000000000000000            Size.PlatformDefault = False            TabOrder = 0            Text = 'Clear'            OnClick = Button2Click          end          object Edit1: TEdit            Touch.InteractiveGestures = [LongTap, DoubleTap]            TabOrder = 1            Text = 'I am the text sent'            Position.X = 4.000000000000000000            Position.Y = 71.000000000000000000            Size.Width = 343.000000000000000000            Size.Height = 32.000000000000000000            Size.PlatformDefault = False          end          object FreeSocket: TButton            Position.X = 190.000000000000000000            Position.Y = 115.000000000000000000            Size.Width = 157.000000000000000000            Size.Height = 25.000000000000000000            Size.PlatformDefault = False            TabOrder = 2            Text = 'Free Client Socket'            OnClick = FreeSocketClick          end          object LabelNameSarver: TLabel            Position.X = 157.000000000000000000            Position.Y = 22.000000000000000000            Size.Width = 180.000000000000000000            Size.Height = 40.000000000000000000            Size.PlatformDefault = False          end          object LabelClient: TLabel            StyledSettings = [Family, Size, FontColor]            Position.X = 4.000000000000000000            Size.Width = 227.000000000000000000            Size.Height = 20.000000000000000000            Size.PlatformDefault = False            Text = 'Client'          end          object ButtonConnectToRFCOMM: TButton            Position.X = 4.000000000000000000            Position.Y = 28.000000000000000000            Size.Width = 143.000000000000000000            Size.Height = 33.000000000000000000            Size.PlatformDefault = False            TabOrder = 5            Text = 'Send text to ->'            OnClick = ButtonConnectToRFCOMMClick          end        end        object PanelServer: TPanel          Position.Y = 40.000000000000000000          Size.Width = 360.000000000000000000          Size.Height = 93.000000000000000000          Size.PlatformDefault = False          TabOrder = 1          object ButtonCloseReadingSocket: TButton            Position.X = 195.000000000000000000            Position.Y = 32.000000000000000000            Size.Width = 160.000000000000000000            Size.Height = 36.000000000000000000            Size.PlatformDefault = False            TabOrder = 0            Text = 'Remove text service'            OnClick = ButtonCloseReadingSocketClick          end          object ButtonOpenReadingSocket: TButton            Position.X = 4.000000000000000000            Position.Y = 32.000000000000000000            Size.Width = 160.000000000000000000            Size.Height = 36.000000000000000000            Size.PlatformDefault = False            TabOrder = 1            Text = 'Create text service'            OnClick = ButtonOpenReadingSocketClick          end          object LabelServer: TLabel            StyledSettings = [Family, Size, FontColor]            Position.X = 4.000000000000000000            Size.Width = 227.000000000000000000            Size.Height = 20.000000000000000000            Size.PlatformDefault = False            Text = 'Server'          end        end      end    end    object Labeldiscoverable: TLabel      StyledSettings = [Family, Style, FontColor]      Position.X = 16.000000000000000000      Position.Y = 8.000000000000000000      Size.Width = 321.000000000000000000      Size.Height = 23.000000000000000000      Size.PlatformDefault = False    end    object DisplayR: TMemo      Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]      Anchors = [akLeft, akTop, akRight]      Position.Y = 288.000000000000000000      Size.Width = 360.000000000000000000      Size.Height = 232.000000000000000000      Size.PlatformDefault = False      TabOrder = 2      TabStop = False      ReadOnly = True      ShowSizeGrip = True    end  endend

0 0