Библиотека для работы с BlueTooth

Code:

{

Copyright (C)  Mike B. Petrichenko

Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.

Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.

All Rights Reserved.

Only for non commercial purpose.

}

unit BTDevice;

interface

uses

BTRadio, BluetoothAPI, Windows;

type

TBTDeviceSearchFlag = (sfReturnAuthenticated, sfReturnRemembered,

                        sfReturnUnknown, sfReturnConnected);

TBTDeviceSearchFlags = set of TBTDeviceSearchFlag;

TBTDeviceSelectFlag = (dsForceAuthentication, dsShowAuthenticated,

                        dsShowRemembered, dsShowUnknown, dsAddNewDeviceWizard,

                        dsSkipServicesPage);

TBTDeviceSelectFlags = set of TBTDeviceSelectFlag;

TBTAuthenticateEvent = procedure (Sender: TObject; var Pwd: string);

TBTDevice = class

private

   FAddress: BTH_ADDR;

   FAuReg: HBLUETOOTH_AUTHENTICATION_REGISTRATION;

   FBTRadio: TBTRadio;

   FOnAuthenticate: TBTAuthenticateEvent;

   function GetAuthenticated: boolean;

   function GetClassOfDevice: cardinal;

   function GetConnected: boolean;

   function GetDeviceInfo: BLUETOOTH_DEVICE_INFO;

   function GetLastSeen: TDateTime;

   function GetLastUsed: TDateTime;

   function GetName: string;

   function GetRemembered: boolean;

   procedure SetOnAuthenticate(const Value: TBTAuthenticateEvent);

   procedure DoAuthenticate;

protected

   property DeviceInfo: BLUETOOTH_DEVICE_INFO read GetDeviceInfo;

public

   constructor Create(const Addr: BTH_ADDR; const ABTRadio: TBTRadio);

   destructor Destroy; override;

   procedure Authenticate(const Pwd: string);

   procedure DisplayProperties;

   procedure Remove;

   procedure Select(const FLags: TBTDeviceSelectFlags);

   procedure Update(const NewName: string);

   property Address: BTH_ADDR read FAddress;

   property Authenticated: boolean read GetAuthenticated;

   property BTRadio: TBTRadio read FBTRadio;

   property ClassofDevice: cardinal read GetClassOfDevice;

   property Connected: boolean read GetConnected;

   property LastSeen: TDateTime read GetLastSeen;

   property LastUsed: TDateTime read GetLastUsed;

   property Name: string read GetName;

   property Remembered: boolean read GetRemembered;

   property OnAuthenticate: TBTAuthenticateEvent read FOnAuthenticate write SetOnAuthenticate;

end;

function BTGetDeviceByAddr(const Addr: BTH_ADDR; const ABTRadio: TBTRadio): TBTDevice;

procedure BTEnumDevices(const BTRadio: TBTRadio; const SearchFlags: TBTDeviceSearchFlags; var Devices: TBTAddrArray);

implementation

uses

BTExceptions, BTStrings, SysUtils;

function BTAuCallBack(pvParam: Pointer; pDevice: PBLUETOOTH_DEVICE_INFO): BOOL; stdcall;

begin

TBTDevice(pvParam).DoAuthenticate;

Result := true;

end;

function BTGetDeviceByAddr(const Addr: BTH_ADDR; const ABTRadio: TBTRadio): TBTDevice;

begin

  if (not Assigned(ABTRadio)) then raise BTException.Create(STR_ERROR_INVALID_PARAMETER);

  Result := TBTDevice.Create(Addr, ABTRadio);

end;

procedure BTEnumDevices(const BTRadio: TBTRadio; const SearchFlags: TBTDeviceSearchFlags; var Devices: TBTAddrArray);

var

hFind: HBLUETOOTH_DEVICE_FIND;

SearchParams: BLUETOOTH_DEVICE_SEARCH_PARAMS;

SearchParamsSize: dword;

DeviceInfo: BLUETOOTH_DEVICE_INFO;

DeviceInfoSize: dword;

Ndx: word;

begin

if (not Assigned(BTRadio)) then raise BTException.Create(STR_ERROR_INVALID_PARAMETER);

Ndx := 0;

SearchParamsSize := SizeOf(BLUETOOTH_DEVICE_SEARCH_PARAMS);

FillChar(SearchParams, SearchParamsSize, 0);

with SearchParams do begin

   dwSize := SearchParamsSize;

   hRadio := BTRadio.Handle;

   fReturnAuthenticated := (sfReturnAuthenticated in SearchFlags);

   fReturnRemembered := (sfReturnRemembered in SearchFlags);

   fReturnUnknown := (sfReturnUnknown in SearchFlags);

   fReturnConnected := (sfReturnConnected in SearchFlags);

end;

DeviceInfoSize := SizeOf(BLUETOOTH_DEVICE_INFO);

FillChar(DeviceInfo, DeviceInfoSize, 0);

DeviceInfo.dwSize := DeviceInfoSize;

hFind :=  BluetoothFindFirstDevice(SearchParams, DeviceInfo);

if (hFind <> 0) then begin

   repeat

     Inc(Ndx);

     SetLength(Devices, Ndx);

     Devices[Ndx - 1] := DeviceInfo.Address.ullLong;

     FillChar(DeviceInfo, DeviceInfoSize, 0);

     DeviceInfo.dwSize := DeviceInfoSize;

   until (not BluetoothFindNextDevice(hFind, DeviceInfo));

   BluetoothFindDeviceClose(hFind);

end;

end;

function TBTDevice.GetAuthenticated: boolean;

begin

Result := boolean(GetDeviceInfo.fAuthenticated);

end;

function TBTDevice.GetClassOfDevice: cardinal;

begin

Result := GetDeviceInfo.ulClassofDevice;

end;

function TBTDevice.GetConnected: boolean;

begin

Result := boolean(GetDeviceInfo.fConnected);

end;

function TBTDevice.GetDeviceInfo: BLUETOOTH_DEVICE_INFO;

var

DeviceInfoSize: dword;

Res: dword;

begin

DeviceInfoSize := SizeOf(BLUETOOTH_DEVICE_INFO);

FillChar(Result, DeviceInfoSize, 0);

with Result do begin

   dwSize := DeviceInfoSize;

   Address.ullLong := FAddress;

end;

Res := BluetoothGetDeviceInfo(FBTRadio.Handle, Result);

if (Res <> ERROR_SUCCESS) then

   case Res of

     ERROR_REVISION_MISMATCH: raise BTException.Create(STR_ERROR_REVISION_MISMATCH_DEV);

     ERROR_INVALID_PARAMETER: raise BTException.Create(STR_ERROR_INVALID_PARAMETER_DEV);

   else

     RaiseLastOSError;

   end;

end;

function TBTDevice.GetLastSeen: TDateTime;

begin

Result := SystemTimeToDateTime(GetDeviceInfo.stLastSeen);

end;

function TBTDevice.GetLastUsed: TDateTime;

begin

Result := SystemTimeToDateTime(GetDeviceInfo.stLastUsed);

end;

function TBTDevice.GetName: string;

begin

Result := string(widestring(GetDeviceInfo.szName));

end;

function TBTDevice.GetRemembered: boolean;

begin

Result := boolean(GetDeviceInfo.fRemembered);

end;

procedure TBTDevice.SetOnAuthenticate(const Value: TBTAuthenticateEvent);

procedure Unreg;

begin

   if (FAuReg <> 0) then

     if (not BluetoothUnregisterAuthentication(FAuReg)) then

       RaiseLastOsError;

   FAuReg := 0;

   FOnAuthenticate := nil;

end;

begin

if Assigned(Value) then begin

   Unreg;

   if (BluetoothRegisterForAuthentication(GetDeviceInfo, FAuReg, BTAuCallBack, Self) <> ERROR_SUCCESS) then begin

     FAuReg := 0;

     RaiseLastOSError;

   end;

   FOnAuthenticate := Value;

end else

   Unreg;

end;

procedure TBTDevice.DoAuthenticate;

var

Pwd: string;

begin

if Assigned(FOnAuthenticate) then begin

   FOnAuthenticate(Self, Pwd);

   BluetoothSendAuthenticationResponse(FBTRadio.Handle, GetDeviceInfo, pwidechar(widestring(Pwd)));

end;

end;

constructor TBTDevice.Create(const Addr: BTH_ADDR; const ABTRadio: TBTRadio);

begin

if (not Assigned(FBTRadio)) then raise BTException.Create(STR_ERROR_INVALID_PARAMETER);

FAddress := Addr;

FAuReg := 0;

FBTRadio := ABTRadio;

FOnAuthenticate := nil;

end;

destructor TBTDevice.Destroy;

begin

if Assigned(FOnAuthenticate) then OnAuthenticate := nil;

inherited;

end;

procedure TBTDevice.Authenticate(const Pwd: string);

var

Res: dword;

PPwd: pwidechar;

PPwdLength: dword;

begin

if (Pwd = '') then begin

   PPwd := nil;

   PPwdLength := 0;

end else begin

   PPwd := pwidechar(widestring(Pwd));

   PPwdLength := Length(WideString(Pwd));

end;

Res := BluetoothAuthenticateDevice(0, FBTRadio.Handle, GetDeviceInfo, PPwd, PPwdLength);

if (Res <> ERROR_SUCCESS) then RaiseLastOsError;

end;

procedure TBTDevice.DisplayProperties;

begin

if (not BluetoothDisplayDeviceProperties(0, GetDeviceInfo)) then RaiseLastOsError;

end;

procedure TBTDevice.Remove;

var

Addr: BLUETOOTH_ADDRESS;

begin

Addr.ullLong := FAddress;

if (BluetoothRemoveDevice(Addr) <> ERROR_SUCCESS) then RaiseLastOsError;

end;

procedure TBTDevice.Select(const FLags: TBTDeviceSelectFlags);

var

SelectParams: BLUETOOTH_SELECT_DEVICE_PARAMS;

SelectParamsSize: dword;

Res: dword;

begin

SelectParamsSize := SizeOf(BLUETOOTH_SELECT_DEVICE_PARAMS);

FillChar(SelectParams, SelectParamsSize, 0);

with SelectParams do begin

   dwSize := SelectParamsSize;

   fForceAuthentication := (dsForceAuthentication in Flags);

   fShowAuthenticated := (dsShowAuthenticated in Flags);

   fShowRemembered := (dsShowRemembered in Flags);

   fShowUnknown := (dsShowUnknown in Flags);

   fAddNewDeviceWizard := (dsAddNewDeviceWizard in Flags);

   fSkipServicesPage := (dsSkipServicesPage in Flags);

end;

if BluetoothSelectDevices(@SelectParams) then begin

   FAddress := BLUETOOTH_DEVICE_INFO(SelectParams.pDevices).Address.ullLong;

   BluetoothSelectDevicesFree(@SelectParams);

end else begin

   Res := GetLastError;

   if (Res <> ERROR_CANCELLED) then

     case Res of

       ERROR_INVALID_PARAMETER: raise BTException.Create(STR_ERROR_INVALID_PARAMETER_SEL);

       ERROR_REVISION_MISMATCH: raise BTException.Create(STR_ERROR_REVISION_MISMATCH_SEL);

     else

       RaiseLastOSError;

     end;

end;

end;

procedure TBTDevice.Update(const NewName: string);

var

DeviceInfo: BLUETOOTH_DEVICE_INFO;

DeviceInfoSize: dword;

Res: dword;

begin

DeviceInfoSize := SizeOf(BLUETOOTH_DEVICE_INFO);

FillChar(DeviceInfo, DeviceInfoSize, 0);

with DeviceInfo do begin

   dwSize := DeviceInfoSize;

   Address.ullLong := FAddress;

   lstrcpyw(szName, pwidechar(widestring(NewName)));

end;

Res := BluetoothUpdateDeviceRecord(DeviceInfo);

if (Res <> ERROR_SUCCESS) then

   case Res of

     ERROR_INVALID_PARAMETER: raise BTException.Create(STR_ERROR_INVALID_PARAMETER_DEV);

     ERROR_REVISION_MISMATCH: raise BTException.Create(STR_ERROR_REVISION_MISMATCH_DEV);

   else

     RaiseLastOsError;

   end;

end;

end.