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
TBluetoothService = record Name: string; UUID: TBluetoothUUID; end;
TBluetoothServiceList服務列表 = class(TList<TBluetoothService>);可通過TBluetoothDevice.GetServices獲得遠端設備服務列表
TBluetoothSocket藍牙通訊套接字,通過 TBluetoothDevice.CreateClientSocket(StringToGUID(ServiceGUI), True/False)創建,
下面是一個XE7自帶的例子,記得在Android下把相關權限添加到工程設置中。
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; 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; end end; 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; end end; 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); end end; {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 end end
沒有啊.大牛們都不放手.我等小人物只能苦苦等Xe6到來時.可能大牛們就放xe5 update2補丁了.
最新電腦常見術語速查手冊
陳英
在使用電腦的過程中,面對一些相對專業的名詞術語和專業縮略語,經常搞得人雲裡霧裡。本手冊按字母序作為索引,收錄詞目200余條,在內容上力求涵蓋電腦應用的方方面面,希望能對你在使用電腦的過程中有所幫助。
●Aactive Network(動態網絡)
動態網絡是這樣一種網絡,該網絡上的各個節點經過編程處理,可以依據通過該節點的信息執行定制化的任務。例如,一個節點可以經過編程或者定制化處理,以一個單獨用戶為基礎處置信息包,或者處置不同於其他信息包的多點傳送信息包。動態網絡的這種處理方法,在一個由移動用戶構成的網絡中顯得特別重要。
●AC 97(音響數字/模擬轉換)
AC 97即音響數字/模擬轉換97。AC 97能使PC與一般音響系統相容,以配合家用電器的標准。該規格支持一些新的功能,如支持Modem等。
●Access Control(訪問控制)
按用戶身份及其所歸屬的某預定義組來限制用戶對某些信息項的訪問,或限制對某些控制功能的使用。訪問控制通常用於系統管理員控制用戶對服務器、目錄、文件等網絡資源的訪問。
●ACL(訪問控制表)
ACL(Access Control List,訪問控制表)。用戶和設備可以訪問的那些現有服務和信息的列表。用戶必須具有相應的授權才能修改目標的ACL。通常要求用戶提供注冊姓名和口令,它是用來保證系統安全性的一種手段。
●ACOPS(自動CPU過熱保護)
ACOPS(Automatic CPU Overheat Prevention System)特指一類計算機主板的一種功能。此類主板在CPU插槽的中央有一個溫度傳感器,當CPU散熱不佳或散熱風扇不轉導致CPU溫度超出安全范圍時,系統會通過喇叭發出警告並自動執行降溫程序。ACOPS有自己獨立的電路和軟件,無需任何驅動程序來啟動。
●Active Directory(活動目錄)
Active Directory是Windows 2000的目錄服務,它取代了Windows NT 4.0版中的安全賬戶管理器(SAM)。Active Directory由目錄林、域、組織單位、容器和對象等組成。
●ADSL(非對稱數字用戶線路)
非對稱數字用戶線路。這種DSL叫做非對稱DSL,將成為廣大家庭和小型商業客戶最熟悉的一種DSL。ADSL(Asymmetrical Digital Subscriber Loop)之所以叫做非對稱是因為它的兩個雙工通道都用來向用戶傳輸數據。僅有很小一部分帶寬用來回送用戶的信息。然而,大部Internet特別是富於圖形和多媒體Web數據需要很大的下傳帶寬,同時用戶信息相對比較少,上傳的帶寬也不要很大。使用ADSL時,下傳的速率可以達到6.1Mbps,而上傳速率也可以達到640Kbps。高的下傳速率意味著你的電話可以傳輸動畫,聲音和立體圖形。另外,一小部分的帶寬可以用來傳輸語音信號,你可以同時打電話而不用再使用第二條電話線。不象電視線路提供的相同的服務,使用ADSL,你不需要和你的鄰居爭用帶寬。有時候,現有的電話線可以使用ADSL,而有時候卻要升級,除非電話公司提供了無分離器的ADSL,你就必須安裝一個DSL調制解調器。
●AGP(加速圖形接口)
AGP是一種接口規范,可以使3D圖形在普通個人電腦上以更快的速度顯示。AGP是一種設計用來更快,更平穩地傳送3D圖形的接口。它使用普通個人電腦的主內存來刷新顯示器顯示的圖像,支持紋理貼圖,零緩沖和阿爾法混合等3D圖形技術。
AGP接口對主內存的......余下全文>>