文档章节

Delphi XE7的蓝牙 Bluetooth

vga
 vga
发布于 2015/03/02 15:07
字数 1214
阅读 1555
收藏 1
介绍

本文章介绍了Delphi XE7的蓝牙 Bluetooth,Delphi XE7已经内建了蓝牙功能,提供了System.Bluetooth.pas单元

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

System.Bluetooth单元中主要包含一下几个类,其中带LE的支持所有系统,不带LE的类不支持Ios系统,带与不带LE功能是一样的。

TBluetoothManager
TBluetoothDeviceList
TBluetoothAdapter
TBluetoothDevice
TBluetoothService
TBluetoothServiceList
TBluetoothSocket

TBluetoothLEManager
TBluetoothLEDeviceList
TBluetoothLEAdapter
TBluetoothLEDevice
TBluetoothLEService
TBluetoothLEServiceList
TBluetoothLESocket

其中:

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

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

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

TBluetoothDevice远端蓝牙设备,每个远端设备可以提供若干个服务(TBluetoothService),

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


  1. TBluetoothService = record

  2.     Name: string;

  3.     UUID: TBluetoothUUID;

  4.   end;

复制代码


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

TBluetoothSocket蓝牙通讯套接字,通过 TBluetoothDevice.CreateClientSocket(StringToGUID(ServiceGUI), True/False)创建,

下面是一个XE7自带的例子,记得在Android下把相关权限添加到工程设置中。

  1. unit Unit1;


  2. interface


  3. uses

  4.   System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,

  5.   FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, System.Bluetooth,

  6.   FMX.Layouts, FMX.ListBox, FMX.StdCtrls, FMX.Memo, FMX.Controls.Presentation,

  7.   FMX.Edit, FMX.TabControl;


  8. type


  9.   TServerConnectionTH = class(TThread)

  10.   private

  11.     { Private declarations }

  12.     FServerSocket: TBluetoothServerSocket;

  13.     FSocket: TBluetoothSocket;

  14.     FData: TBytes;

  15.   protected

  16.     procedure Execute; override;

  17.   public

  18.     { Public declarations }

  19.     constructor Create(ACreateSuspended: Boolean);

  20.     destructor Destroy; override;

  21.   end;


  22.   TForm1 = class(TForm)

  23.     ButtonDiscover: TButton;

  24.     ButtonPair: TButton;

  25.     ButtonUnPair: TButton;

  26.     ButtonPairedDevices: TButton;

  27.     DisplayR: TMemo;

  28.     Edit1: TEdit;

  29.     Button2: TButton;

  30.     FreeSocket: TButton;

  31.     Labeldiscoverable: TLabel;

  32.     ComboBoxDevices: TComboBox;

  33.     ComboBoxPaired: TComboBox;

  34.     Panel1: TPanel;

  35.     TabControl1: TTabControl;

  36.     TabItem1: TTabItem;

  37.     TabItem2: TTabItem;

  38.     LabelNameSarver: TLabel;

  39.     ButtonServices: TButton;

  40.     ComboBoxServices: TComboBox;

  41.     PanelClient: TPanel;

  42.     LabelClient: TLabel;

  43.     ButtonConnectToRFCOMM: TButton;

  44.     PanelServer: TPanel;

  45.     ButtonCloseReadingSocket: TButton;

  46.     ButtonOpenReadingSocket: TButton;

  47.     LabelServer: TLabel;

  48.     procedure ButtonDiscoverClick(Sender: TObject);

  49.     procedure ButtonPairClick(Sender: TObject);

  50.     procedure ButtonUnPairClick(Sender: TObject);

  51.     procedure ButtonPairedDeviceClick(Sender: TObject);

  52.     procedure FormShow(Sender: TObject);

  53.     procedure ButtonOpenReadingSocketClick(Sender: TObject);

  54.     procedure ButtonConnectToRFCOMMClick(Sender: TObject);

  55.     procedure ButtonCloseReadingSocketClick(Sender: TObject);

  56.     procedure Button2Click(Sender: TObject);

  57.     procedure FormClose(Sender: TObject; var Action: TCloseAction);

  58.     procedure FreeSocketClick(Sender: TObject);

  59.     function ManagerConnected:Boolean;

  60.     function GetServiceName(GUID: string): string;

  61.     procedure ComboBoxPairedChange(Sender: TObject);

  62.     procedure ButtonServicesClick(Sender: TObject);

  63.   private

  64.     { Private declarations }

  65.     FBluetoothManager: TBluetoothManager;

  66.     FDiscoverDevices: TBluetoothDeviceList;

  67.     FPairedDevices: TBluetoothDeviceList;

  68.     FAdapter: TBluetoothAdapter;

  69.     FData: TBytes;

  70.     FSocket: TBluetoothSocket;

  71.     ItemIndex: Integer;

  72.     ServerConnectionTH: TServerConnectionTH;

  73.     procedure DevicesDiscoveryEnd(const Sender: TObject; const ADevices: TBluetoothDeviceList);

  74.     procedure PairedDevices;

  75.     procedure SendData;

  76.   public

  77.     { Public declarations }

  78.   end;


  79. Const

  80.   ServiceName = 'Basic Text Server';

  81.   ServiceGUI = '{B62C4E8D-62CC-404B-BBBF-BF3E3BBB1378}';

  82. var

  83.   Form1: TForm1;


  84. implementation


  85. {$R *.fmx}

  86. {$R *.NmXhdpiPh.fmx ANDROID}

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

  88. {$R *.SmXhdpiPh.fmx ANDROID}

  89. {$R *.Macintosh.fmx MACOS}

  90. {$R *.iPhone4in.fmx IOS}

  91. {$R *.Windows.fmx MSWINDOWS}


  92. procedure TForm1.ButtonPairClick(Sender: TObject);

  93. begin

  94.   if ManagerConnected then

  95.     if ComboboxDevices.ItemIndex > -1 then

  96.       FAdapter.Pair(FDiscoverDevices[ComboboxDevices.ItemIndex])

  97.     else

  98.       ShowMessage('No device selected');

  99. end;


  100. procedure TForm1.ButtonUnPairClick(Sender: TObject);

  101. begin

  102.   if ManagerConnected then

  103.     if ComboboxPaired.ItemIndex > -1 then

  104.       FAdapter.UnPair(FPairedDevices[ComboboxPaired.ItemIndex])

  105.     else

  106.       ShowMessage('No Paired device selected');

  107. end;


  108. procedure TForm1.ComboBoxPairedChange(Sender: TObject);

  109. begin

  110.   LabelNameSarver.Text := ComboBoxPaired.Items[ComboBoxPaired.ItemIndex];

  111. end;


  112. procedure TForm1.PairedDevices;

  113. var

  114.   I: Integer;

  115. begin

  116.   ComboboxPaired.Clear;

  117.   if ManagerConnected then

  118.   begin

  119.   FPairedDevices := FBluetoothManager.GetPairedDevices;

  120.   if FPairedDevices.Count > 0 then

  121.     for I:= 0 to FPairedDevices.Count - 1 do

  122.       ComboboxPaired.Items.Add(FPairedDevices[I].DeviceName)

  123.   else

  124.     ComboboxPaired.Items.Add('No Paired Devices');

  125.   end;

  126. end;


  127. procedure TForm1.ButtonPairedDeviceClick(Sender: TObject);

  128. begin

  129.   PairedDevices;

  130.   ComboboxPaired.DropDown;

  131. end;


  132. procedure TForm1.ButtonServicesClick(Sender: TObject);

  133. var

  134.   LServices: TBluetoothServiceList;

  135.   LDevice: TBluetoothDevice;

  136.   I: Integer;

  137. begin

  138.   ComboBoxServices.Clear;

  139.   if ManagerConnected then

  140.     if ComboboxPaired.ItemIndex > -1 then

  141.     begin

  142.       LDevice := FPairedDevices[ComboboxPaired.ItemIndex] as TBluetoothDevice;

  143.       LServices := LDevice.GetServices;

  144.       for I := 0 to LServices.Count - 1 do

  145.         ComboBoxServices.Items.Add(LServices[I].Name + ' --> ' + GUIDToString(LServices[I].UUID));

  146.       ComboBoxServices.ItemIndex := 0;

  147.       ComboBoxServices.DropDown;

  148.     end

  149.     else

  150.       ShowMessage('No paired device selected');

  151. end;


  152. procedure TForm1.FreeSocketClick(Sender: TObject);

  153. begin

  154.   FreeAndNil(FSocket);

  155.   DisplayR.Lines.Add('Client socket set free');

  156.   DisplayR.GoToLineEnd;

  157. end;


  158. procedure TForm1.Button2Click(Sender: TObject);

  159. begin

  160.   DisplayR.ReadOnly := False;

  161.   DisplayR.SelectAll;

  162.   DisplayR.DeleteSelection;

  163.   DisplayR.ReadOnly := True;

  164. end;


  165. function TForm1.GetServiceName(GUID: string): string;

  166. var

  167.   LServices: TBluetoothServiceList;

  168.   LDevice: TBluetoothDevice;

  169.   I: Integer;

  170. begin

  171.   LDevice := FPairedDevices[ComboboxPaired.ItemIndex] as TBluetoothDevice;

  172.   LServices := LDevice.GetServices;

  173.   for I := 0 to LServices.Count - 1 do

  174.   begin

  175.     if StringToGUID(GUID) = LServices[I].UUID then

  176.     begin

  177.       Result := LServices[I].Name;

  178.       break;

  179.     end;

  180.   end;

  181. end;


  182. procedure TForm1.ButtonConnectToRFCOMMClick(Sender: TObject);

  183. begin

  184.   if ManagerConnected then

  185.     try

  186.       SendData;

  187.     except

  188.       on E : Exception do

  189.       begin

  190.         DisplayR.Lines.Add(E.Message);

  191.         DisplayR.GoToTextEnd;

  192.         FreeAndNil(FSocket);

  193.       end;

  194.     end;

  195. end;


  196. function TForm1.ManagerConnected:Boolean;

  197. begin

  198.   if FBluetoothManager.ConnectionState = TBluetoothConnectionState.Connected then

  199.   begin

  200.     Labeldiscoverable.Text := 'Device discoverable as "'+FBluetoothManager.CurrentAdapter.AdapterName+'"';

  201.     Result := True;

  202.   end

  203.   else

  204.   begin

  205.     Result := False;

  206.     DisplayR.Lines.Add('No Bluetooth device Found');

  207.     DisplayR.GoToTextEnd;

  208.   end

  209. end;


  210. procedure TForm1.SendData;

  211. var

  212.   ToSend: TBytes;

  213.   LDevice: TBluetoothDevice;

  214. begin

  215.   if (FSocket = nil) or (ItemIndex <> ComboboxPaired.ItemIndex) then

  216.   begin

  217.     if ComboboxPaired.ItemIndex > -1 then

  218.     begin

  219.       LDevice := FPairedDevices[ComboboxPaired.ItemIndex] as TBluetoothDevice;

  220.       DisplayR.Lines.Add(GetServiceName(ServiceGUI));

  221.       DisplayR.GoToTextEnd;

  222.       FSocket := LDevice.CreateClientSocket(StringToGUID(ServiceGUI), False);

  223.       if FSocket <> nil then

  224.       begin

  225.         ItemIndex := ComboboxPaired.ItemIndex;

  226.         FSocket.Connect;

  227.         ToSend := TEncoding.UTF8.GetBytes(Edit1.Text);

  228.         FSocket.SendData(ToSend);

  229.         DisplayR.Lines.Add('Text Sent');

  230.         DisplayR.GoToTextEnd;

  231.       end

  232.       else

  233.         ShowMessage('Out of time -15s-');

  234.     end

  235.     else

  236.       ShowMessage('No paired device selected');

  237.   end

  238.   else

  239.   begin

  240.     ToSend := TEncoding.UTF8.GetBytes(Edit1.Text);

  241.     FSocket.SendData(ToSend);

  242.     DisplayR.Lines.Add('Text Sent');

  243.     DisplayR.GoToTextEnd;

  244.   end;

  245. end;


  246. procedure TForm1.ButtonDiscoverClick(Sender: TObject);

  247. begin

  248.   ComboboxDevices.Clear;

  249.   if ManagerConnected then

  250.   begin

  251.     FAdapter := FBluetoothManager.CurrentAdapter;

  252.     FBluetoothManager.StartDiscovery(10000);

  253.     FBluetoothManager.OnDiscoveryEnd := DevicesDiscoveryEnd;

  254.   end;

  255. end;


  256. procedure TForm1.DevicesDiscoveryEnd(const Sender: TObject; const ADevices: TBluetoothDeviceList);

  257. var

  258.   I: Integer;

  259. begin

  260.   FDiscoverDevices := ADevices;

  261.   for I := 0 to ADevices.Count - 1 do

  262.     ComboboxDevices.Items.Add(ADevices[I].DeviceName + '  -> ' + ADevices[I].Address);

  263.   ComboboxDevices.ItemIndex := 0;

  264. end;


  265. procedure TForm1.ButtonOpenReadingSocketClick(Sender: TObject);

  266. begin

  267.   if (ServerConnectionTH = nil) and ManagerConnected then

  268.   begin

  269.     try

  270.       FAdapter := FBluetoothManager.CurrentAdapter;

  271.       ServerConnectionTH := TServerConnectionTH.Create(True);

  272.       ServerConnectionTH.FServerSocket := FAdapter.CreateServerSocket(ServiceName, StringToGUID(ServiceGUI), False);

  273.       ServerConnectionTH.Start;

  274.       DisplayR.Lines.Add(' - Service created: "'+ServiceName+'"');

  275.       DisplayR.GoToTextEnd;

  276.     except

  277.       on E : Exception do

  278.       begin

  279.         DisplayR.Lines.Add(E.Message);

  280.         DisplayR.GoToTextEnd;

  281.       end;

  282.     end;

  283.   end;

  284. end;


  285. procedure TForm1.ButtonCloseReadingSocketClick(Sender: TObject);

  286. begin

  287.   if ServerConnectionTH <> nil then

  288.   begin

  289.     ServerConnectionTH.Terminate;

  290.     ServerConnectionTH.WaitFor;

  291.     FreeAndNil(ServerConnectionTH);

  292.     DisplayR.Lines.Add(' - Service removed -');

  293.     DisplayR.GoToTextEnd;

  294.   end

  295. end;


  296. procedure TForm1.FormShow(Sender: TObject);

  297. begin

  298.   try

  299.     LabelServer.Text := ServiceName;

  300.     LabelClient.Text := 'Client of '+ServiceName;

  301.     FBluetoothManager := TBluetoothManager.Current;

  302.     FAdapter := FBluetoothManager.CurrentAdapter;

  303.     if ManagerConnected then

  304.     begin

  305.       PairedDevices;

  306.       ComboboxPaired.ItemIndex := 0;

  307.     end;

  308.   except

  309.     on E : Exception do

  310.     begin

  311.       ShowMessage(E.Message);

  312.     end;

  313.   end;

  314. end;


  315. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

  316. begin

  317.   if ServerConnectionTH <> nil then

  318.   begin

  319.     ServerConnectionTH.Terminate;

  320.     ServerConnectionTH.WaitFor;

  321.     FreeAndNil(ServerConnectionTH);

  322.   end

  323. end;


  324. {TServerConnection}


  325. constructor TServerConnectionTH.Create(ACreateSuspended: Boolean);

  326. begin

  327.   inherited;

  328. end;


  329. destructor TServerConnectionTH.Destroy;

  330. begin

  331.   FSocket.Free;

  332.   FServerSocket.Free;

  333.   inherited;

  334. end;


  335. procedure TServerConnectionTH.execute;

  336. var

  337.   ASocket: TBluetoothSocket;

  338.   Msg: string;

  339. begin

  340.   while not Terminated do

  341.     try

  342.       ASocket := nil;

  343.       while not Terminated and (ASocket = nil) do

  344.         ASocket := FServerSocket.Accept(100);

  345.       if(ASocket <> nil) then

  346.       begin

  347.         FSocket := ASocket;

  348.         while not Terminated do

  349.         begin

  350.           FData := ASocket.ReadData;

  351.           if length(FData) > 0 then

  352.             Synchronize(procedure

  353.               begin

  354.                 Form1.DisplayR.Lines.Add(TEncoding.UTF8.GetString(FData));

  355.                 Form1.DisplayR.GoToTextEnd;

  356.               end);

  357.           sleep(100);

  358.         end;

  359.       end;

  360.     except

  361.       on E : Exception do

  362.       begin

  363.         Msg := E.Message;

  364.         Synchronize(procedure

  365.           begin

  366.             Form1.DisplayR.Lines.Add('Server Socket closed: ' + Msg);

  367.             Form1.DisplayR.GoToTextEnd;

  368.           end);

  369.       end;

  370.     end;

  371. end;


  372. end.

本文转载自:http://www.dfwlt.com/forum.php?mod=viewthread&tid=1380&extra=

vga

vga

粉丝 22
博文 364
码字总数 26421
作品 0
佳木斯
私信 提问
Delphi XE7 和C++有什么关系

Delphi XE7支持C++语言了吗?

ioeliwsa
2014/09/09
1K
5
Delphi条件编译时编译器的版本号

更早的版本忽略,我们从2006开始记录,相应的版本号判断方式: VER180 : Delphi 10.0 CodeGear 2006/2007 VER185 : Delphi 11.0 CodeGear 2007 VER190 : Delphi 12.0 CodeGear 2008 VER200 :......

simpower
2018/11/07
0
0
Android源码分析(六)-----蓝牙Bluetooth源码目录分析

一 :Bluetooth 的设置应用 packagesappsSettingssrccomandroidsettingsbluetooth* 蓝牙设置应用及设置参数,蓝牙状态,蓝牙设备等。 BluetoothDevicePreference.java 顾名思义,蓝牙设备首选...

—莫言—
05/20
0
0
delphi XE7 Update1 发布

http://altd.embarcadero.com/download/radstudio/xe7/delphicbuilderxe7upd1_win.iso

vga
2014/10/05
0
0
关于蓝牙技术—BR/EDR和Smart的十个区别,一文解答,值得收藏

随着物联网技术应用的普及,蓝牙技术也在快速的演进。对于蓝牙技术规格中的两大主要技术,如果你想进一步了解,本文将全面解析这两种技术之间的区别,加深你对蓝牙技术的了解! 关于Bluetoo...

昇润科技
2018/01/03
0
0

没有更多内容

加载失败,请刷新页面

加载更多

Android双向绑定原理简述

Android双向绑定原理简述 双向绑定涉及两个部分,即将业务状态的变化传递给UI,以及将用户输入信息传递给业务模型。 首先我们来看业务状态是如何传递给UI的。开启dataBinding后,编译器为布局...

tommwq
今天
4
0
Spring系列教程八: Spring实现事务的两种方式

一、 Spring事务概念: 事务是一系列的动作,它们综合在一起才是一个完整的工作单元,这些动作必须全部完成,如果有一个失败的话,那么事务就会回滚到最开始的状态,仿佛什么都没发生过一样。...

我叫小糖主
今天
8
0
CentOS 的基本使用

1. 使用 sudo 命令, 可以以 root 身份执行命令, 必须要在 /etc/sudoers 中定义普通用户 2. 设置 阿里云 yum 镜像, 参考 https://opsx.alibaba.com/mirror # 备份mv /etc/yum.repos.d/CentO...

北漂的我
昨天
4
0
Proxmox VE技巧 移除PVE “没有有效订阅” 的弹窗提示

登陆的时候提示没有有效的订阅You do not have a valid subscription for this server. Please visit www.proxmox.com to get a list of available options. 用的是免费版的,所以每次都提示......

以谁为师
昨天
5
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部