【Delphi】使用Windows 中的蓝牙功能

要在 Delphi 中实现一个完整的蓝牙操作程序，包括蓝牙设备的发现、配对、连接和数据发送，您可以使用 Windows 的 Bluetooth API。此 API 提供了用于蓝牙通信的各类函数。以下是一个演示程序，它展示了如何发现、配对、连接和发送数据。

主要步骤

1. 发现蓝牙设备
2. 配对蓝牙设备
3. 连接蓝牙设备
4. 发送数据

步骤 1：创建项目并引入必要的单元

在 Delphi 中，创建一个新的 VCL 项目，确保引入必要的 Windows API 单元：

uses
  Winapi.Windows, Winapi.Bluetooth, System.SysUtils, Vcl.StdCtrls, Vcl.Forms;

步骤 2：发现蓝牙设备

首先，创建一个函数来查找附近的蓝牙设备。这个函数会列出所有可用的蓝牙设备。

procedure DiscoverBluetoothDevices;
var
  RadioFindParams: BLUETOOTH_FIND_RADIO_PARAMS;
  DeviceInfo: BLUETOOTH_DEVICE_INFO;
  DeviceFindParams: BLUETOOTH_DEVICE_SEARCH_PARAMS;
  RadioHandle: HBLUETOOTH_RADIO_FIND;
  DeviceFindHandle: HBLUETOOTH_DEVICE_FIND;
  Radio: THandle;
begin
  ZeroMemory(@RadioFindParams, SizeOf(RadioFindParams));
  RadioFindParams.dwSize := SizeOf(RadioFindParams);

  // 查找第一个蓝牙电台
  RadioHandle := BluetoothFindFirstRadio(@RadioFindParams, Radio);
  if RadioHandle = 0 then
  begin
    ShowMessage('No Bluetooth radios found.');
    Exit;
  end;

  try
    ZeroMemory(@DeviceFindParams, SizeOf(DeviceFindParams));
    DeviceFindParams.dwSize := SizeOf(DeviceFindParams);
    DeviceFindParams.hRadio := Radio;
    DeviceFindParams.fReturnAuthenticated := True;
    DeviceFindParams.fReturnRemembered := True;
    DeviceFindParams.fReturnConnected := True;
    DeviceFindParams.fReturnUnknown := True;

    ZeroMemory(@DeviceInfo, SizeOf(DeviceInfo));
    DeviceInfo.dwSize := SizeOf(DeviceInfo);

    // 查找设备
    DeviceFindHandle := BluetoothFindFirstDevice(@DeviceFindParams, DeviceInfo);
    if DeviceFindHandle <> 0 then
    begin
      repeat
        ShowMessage('Device found: ' + DeviceInfo.szName);
      until not BluetoothFindNextDevice(DeviceFindHandle, DeviceInfo);

      BluetoothFindDeviceClose(DeviceFindHandle);
    end
    else
      ShowMessage('No Bluetooth devices found.');
  finally
    BluetoothFindRadioClose(RadioHandle);
  end;
end;

步骤 3：配对蓝牙设备

接下来，创建一个函数来配对设备。您需要先找到设备，然后使用 BluetoothAuthenticateDevice 进行配对。

function PairBluetoothDevice(const DeviceInfo: BLUETOOTH_DEVICE_INFO): Boolean;
var
  hRadio: THandle;
  RadioInfo: BLUETOOTH_RADIO_INFO;
begin
  ZeroMemory(@RadioInfo, SizeOf(RadioInfo));
  RadioInfo.dwSize := SizeOf(RadioInfo);

  // 获取蓝牙电台信息
  if BluetoothGetRadioInfo(hRadio, @RadioInfo) = ERROR_SUCCESS then
  begin
    // 配对设备
    if BluetoothAuthenticateDevice(0, hRadio, @DeviceInfo, nil, MITMProtectionNotRequired) = ERROR_SUCCESS then
    begin
      Result := True;
      ShowMessage('Device paired: ' + DeviceInfo.szName);
    end
    else
    begin
      Result := False;
      ShowMessage('Failed to pair with device.');
    end;
  end
  else
    Result := False;
end;

步骤 4：连接蓝牙设备

连接蓝牙设备通常通过蓝牙串口服务进行。在 Windows 下，配对成功的蓝牙设备会分配一个虚拟串口号，您可以使用该串口号进行数据通信。

function ConnectToBluetoothDevice(const ComPort: string): THandle;
var
  DCB: TDCB;
  CommTimeouts: TCOMMTIMEOUTS;
  hComm: THandle;
begin
  // 打开蓝牙设备的虚拟串口
  hComm := CreateFile(PChar('\\.\' + ComPort), GENERIC_READ or GENERIC_WRITE,
    0, nil, OPEN_EXISTING, 0, 0);

  if hComm = INVALID_HANDLE_VALUE then
  begin
    ShowMessage('Failed to connect to the Bluetooth device.');
    Exit(INVALID_HANDLE_VALUE);
  end;

  // 配置串口通信参数
  GetCommState(hComm, DCB);
  DCB.BaudRate := CBR_9600; // 设置波特率
  DCB.ByteSize := 8;        // 数据位
  DCB.Parity := NOPARITY;   // 校验位
  DCB.StopBits := ONESTOPBIT; // 停止位
  SetCommState(hComm, DCB);

  // 设置通信超时
  GetCommTimeouts(hComm, CommTimeouts);
  CommTimeouts.ReadIntervalTimeout := MAXDWORD;
  CommTimeouts.ReadTotalTimeoutMultiplier := 0;
  CommTimeouts.ReadTotalTimeoutConstant := 1000;
  CommTimeouts.WriteTotalTimeoutMultiplier := 0;
  CommTimeouts.WriteTotalTimeoutConstant := 1000;
  SetCommTimeouts(hComm, CommTimeouts);

  Result := hComm;
end;

步骤 5：发送数据

通过打开的串口句柄，可以使用 WriteFile 函数发送数据到蓝牙设备。

procedure SendDataToBluetoothDevice(hComm: THandle; const Data: string);
var
  BytesWritten: DWORD;
begin
  if WriteFile(hComm, PAnsiChar(AnsiString(Data))^, Length(Data), BytesWritten, nil) then
    ShowMessage('Data sent: ' + Data)
  else
    ShowMessage('Failed to send data.');
end;

完整示例：蓝牙设备发现、配对、连接和发送数据

procedure TForm1.ButtonDiscoverClick(Sender: TObject);
begin
  DiscoverBluetoothDevices;
end;

procedure TForm1.ButtonPairClick(Sender: TObject);
var
  DeviceInfo: BLUETOOTH_DEVICE_INFO;
begin
  // 假设已经找到设备并存储在 DeviceInfo
  PairBluetoothDevice(DeviceInfo);
end;

procedure TForm1.ButtonConnectClick(Sender: TObject);
var
  hComm: THandle;
begin
  // 假设配对成功后，虚拟串口号为 COM3
  hComm := ConnectToBluetoothDevice('COM3');
  if hComm <> INVALID_HANDLE_VALUE then
    SendDataToBluetoothDevice(hComm, 'Hello Bluetooth!');
end;

总结

• 蓝牙发现：使用 BluetoothFindFirstDevice 和 BluetoothFindNextDevice 列出附近的蓝牙设备。
• 蓝牙配对：使用 BluetoothAuthenticateDevice 进行设备的配对。
• 蓝牙连接：通过虚拟串口连接配对后的蓝牙设备。
• 发送数据：使用 WriteFile 向连接的蓝牙设备发送数据。

在实际应用中，您需要处理错误检测和不同设备的兼容性问题，例如确保正确的设备驱动程序已经安装，并且设备支持的通信协议兼容。