Delphi XE7的蓝牙 Bluetooth

发布时间：2020-12-15 09:59:14 所属栏目：大数据来源：网络整理

导读：Delphi XE7已经内建了蓝牙功能，提供了System.Bluetooth.pas单元顾名思义，System表示XE7的蓝牙功能可以在Windows，Android，IOS系统内使用 System.Bluetooth单元中主要包含一下几个类 TBluetoothManager TBluetoothDeviceList TBluetoothAdapter TBluetoot

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;

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.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; end;

  TForm1 = (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);
     ButtonPairClick(Sender: TObject);
     ButtonUnPairClick(Sender: TObject);
     ButtonPairedDeviceClick(Sender: TObject);
     FormShow(Sender: TObject);
     ButtonOpenReadingSocketClick(Sender: TObject);
     ButtonConnectToRFCOMMClick(Sender: TObject);
     ButtonCloseReadingSocketClick(Sender: TObject);
     Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
     FreeSocketClick(Sender: TObject);
    function ManagerConnected:Boolean;
    function GetServiceName(GUID: string): ;
     ComboBoxPairedChange(Sender: TObject);
     ButtonServicesClick(Sender: TObject);
  
    FBluetoothManager: TBluetoothManager;
    FDiscoverDevices: TBluetoothDeviceList;
    FPairedDevices: TBluetoothDeviceList;
    FAdapter: TBluetoothAdapter;
    FData: TBytes;
    FSocket: TBluetoothSocket;
    ItemIndex: Integer;
    ServerConnectionTH: TServerConnectionTH;
    procedure DevicesDiscoveryEnd(const Sender: TObject; const ADevices: TBluetoothDeviceList);
     PairedDevices;
     SendData;
  }
  ;

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

  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}

 TForm1.ButtonPairClick(Sender: TObject);
begin
  if ManagerConnected then
    if ComboboxDevices.ItemIndex > -1 then
      FAdapter.Pair(FDiscoverDevices[ComboboxDevices.ItemIndex])
    else
      ShowMessage(No device selected);
;

 TForm1.ButtonUnPairClick(Sender: TObject);
if ComboboxPaired.ItemIndex > -
      FAdapter.UnPair(FPairedDevices[ComboboxPaired.ItemIndex])
    No Paired device selected TForm1.ComboBoxPairedChange(Sender: TObject);
begin
  LabelNameSarver.Text := ComboBoxPaired.Items[ComboBoxPaired.ItemIndex];
 TForm1.PairedDevices;

  I: Integer;

  ComboboxPaired.Clear;
  then
  
  FPairedDevices := FBluetoothManager.GetPairedDevices;
  if FPairedDevices.Count > 0 for I:= to FPairedDevices.Count - do
      ComboboxPaired.Items.Add(FPairedDevices[I].DeviceName)
  
    ComboboxPaired.Items.Add(No Paired Devices);
   TForm1.ButtonPairedDeviceClick(Sender: TObject);

  PairedDevices;
  ComboboxPaired.DropDown;
 TForm1.ButtonServicesClick(Sender: TObject);

  LServices: TBluetoothServiceList;
  LDevice: TBluetoothDevice;
  I: Integer;

  ComboBoxServices.Clear;
  
      LDevice := FPairedDevices[ComboboxPaired.ItemIndex] as TBluetoothDevice;
      LServices := LDevice.GetServices;
      for I := to LServices.Count - 
        ComboBoxServices.Items.Add(LServices[I].Name +  --> ' + GUIDToString(LServices[I].UUID));
      ComboBoxServices.ItemIndex := 0;
      ComboBoxServices.DropDown;
    end
    No paired device selected TForm1.FreeSocketClick(Sender: TObject);

  FreeAndNil(FSocket);
  DisplayR.Lines.Add(Client socket set free);
  DisplayR.GoToLineEnd;
 TForm1.Button2Click(Sender: TObject);

  DisplayR.ReadOnly := False;
  DisplayR.SelectAll;
  DisplayR.DeleteSelection;
  DisplayR.ReadOnly := True;
function TForm1.GetServiceName(GUID: 
  LDevice := FPairedDevices[ComboboxPaired.ItemIndex]  TBluetoothDevice;
  LServices := LDevice.GetServices;
  do
  begin
    if StringToGUID(GUID) = LServices[I].UUID 
      Result := LServices[I].Name;
      break TForm1.ButtonConnectToRFCOMMClick(Sender: TObject);
try
      SendData;
    except
      on E : Exception do
      
        DisplayR.Lines.Add(E.Message);
        DisplayR.GoToTextEnd;
        FreeAndNil(FSocket);
       TForm1.ManagerConnected:Boolean;
if FBluetoothManager.ConnectionState = TBluetoothConnectionState.Connected 
    Labeldiscoverable.Text := Device discoverable as "'+FBluetoothManager.CurrentAdapter.AdapterName+";
    Result := True;
  end
  else
  
    Result := False;
    DisplayR.Lines.Add(No Bluetooth device Found);
    DisplayR.GoToTextEnd;
  end
 TForm1.SendData;

  ToSend: TBytes;
  LDevice: TBluetoothDevice;
if (FSocket = nil) or (ItemIndex <> ComboboxPaired.ItemIndex)  TBluetoothDevice;
      DisplayR.Lines.Add(GetServiceName(ServiceGUI));
      DisplayR.GoToTextEnd;
      FSocket := LDevice.CreateClientSocket(StringToGUID(ServiceGUI),False);
      if FSocket <> nil then
      
        ItemIndex := ComboboxPaired.ItemIndex;
        FSocket.Connect;
        ToSend := TEncoding.UTF8.GetBytes(Edit1.Text);
        FSocket.SendData(ToSend);
        DisplayR.Lines.Add(Text Sent);
        DisplayR.GoToTextEnd;
      end
      
        ShowMessage(Out of time -15s-);
    
    ToSend := TEncoding.UTF8.GetBytes(Edit1.Text);
    FSocket.SendData(ToSend);
    DisplayR.Lines.Add( TForm1.ButtonDiscoverClick(Sender: TObject);

  ComboboxDevices.Clear;
  
    FAdapter := FBluetoothManager.CurrentAdapter;
    FBluetoothManager.StartDiscovery(10000);
    FBluetoothManager.OnDiscoveryEnd := DevicesDiscoveryEnd;
  procedure TForm1.DevicesDiscoveryEnd( ADevices: TBluetoothDeviceList);

  FDiscoverDevices := ADevices;
  to ADevices.Count - 
    ComboboxDevices.Items.Add(ADevices[I].DeviceName +   ->  ADevices[I].Address);
  ComboboxDevices.ItemIndex :=  TForm1.ButtonOpenReadingSocketClick(Sender: TObject);
if (ServerConnectionTH = and ManagerConnected 
      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;
    
        DisplayR.Lines.Add(E.Message);
        DisplayR.GoToTextEnd;
       TForm1.ButtonCloseReadingSocketClick(Sender: TObject);
if ServerConnectionTH <> 
    ServerConnectionTH.Terminate;
    ServerConnectionTH.WaitFor;
    FreeAndNil(ServerConnectionTH);
    DisplayR.Lines.Add( - Service removed - TForm1.FormShow(Sender: TObject);

    LabelServer.Text := ServiceName;
    LabelClient.Text := Client of '+ServiceName;
    FBluetoothManager := TBluetoothManager.Current;
    FAdapter := FBluetoothManager.CurrentAdapter;
    
      PairedDevices;
      ComboboxPaired.ItemIndex := 
    on E : Exception do
    
      ShowMessage(E.Message);
    procedure TForm1.FormClose(Sender: TObject;  Action: TCloseAction);

    ServerConnectionTH.Terminate;
    ServerConnectionTH.WaitFor;
    FreeAndNil(ServerConnectionTH);
  TServerConnection TServerConnectionTH.Create(ACreateSuspended: Boolean);
inheriteddestructor TServerConnectionTH.Destroy;

  FSocket.Free;
  FServerSocket.Free;
   TServerConnectionTH.execute;

  ASocket: TBluetoothSocket;
  Msg: while not Terminated 
      ASocket := nil;
      and (ASocket = 
        ASocket := FServerSocket.Accept(100);
      if(ASocket <> 
        FSocket := ASocket;
        do
        
          FData := ASocket.ReadData;
          if length(FData) > 
            Synchronize(procedure
              
                Form1.DisplayR.Lines.Add(TEncoding.UTF8.GetString(FData));
                Form1.DisplayR.GoToTextEnd;
              );
          sleep();
        
        Msg := E.Message;
        Synchronize(procedure
          
            Form1.DisplayR.Lines.Add(Server Socket closed:  Msg);
            Form1.DisplayR.GoToTextEnd;
          end.

窗体文件

object Form1: TForm1 Left = Top = Caption = Basic Classic Bluetooth Demo ClientHeight = 570 ClientWidth = 360 FormFactor.Width = 320 FormFactor.Height = 480 FormFactor.Devices = [Desktop] OnClose = FormClose OnShow = FormShow DesignerMasterStyle = 3 Panel1: TPanel Align = Client Size.Width = 360.000000000000000000 Size.Height = 570.000000000000000000 Size.PlatformDefault = False TabOrder = 13 TabControl1: TTabControl Align = Client FullSize = True Size.Width = Size.Height = Size.PlatformDefault = False TabHeight = 49.000000000000000000 TabIndex = TabOrder = 1 TabPosition = Bottom TabItem1: TTabItem CustomIcon = < item end> IsSelected = True Size.Width = 180.000000000000000000 Size.Height = Size.PlatformDefault = False TabOrder = Text = Bluetooth settings' ButtonDiscover: TButton Position.X = 4.000000000000000000 Position.Y = 59.000000000000000000 Size.Width = 158.000000000000000000 Size.Height = 31.000000000000000000 Size.PlatformDefault = False TabOrder = Text = Discover devices OnClick = ButtonDiscoverClick end ButtonPair: TButton Position.X = 191.00000000000000000078.000000000000000000Pair ButtonPairClick ButtonPairedDevices: TButton Position.X = 140.0000000000000000002Paired Devices ButtonPairedDeviceClick ButtonUnPair: TButton Position.X = 277.00000000000000000067.00000000000000000080.00000000000000000022.0000000000000000003UnPair ButtonUnPairClick ComboBoxDevices: TComboBox Position.X = 92.000000000000000000352.00000000000000000032.0000000000000000004 ComboBoxPaired: TComboBox Position.X = 173.0000000000000000005 OnChange = ComboBoxPairedChange ButtonServices: TButton Position.X = 221.0000000000000000006Services ButtonServicesClick ComboBoxServices: TComboBox Position.X = 254.0000000000000000007 TabItem2: TTabItem CustomIcon = < False Size.Width = Service demo PanelClient: TPanel Position.Y = 134.000000000000000000153.0000000000000000000 Button2: TButton Position.X = Position.Y = 115.000000000000000000 Size.Width = 73.000000000000000000 Size.Height = 25.000000000000000000 Size.PlatformDefault = False TabOrder = Text = Clear OnClick = Button2Click end Edit1: TEdit Touch.InteractiveGestures = [LongTap,DoubleTap] TabOrder = I am the text sent Position.X = 71.000000000000000000343.000000000000000000 False FreeSocket: TButton Position.X = 190.000000000000000000157.000000000000000000Free Client Socket FreeSocketClick LabelNameSarver: TLabel Position.X = 40.000000000000000000 LabelClient: TLabel StyledSettings = [Family,Size,FontColor] Position.X = 227.00000000000000000020.000000000000000000 False Text = Client' ButtonConnectToRFCOMM: TButton Position.X = 28.000000000000000000143.00000000000000000033.000000000000000000Send text to -> ButtonConnectToRFCOMMClick PanelServer: TPanel Position.Y = 93.0000000000000000001 ButtonCloseReadingSocket: TButton Position.X = 195.000000000000000000160.00000000000000000036.000000000000000000Remove text service ButtonCloseReadingSocketClick ButtonOpenReadingSocket: TButton Position.X = Create text service ButtonOpenReadingSocketClick LabelServer: TLabel StyledSettings =Server Labeldiscoverable: TLabel StyledSettings =16.000000000000000000 Position.Y = 8.000000000000000000 Size.Width = 321.00000000000000000023.000000000000000000 False DisplayR: TMemo Touch.InteractiveGestures = [Pan,LongTap,DoubleTap] Anchors = [akLeft,akTop,akRight] Position.Y = 288.000000000000000000232.000000000000000000 False TabOrder = TabStop = False ReadOnly = True ShowSizeGrip = True end

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!