Platforms to show: All Mac Windows Linux Cross-Platform
/WinFrameworks/Bluetooth/BluetoothLE Device
Required plugins for this example: MBS WinFrameworks Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /WinFrameworks/Bluetooth/BluetoothLE Device
This example is the version from Mon, 10th Sep 2023.
Project "BluetoothLE Device.xojo_binary_project"
Class App Inherits DesktopApplication
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
End Class
Class MainWindow Inherits DesktopWindow
Control List Inherits DesktopListBox
ControlInstance List Inherits DesktopListBox
End Control
EventHandler Sub Opening()
#If TargetWindows
// find device
log "Waiting for device..."
Watcher = new WindowsBluetoothLEAdvertisementWatcher
watcher.ScanningMode = Watcher.ScanningModeActive
watcher.list = list
Watcher.Start
'Dim BluetoothAddress As UInt64 = &h4EE3E408B94A // you need to change this!
'FromBluetoothAddress BluetoothAddress
#Else
Log "Please run on Windows."
#EndIf
End EventHandler
Sub FromBluetoothAddress(BluetoothAddress as UInt64)
Log "try to connect to device at "+BluetoothAddress.ToString
// 1.
WindowsBluetoothLEDeviceMBS.FromBluetoothAddressAsync(bluetoothAddress, AddressOf FromBluetoothAddressAsyncCompleted)
End Sub
Sub FromBluetoothAddressAsyncCompleted(AsyncStatus as Integer, Device as WindowsBluetoothLEDeviceMBS)
#pragma unused AsyncStatus
// got device
If Device = Nil Then
MessageBox "Failed to get device."
Else
Dim NewDevice As New WindowsBluetoothLEDevice(Device)
NewDevice.list = list
Self.Devices.append NewDevice
Log "Device.Name: "+NewDevice.name
Log "Device.ID: "+NewDevice.BluetoothDeviceId.Id
Log "Device.Appearance.Category: "+NewDevice.Appearance.Category.ToString
// 2. request access
NewDevice.RequestAccessAsync
End If
End Sub
Sub Log(message as string)
System.DebugLog message
List.AddRow message
End Sub
Property Watcher As WindowsBluetoothLEAdvertisementWatcher
Property devices() As WindowsBluetoothLEDevice
End Class
MenuBar MainMenuBar
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem EditSeparator1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem EditSeparator2 = "-"
MenuItem EditSelectAll = "Select &All"
MenuItem HelpMenu = "&Help"
End MenuBar
Class WindowsBluetoothLEDevice Inherits WindowsBluetoothLEDeviceMBS
EventHandler Sub ConnectionStatusChanged()
Log CurrentMethodName
Select Case Me.ConnectionStatus
Case Me.ConnectionStatusConnected
Log "New status: Connected"
Case Me.ConnectionStatusDisconnected
Log "New status: Disconnected"
End Select
End EventHandler
EventHandler Sub GattServicesChanged()
Log CurrentMethodName
End EventHandler
EventHandler Sub GetGattServicesCompleted(asyncStatus as Integer, Result as WindowsGattDeviceServicesResultMBS)
Log CurrentMethodName
if Result <> nil then
dim services() as WindowsGattDeviceServiceMBS = Result.Services
for each Service as WindowsGattDeviceServiceMBS in Services
log "Found service: "+Service.UUID
'dim iservices() as WindowsGattDeviceServiceMBS = Service.GetAllIncludedServices
'for each iservice as WindowsGattDeviceServiceMBS in iservices
'log " Found included service: "+iService.UUID
'next
'dim pservices() as WindowsGattDeviceServiceMBS = Service.ParentServices
'for each pService as WindowsGattDeviceServiceMBS in pservices
'log " Found parent service: "+pService.UUID
'next
Dim HeartRateServiceUUID As String = "{0000180d-0000-1000-8000-00805f9b34fb}" // heart rate
if Service.UUID = HeartRateServiceUUID then
dim GattService as New WindowsGattDeviceService(service)
GattService.list = list
GattService.RequestAccessAsync
GattServices.append GattService
end if
next
end if
End EventHandler
EventHandler Sub NameChanged()
Log CurrentMethodName
Log "New name: "+Me.Name
End EventHandler
EventHandler Sub RequestAccessCompleted(asyncStatus as Integer, DeviceAccessStatus as Integer)
// got access
Log CurrentMethodName
If AsyncStatus = AsyncStatusCompleted Then
Select Case DeviceAccessStatus
Case Me.DeviceAccessStatusAllowed
Log "Access allowed."
Case Me.DeviceAccessStatusDeniedBySystem
Log "Access denied by system."
Case Me.DeviceAccessStatusDeniedByUser
Log "Access denied by user."
Case Me.DeviceAccessStatusUnspecified
Log "Access unknown."
End Select
Me.CheckGatt
Else
MessageBox "Failed to ask for device access."
End If
End EventHandler
Sub CheckGatt()
// 3. get list of all services
me.GetGattServicesAsync
if false then
// this is ID of our Bluetooth Heart Rate Monitor: 180D
Dim HeartRateServiceUUID As String = "{0000180d-0000-1000-8000-00805f9b34fb}"
try
Dim g As WindowsGattDeviceServiceMBS = Me.GetGattService(HeartRateServiceUUID)
dim GattService as New WindowsGattDeviceService(g)
GattService.list = list
GattService.RequestAccessAsync
GattServices.append GattService
catch r as RuntimeException
log Introspection.GetType(r).name+": "+r.Message
end try
end if
End Sub
Sub Log(message as string)
System.DebugLog message
if list = nil then
Break
else
List.AddRow message
end if
End Sub
Property GattServices() As WindowsGattDeviceService
Property list As DesktopListBox
End Class
Class WindowsGattDeviceService Inherits WindowsGattDeviceServiceMBS
EventHandler Sub CharacteristicsCompleted(asyncStatus as Integer, Result as WindowsGattCharacteristicsResultMBS)
Log CurrentMethodName
// got characteristics
If result <> Nil Then
Dim theCharacteristics() As WindowsGattCharacteristicMBS = Result.Characteristics
For Each theCharacteristic As WindowsGattCharacteristicMBS In theCharacteristics
Dim Characteristic As New WindowsGattCharacteristic(theCharacteristic)
Characteristic.list = list
Log "Characteristic: "+Characteristic.UserDescription+" "+Characteristic.UUID
Characteristics.append Characteristic
Characteristic.GetDescriptorsAsync
dim Mode as integer = _
WindowsGattReadClientCharacteristicConfigurationDescriptorResultMBS.ConfigurationDescriptorValueNotify + _
WindowsGattReadClientCharacteristicConfigurationDescriptorResultMBS.ConfigurationDescriptorValueIndicate
Characteristic.WriteClientCharacteristicConfigurationDescriptorAsync Mode
Next
Else
Log "Failed to get characteristics."
End If
End EventHandler
EventHandler Sub IncludedServicesCompleted(asyncStatus as Integer, Result as WindowsGattDeviceServicesResultMBS)
Log CurrentMethodName
End EventHandler
EventHandler Sub OpenAsyncCompleted(asyncStatus as Integer, OpenStatus as Integer)
// device open
Log CurrentMethodName
If AsyncStatus = WindowsBluetoothLEDevice.AsyncStatusCompleted Then
Select Case OpenStatus
Case Me.OpenStatusAccessDenied
Log "AccessDenied."
Case Me.OpenStatusAlreadyOpened
Log "AlreadyOpened."
Case Me.OpenStatusNotFound
Log "NotFound."
Case Me.OpenStatusSharingViolation
Log "SharingViolation."
Case Me.OpenStatusSuccess
Log "Success."
Case Me.OpenStatusUnspecified
Log "Unspecified."
End Select
me.CheckGattCharacteristics
Else
MessageBox "Failed to ask for device access."
End If
End EventHandler
EventHandler Sub RequestAccessCompleted(asyncStatus as Integer, DeviceAccessStatus as Integer)
// got access
Log CurrentMethodName
If AsyncStatus = WindowsBluetoothLEDevice.AsyncStatusCompleted Then
Select Case DeviceAccessStatus
Case WindowsBluetoothLEDevice.DeviceAccessStatusAllowed
Log "Access allowed."
Case WindowsBluetoothLEDevice.DeviceAccessStatusDeniedBySystem
Log "Access denied by system."
Case WindowsBluetoothLEDevice.DeviceAccessStatusDeniedByUser
Log "Access denied by user."
Case WindowsBluetoothLEDevice.DeviceAccessStatusUnspecified
Log "Access unknown."
End Select
// 4. open
Me.OpenAsync Me.SharingModeSharedReadOnly
Else
MessageBox "Failed to ask for device access."
End If
End EventHandler
Sub CheckGattCharacteristics()
// 5. query characteristics
Me.GetCharacteristicsAsync(Me.CacheModeCached)
End Sub
Sub Log(message as string)
System.DebugLog message
List.AddRow message
End Sub
Property Characteristics() As WindowsGattCharacteristic
Property list As DesktopListBox
End Class
Class WindowsGattDescriptor Inherits WindowsGattDescriptorMBS
EventHandler Sub ReadValueAsyncCompleted(asyncStatus as Integer, Result as WindowsGattReadResultMBS)
Log CurrentMethodName
End EventHandler
EventHandler Sub WriteValueAsyncCompleted(asyncStatus as Integer, Result as Integer)
Log CurrentMethodName
End EventHandler
EventHandler Sub WriteValueWithResultAsyncCompleted(asyncStatus as Integer, Result as WindowsGattWriteResultMBS)
Log CurrentMethodName
End EventHandler
Sub Log(message as string)
System.DebugLog message
if list = nil then
Break
else
List.AddRow message
end if
End Sub
Property list As DesktopListBox
End Class
Class WindowsGattCharacteristic Inherits WindowsGattCharacteristicMBS
EventHandler Sub DescriptorsCompleted(asyncStatus as Integer, Result as WindowsGattDescriptorsResultMBS)
Log CurrentMethodName
If result <> Nil Then
Dim Descriptors() As WindowsGattDescriptorMBS = result.Descriptors
For Each Descriptor As WindowsGattDescriptorMBS In Descriptors
Log "Descriptor for attribute "+Descriptor.AttributeHandle.ToString+" has "+Descriptor.UUID
Next
me.ReadValueAsync
End If
End EventHandler
EventHandler Sub ReadValueAsyncCompleted(asyncStatus as Integer, Result as WindowsGattReadResultMBS)
Log CurrentMethodName
if result <> nil then
dim mem as MemoryBlock = result.Value
log "Value: "+EncodeHex(mem)
end if
End EventHandler
EventHandler Sub ValueChanged(args as WindowsGattValueChangedEventArgsMBS)
Log CurrentMethodName
if args <> nil then
dim CharacteristicValue as MemoryBlock = args.CharacteristicValue
if CharacteristicValue <> nil then
// for Heart Rate, first byte is flags and second byte should be the value
dim flags as integer = CharacteristicValue.UInt8Value(0)
dim bpm as integer = CharacteristicValue.UInt8Value(1)
log "CharacteristicValue changed: "+EncodeHex(CharacteristicValue)+" BPM: "+str(bpm)
end if
end if
End EventHandler
EventHandler Sub WriteValueAsyncCompleted(asyncStatus as Integer, Result as Integer)
Log CurrentMethodName
End EventHandler
EventHandler Sub WriteValueWithResultAsyncCompleted(asyncStatus as Integer, Result as WindowsGattWriteResultMBS)
Log CurrentMethodName
End EventHandler
Sub Log(message as string)
System.DebugLog message
if list = nil then
Break
else
List.AddRow message
end if
End Sub
Property list As DesktopListBox
End Class
Class WindowsBluetoothLEAdvertisementWatcher Inherits WindowsBluetoothLEAdvertisementWatcherMBS
EventHandler Sub Received(Args as WindowsBluetoothLEAdvertisementReceivedEventArgsMBS)
dim ba as string = args.BluetoothAddress.ToHex
dim a as WindowsBluetoothLEAdvertisementMBS = args.Advertisement
if a <> nil then
dim localName as string = a.LocalName
if localName <> "" then
log ba+" has LocalName: "+a.LocalName
if localName = "Heart Rate" then
dim Advertisement as WindowsBluetoothLEAdvertisementMBS = args.Advertisement
dim ServiceUUIDs() as string = Advertisement.ServiceUuids
log "ServiceUUIDs: "+string.FromArray(ServiceUUIDs, ", ")
// we found our device
dim BluetoothAddress as UInt64 = args.BluetoothAddress
MainWindow.FromBluetoothAddress BluetoothAddress
me.Stop
end if
end if
end if
End EventHandler
EventHandler Sub Stopped(Error as Integer)
dim m as string = "Stopped "+str(Error)
dim e as string
Select case Error
case 0
return // no error, we just stopped it
case me.ErrorNotSupported
e = "Error: not supported."
case me.ErrorRadioNotAvailable
e = "Error: Radio not available."
case me.ErrorDisabledByUser
e = "Error: Disabled by user."
case me.ErrorDisabledByPolicy
e = "Error: Disabled by policy."
case me.ErrorResourceInUse
e = "Error: Resource in use."
end Select
MessageBox m + EndOfLine+EndOfLine + e
End EventHandler
Sub Log(message as string)
System.DebugLog message
if list = nil then
Break
else
List.AddRow message
end if
End Sub
Property list As DesktopListBox
End Class
End Project
See also:
The items on this page are in the following plugins: MBS WinFrameworks Plugin.
