此文章是vip文章,如何查看?  

1,点击链接获取密钥 http://nicethemes.cn/product/view29882.html

2,在下方输入文章查看密钥即可立即查看当前vip文章


Delphi XE7的蓝牙 Bluetooth

  • 时间:
  • 浏览:
  • 来源:互联网
支持版本: Delphi XE7 
资源分类: 系统 
发布平台: Android 
转载地址: -
介绍

本文章介绍了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://element-ui.cn/news/show-577327.aspx