Delphi XE7的蓝牙 Bluetooth

标签：

顾名思义，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. 
   

3. interface
   

4. 
   

5. uses
   

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

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

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

9.   FMX.Edit, FMX.TabControl;
   

10. 
    

11. type
    

12. 
    

13.   TServerConnectionTH = class(TThread)
    

14.   private
    

15.     { Private declarations }
    

16.     FServerSocket: TBluetoothServerSocket;
    

17.     FSocket: TBluetoothSocket;
    

18.     FData: TBytes;
    

19.   protected
    

20.     procedure Execute; override;
    

21.   public
    

22.     { Public declarations }
    

23.     constructor Create(ACreateSuspended: Boolean);
    

24.     destructor Destroy; override;
    

25.   end;
    

26. 
    

27.   TForm1 = class(TForm)
    

28.     ButtonDiscover: TButton;
    

29.     ButtonPair: TButton;
    

30.     ButtonUnPair: TButton;
    

31.     ButtonPairedDevices: TButton;
    

32.     DisplayR: TMemo;
    

33.     Edit1: TEdit;
    

34.     Button2: TButton;
    

35.     FreeSocket: TButton;
    

36.     Labeldiscoverable: TLabel;
    

37.     ComboBoxDevices: TComboBox;
    

38.     ComboBoxPaired: TComboBox;
    

39.     Panel1: TPanel;
    

40.     TabControl1: TTabControl;
    

41.     TabItem1: TTabItem;
    

42.     TabItem2: TTabItem;
    

43.     LabelNameSarver: TLabel;
    

44.     ButtonServices: TButton;
    

45.     ComboBoxServices: TComboBox;
    

46.     PanelClient: TPanel;
    

47.     LabelClient: TLabel;
    

48.     ButtonConnectToRFCOMM: TButton;
    

49.     PanelServer: TPanel;
    

50.     ButtonCloseReadingSocket: TButton;
    

51.     ButtonOpenReadingSocket: TButton;
    

52.     LabelServer: TLabel;
    

53.     procedure ButtonDiscoverClick(Sender: TObject);
    

54.     procedure ButtonPairClick(Sender: TObject);
    

55.     procedure ButtonUnPairClick(Sender: TObject);
    

56.     procedure ButtonPairedDeviceClick(Sender: TObject);
    

57.     procedure FormShow(Sender: TObject);
    

58.     procedure ButtonOpenReadingSocketClick(Sender: TObject);
    

59.     procedure ButtonConnectToRFCOMMClick(Sender: TObject);
    

60.     procedure ButtonCloseReadingSocketClick(Sender: TObject);
    

61.     procedure Button2Click(Sender: TObject);
    

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

63.     procedure FreeSocketClick(Sender: TObject);
    

64.     function ManagerConnected:Boolean;
    

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

66.     procedure ComboBoxPairedChange(Sender: TObject);
    

67.     procedure ButtonServicesClick(Sender: TObject);
    

68.   private
    

69.     { Private declarations }
    

70.     FBluetoothManager: TBluetoothManager;
    

71.     FDiscoverDevices: TBluetoothDeviceList;
    

72.     FPairedDevices: TBluetoothDeviceList;
    

73.     FAdapter: TBluetoothAdapter;
    

74.     FData: TBytes;
    

75.     FSocket: TBluetoothSocket;
    

76.     ItemIndex: Integer;
    

77.     ServerConnectionTH: TServerConnectionTH;
    

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

79.     procedure PairedDevices;
    

80.     procedure SendData;
    

81.   public
    

82.     { Public declarations }
    

83.   end;
    

84. 
    

85. Const
    

86.   ServiceName = ‘Basic Text Server‘;
    

87.   ServiceGUI = ‘{B62C4E8D-62CC-404B-BBBF-BF3E3BBB1378}‘;
    

88. var
    

89.   Form1: TForm1;
    

90. 
    

91. implementation
    

92. 
    

93. {$R *.fmx}
    

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

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

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

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

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

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

100. 
     

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

102. begin
     

103.   if ManagerConnected then
     

104.     if ComboboxDevices.ItemIndex > -1 then
     

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

106.     else
     

107.       ShowMessage(‘No device selected‘);
     

108. end;
     

109. 
     

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

111. begin
     

112.   if ManagerConnected then
     

113.     if ComboboxPaired.ItemIndex > -1 then
     

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

115.     else
     

116.       ShowMessage(‘No Paired device selected‘);
     

117. end;
     

118. 
     

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

120. begin
     

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

122. end;
     

123. 
     

124. procedure TForm1.PairedDevices;
     

125. var
     

126.   I: Integer;
     

127. begin
     

128.   ComboboxPaired.Clear;
     

129.   if ManagerConnected then
     

130.   begin
     

131.   FPairedDevices := FBluetoothManager.GetPairedDevices;
     

132.   if FPairedDevices.Count > 0 then
     

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

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

135.   else
     

136.     ComboboxPaired.Items.Add(‘No Paired Devices‘);
     

137.   end;
     

138. end;
     

139. 
     

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

141. begin
     

142.   PairedDevices;
     

143.   ComboboxPaired.DropDown;
     

144. end;
     

145. 
     

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

147. var
     

148.   LServices: TBluetoothServiceList;
     

149.   LDevice: TBluetoothDevice;
     

150.   I: Integer;
     

151. begin
     

152.   ComboBoxServices.Clear;
     

153.   if ManagerConnected then
     

154.     if ComboboxPaired.ItemIndex > -1 then
     

155.     begin
     

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

157.       LServices := LDevice.GetServices;
     

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

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

160.       ComboBoxServices.ItemIndex := 0;
     

161.       ComboBoxServices.DropDown;
     

162.     end
     

163.     else
     

164.       ShowMessage(‘No paired device selected‘);
     

165. end;
     

166. 
     

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

168. begin
     

169.   FreeAndNil(FSocket);
     

170.   DisplayR.Lines.Add(‘Client socket set free‘);
     

171.   DisplayR.GoToLineEnd;
     

172. end;
     

173. 
     

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

175. begin
     

176.   DisplayR.ReadOnly := False;
     

177.   DisplayR.SelectAll;
     

178.   DisplayR.DeleteSelection;
     

179.   DisplayR.ReadOnly := True;
     

180. end;
     

181. 
     

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

183. var
     

184.   LServices: TBluetoothServiceList;
     

185.   LDevice: TBluetoothDevice;
     

186.   I: Integer;
     

187. begin
     

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

189.   LServices := LDevice.GetServices;
     

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

191.   begin
     

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

193.     begin
     

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

195.       break;
     

196.     end;
     

197.   end;
     

198. end;
     

199. 
     

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

201. begin
     

202.   if ManagerConnected then
     

203.     try
     

204.       SendData;
     

205.     except
     

206.       on E : Exception do
     

207.       begin
     

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

209.         DisplayR.GoToTextEnd;
     

210.         FreeAndNil(FSocket);
     

211.       end;
     

212.     end;
     

213. end;
     

214. 
     

215. function TForm1.ManagerConnected:Boolean;
     

216. begin
     

217.   if FBluetoothManager.ConnectionState = TBluetoothConnectionState.Connected then
     

218.   begin
     

219.     Labeldiscoverable.Text := ‘Device discoverable as "‘+FBluetoothManager.CurrentAdapter.AdapterName+‘"‘;
     

220.     Result := True;
     

221.   end
     

222.   else
     

223.   begin
     

224.     Result := False;
     

225.     DisplayR.Lines.Add(‘No Bluetooth device Found‘);
     

226.     DisplayR.GoToTextEnd;
     

227.   end
     

228. end;
     

229. 
     

230. procedure TForm1.SendData;
     

231. var
     

232.   ToSend: TBytes;
     

233.   LDevice: TBluetoothDevice;
     

234. begin
     

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

236.   begin
     

237.     if ComboboxPaired.ItemIndex > -1 then
     

238.     begin
     

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

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

241.       DisplayR.GoToTextEnd;
     

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

243.       if FSocket <> nil then
     

244.       begin
     

245.         ItemIndex := ComboboxPaired.ItemIndex;
     

246.         FSocket.Connect;
     

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

248.         FSocket.SendData(ToSend);
     

249.         DisplayR.Lines.Add(‘Text Sent‘);
     

250.         DisplayR.GoToTextEnd;
     

251.       end
     

252.       else
     

253.         ShowMessage(‘Out of time -15s-‘);
     

254.     end
     

255.     else
     

256.       ShowMessage(‘No paired device selected‘);
     

257.   end
     

258.   else
     

259.   begin
     

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

261.     FSocket.SendData(ToSend);
     

262.     DisplayR.Lines.Add(‘Text Sent‘);
     

263.     DisplayR.GoToTextEnd;
     

264.   end;
     

265. end;
     

266. 
     

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

268. begin
     

269.   ComboboxDevices.Clear;
     

270.   if ManagerConnected then
     

271.   begin
     

272.     FAdapter := FBluetoothManager.CurrentAdapter;
     

273.     FBluetoothManager.StartDiscovery(10000);
     

274.     FBluetoothManager.OnDiscoveryEnd := DevicesDiscoveryEnd;
     

275.   end;
     

276. end;
     

277. 
     

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

279. var
     

280.   I: Integer;
     

281. begin
     

282.   FDiscoverDevices := ADevices;
     

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

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

285.   ComboboxDevices.ItemIndex := 0;
     

286. end;
     

287. 
     

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

289. begin
     

290.   if (ServerConnectionTH = nil) and ManagerConnected then
     

291.   begin
     

292.     try
     

293.       FAdapter := FBluetoothManager.CurrentAdapter;
     

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

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

296.       ServerConnectionTH.Start;
     

297.       DisplayR.Lines.Add(‘ - Service created: "‘+ServiceName+‘"‘);
     

298.       DisplayR.GoToTextEnd;
     

299.     except
     

300.       on E : Exception do
     

301.       begin
     

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

303.         DisplayR.GoToTextEnd;
     

304.       end;
     

305.     end;
     

306.   end;
     

307. end;
     

308. 
     

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

310. begin
     

311.   if ServerConnectionTH <> nil then
     

312.   begin
     

313.     ServerConnectionTH.Terminate;
     

314.     ServerConnectionTH.WaitFor;
     

315.     FreeAndNil(ServerConnectionTH);
     

316.     DisplayR.Lines.Add(‘ - Service removed -‘);
     

317.     DisplayR.GoToTextEnd;
     

318.   end
     

319. end;
     

320. 
     

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

322. begin
     

323.   try
     

324.     LabelServer.Text := ServiceName;
     

325.     LabelClient.Text := ‘Client of ‘+ServiceName;
     

326.     FBluetoothManager := TBluetoothManager.Current;
     

327.     FAdapter := FBluetoothManager.CurrentAdapter;
     

328.     if ManagerConnected then
     

329.     begin
     

330.       PairedDevices;
     

331.       ComboboxPaired.ItemIndex := 0;
     

332.     end;
     

333.   except
     

334.     on E : Exception do
     

335.     begin
     

336.       ShowMessage(E.Message);
     

337.     end;
     

338.   end;
     

339. end;
     

340. 
     

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

342. begin
     

343.   if ServerConnectionTH <> nil then
     

344.   begin
     

345.     ServerConnectionTH.Terminate;
     

346.     ServerConnectionTH.WaitFor;
     

347.     FreeAndNil(ServerConnectionTH);
     

348.   end
     

349. end;
     

350. 
     

351. {TServerConnection}
     

352. 
     

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

354. begin
     

355.   inherited;
     

356. end;
     

357. 
     

358. destructor TServerConnectionTH.Destroy;
     

359. begin
     

360.   FSocket.Free;
     

361.   FServerSocket.Free;
     

362.   inherited;
     

363. end;
     

364. 
     

365. procedure TServerConnectionTH.execute;
     

366. var
     

367.   ASocket: TBluetoothSocket;
     

368.   Msg: string;
     

369. begin
     

370.   while not Terminated do
     

371.     try
     

372.       ASocket := nil;
     

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

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

375.       if(ASocket <> nil) then
     

376.       begin
     

377.         FSocket := ASocket;
     

378.         while not Terminated do
     

379.         begin
     

380.           FData := ASocket.ReadData;
     

381.           if length(FData) > 0 then
     

382.             Synchronize(procedure
     

383.               begin
     

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

385.                 Form1.DisplayR.GoToTextEnd;
     

386.               end);
     

387.           sleep(100);
     

388.         end;
     

389.       end;
     

390.     except
     

391.       on E : Exception do
     

392.       begin
     

393.         Msg := E.Message;
     

394.         Synchronize(procedure
     

395.           begin
     

396.             Form1.DisplayR.Lines.Add(‘Server Socket closed: ‘ + Msg);
     

397.             Form1.DisplayR.GoToTextEnd;
     

398.           end);
     

399.       end;
     

400.     end;
     

401. end;
     

402. 
     

403. end.

Delphi XE7的蓝牙 Bluetooth

标签：

原文地址：http://my.oschina.net/u/582827/blog/381290