Delphi XE7的蓝牙 Bluetooth

分类：Delphi作者：编程之家用户

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

版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。

相关推荐

Delphi API HOOK完全说明(存在错误的原文，含修正)
 从网上看到《Delphi API HOOK完全说明》这篇文章，基本上都是大家转来转去，原文出处我已经找不到了。这篇文章写的很不错，但最后部分“PermuteFunction 的终极版本”描述的不太清楚，完全按照该文章代码执行，是不行的。可能是作者故意这样做的？本文最后提供修正后的下载地址。原文如下：一、关于API Hook1.什么是API Hook不知道大家是否还记得，在DO
Delphi API HOOK完全说明(修正及说明)
  从网上看到《Delphi API HOOK完全说明》这篇文章，基本上都是大家转来转去，原文出处我已经找不到了。 这篇文章写的很不错，但最后部分“PermuteFunction 的终极版本”描述的不太清楚，完全按照该文章代码执行，是不行的。需要修改mess.pas中代码才行。其实文中提到的一个结构，代码中并没有使用typePIMAGE_IMPORT_DESCRIPTOR = ^IMA
ffmpeg 部分api delphi 版
ffmpeg 是一套强大的开源的多媒体库 一般都是用 c/c++ 调用， 抽空研究了一下该库的最新版 ，把部分api 翻译成了dephi版的 记录一下 地址 ffmpegvcl.zip
寄存器备忘
32位CPU所含有的寄存器有：4个数据寄存器(EAX、EBX、ECX和EDX)2个变址和指针寄存器(ESI和EDI) 2个指针寄存器(ESP和EBP)6个段寄存器(ES、CS、SS、DS、FS和GS)
键位码
指令整理
1 mov dst, src dst是目的操作数，src是源操作数，指令实现的功能是：将源操作数送到目的操作数中，即：(dst) &lt;--(src) 1.dst和src类型必须匹配，即必须同为字节
delphi中ShellExecute使用详解
有三个API函数可以运行可执行文件WinExec、ShellExecute和CreateProcess。 1.CreateProcess因为使用复杂，比较少用。 2.WinExec主要运行EXE文件。如：WinExec('Notepad.exe Readme.txt', SW_SHOW); 3.ShellExecute不仅可以运行EXE文件，也可以运行已经关联的文件。 首先必须引用shellapi
API函数MoveFileEx使用详解(delphi)
API原型: Declare Function MoveFileEx& Lib "kernel32" Alias "MoveFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal dwFlags As Long) 参数 类型及说明 lpExistingFileName String，欲移
delphi控件安装与删除
附带通用控件安装方法： ---------- 基本安装 1、对于单个控件，Componet-->install component..-->PAS或DCU文件-->install; 2、对于带*.dpk文件的控件包，File-->Open(下拉列表框中选*.dpk)-->install即可； 3、对于带*.bpl文件的控件包，Install Packages-->Add-->bpl文件名即可； 4
Delphi 怎样 把TParams 或 record写到流里面
type   TRec=Record     msg:string;     pic:TMemoryStream; end; procedure TForm2.BitBtn1Click(Sender: TObject); var   ms:TMemoryStream;   Rec1,Rec2:TRec;   cc:tmemorystream;   jpg:TJPEGImage; begin   R
一个用delphi写的整合汇编与api的简单的窗口程序
program Project1; { Types and Structures Definition } type   WNDCLASSEX = packed record     cbSize: LongWord;     style: LongWord;     lpfnWndProc: Pointer;     cbClsExtra: Integer;     cbWndExtra: In
用Delphi模拟键盘输入
   在Windows大行其道的今天，windows界面程序受到广大用户的欢迎。对这些程序的操作不外乎两种，键盘输入控制和鼠标输入控制。有时，对于繁杂 的，或重复性的操作，我们能否通过编制程序来代替手工输入，而用程序来模拟键盘及鼠标的输入呢？答案是肯定的。这主要是通过两个API函数来实现的。 　　 　　下面以Delphi为例来介绍一下如何实现这两个功能。模拟键盘我们用Keybd_event这个ap
Delphi 中的 procedure of object
delphi中经常见到以下两种定义 Type TMouseProc = procedure (X,Y:integer); TMouseEvent = procedure (X,Y:integer) of Object; 两者样子差不多但实际意义却不一样, TMouseProc只是单一的函数指针类型; TMouseEvent是对象的函数指针,也就是对象/类的函数/方法 区
delphi创建具有托盘的服务程序service
Windows 2000/XP和2003等支持一种叫做"服务程序"的东西.程序作为服务启动有以下几个好处:     (1)不用登陆进系统即可运行.     (2)具有SYSTEM特权.所以你在进程管理器里面是无法结束它的.     笔者在2003年为一公司开发机顶盒项目的时候,曾经写过课件上传和媒体服务,下面就介绍一下如何用Delphi7创建一个Service程序.     运行Delphi7,选
delphi服务程序(service)的调试方法
方法一： 1.调试delphi 写的服务程序，有这么一个办法。原来每次都是用attach to process方法，很麻烦。并且按照服务线程的执行线路，可能会停不到想要的断点。笨办法是，在procedure TsvcFrm.ServiceExecute(Sender: TService);中想要下断的语句前加个人定胜天的sleep(20000)，但实际上这种办法是主观臆测的。可行，没问题。记得大学
Delphi For iOS开发指南(17):让应用程序禁止竖屏(也就是只显示横屏)
Delphi For iOS开发指南(17):让应用程序禁止竖屏(也就是只显示横屏)     最近好多人问，怎么样让Delphi For iOS开发的应用程序禁止竖屏，也就是想让它一直横屏显示，横屏是好，一行可以放好几个控件，表格的话也可以多显示几列，看起来方便。 只要一句代码就可以让Delphi For iOS开发的应用程序禁止竖屏，如下： Application.FormFactor.Orie
一个比较完整的Inno Setup 安装脚本
一个比较完整的Inno Setup 安装脚本，增加了对ini文件设置的功能，一个安装包常用的功能都具备了。 [Setup] ; 注: AppId的值为单独标识该应用程序。 ; 不要为其他安装程序使用相同的AppId值。 ; (生成新的GUID，点击 工具|在IDE中生成GUID。) AppId={{A9861883-31C5-4324-BD9A-DC3271EEB675} ;程序名 AppName
Delphi6-xe5 中的MD5实现方法
在Delphi自带的Indy控件中其实是提供了MD2,MD4,MD5对象的，我们可以直接使用它们来完成MD5的签名算法。而不需要再去找其它的DLL或是Pas了。 在Uses单元中引用 IdHashMessageDigest,IdGlobal, IdHash 单元，再写如下代码即可以达到MD5的实现。 示例代码 procedure TForm1.Button1Click(Sender: TObjec
Delphi 7下最小化到系统托盘
在Delphi 7下要制作系统托盘，只能制作一个比较简单的系统托盘，因为ShellAPI文件定义的TNotifyIconData结构体是比较早的版本。定义如下： 1 2 3 4 5 6 7 8 9 _NOTIFYICONDATAA = record    cbSize: DWORD;    Wnd: HWND;    uID: UINT;    uFlags: UINT;    uCallback
Delphi中的Type
声明： 1. type Name = Existing type; 2. type Name = type Existing type; 3. type Name = (EnumValue1 [=value], EnumValue2 [=value] ...); 4. type Name = Expression1..Expression2; 5. type Name = ^Existing ty
pythonJavaScriptjavaHTMLPHPreactjsC#AndroidCSSNode.jssqlrpython-3.xMysqLjQueryc++pandasFlutterangularIOSdjangolinuxswifttypescript路由器JSON路由器设置无线路由器h3c华三华三路由器设置华三路由器电脑软件教程arraysdocker软件图文教程Cvue.jslaravelspring-boot