Platforms to show: All Mac Windows Linux Cross-Platform

/Bluetooth/Windows Bluetooth/Bluetooth LE Heart Rate Win
Required plugins for this example: MBS Bluetooth Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Bluetooth/Windows Bluetooth/Bluetooth LE Heart Rate Win
This example is the version from Wed, 26th Jun 2018.
Project "Bluetooth LE Heart Rate Win.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
End Class
Class MainWindow Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
End Control
EventHandler Sub Open() // this is ID of our Bluetooth Heart Rate Monitor: 180D dim ServiceUUID as string = "{0000180D-0000-1000-8000-00805F9B34FB}" // look in registry for path of connected devices dim paths() as String = WindowsBlueToothLEMBS.DevicePathsForClassGUID(ServiceUUID) if paths = nil then list.Log "Failed to list." Return elseif UBound(paths) < 0 then list.Log "Device not found" return end if dim path as string = paths(0) list.log "Path: "+path ble = new MyWindowsBlueToothLEMBS(path) ble.list = list dim Services() as WindowsBlueToothLEServiceMBS = ble.Services if Services = nil then list.log "Failed to query Services" + str(ble.LastError) + " " + ble.LastErrorMessage return end if list.log str(Services.Ubound+1)+" services found" for each service as WindowsBlueToothLEServiceMBS in Services list.log "Service found with UUID "+service.ServiceUUID+" and AttributeHandle "+str(service.AttributeHandle) dim Characteristics() as WindowsBlueToothLECharacteristicMBS = ble.Characteristics(service) if Characteristics = nil then list.log "Failed to query Characteristics" + str(ble.LastError) + " " + ble.LastErrorMessage else for each Characteristic as WindowsBlueToothLECharacteristicMBS in Characteristics list.log " Characteristic found: "+Characteristic.CharacteristicUuid list.log " IsReadable: "+yesno(Characteristic.IsReadable) list.log " IsWritable: "+yesno(Characteristic.IsWritable) list.log " IsNotifiable: "+yesno(Characteristic.IsNotifiable) if Characteristic.IsNotifiable then ble.RegisterChangeEvent array(Characteristic) end if dim Descriptors() as WindowsBlueToothLEDescriptorMBS = ble.Descriptors(Characteristic) if Descriptors = nil then list.log "Failed to query Descriptors" + str(ble.LastError) + " " + ble.LastErrorMessage else for each Descriptor as WindowsBlueToothLEDescriptorMBS in Descriptors list.log " Descriptor found: "+Descriptor.DescriptorUuid list.log " Descriptor type: "+str(Descriptor.DescriptorType) dim dv as WindowsBlueToothLEDescriptorValueMBS = ble.GetDescriptorValue(Descriptor) if dv = nil or ble.LastError <> 0 then list.Log " Descriptor witout data: "+ble.LastErrorMessage else list.log " DescriptorUuid: "+dv.DescriptorUuid list.log " DescriptorType: "+str(dv.DescriptorType) if dv.Data <> nil then dim d as string = list.log " Data: "+EncodeHex(d) 'if Encodings.UTF16LE.IsValidData(d) then d = DefineEncoding(d, encodings.UTF16LE) list.log " Data as UTF16: "+d 'end if = ConvertEncoding("Xojo"+chr(0), encodings.UTF16LE) if ble.SetDescriptorValue(Descriptor, dv) then // ok else list.Log " Descriptor write failed: "+ble.LastErrorMessage end if end if end if next end if if Characteristic.IsWritable then dim data as new MemoryBlock(4) data.Int32Value(0) = &h12345678 dim WriteID as int64 = ble.BeginReliableWrite if ble.LastError <> 0 then list.Log " BeginReliableWrite failed: "+ble.LastErrorMessage else list.log "Write ID: "+str(WriteID) call ble.SetCharacteristicValue(Characteristic, data, WriteID) list.log "Write value done: "+ble.LastErrorMessage ble.EndReliableWrite WriteID end if end if if Characteristic.IsReadable then dim data as MemoryBlock = ble.GetCharacteristicValue(Characteristic) if data <> nil then list.log " Value: "+EncodeHex(data) else list.log "No data read: "+ble.LastErrorMessage end if end if next end if next End EventHandler
Property ble As MyWindowsBlueToothLEMBS
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"
End MenuBar
Module Module1
Sub Log(extends l as listbox, row as string) l.AddRow row // scroll at bottom l.ScrollPosition = l.ListCount End Sub
Function yesno(b as Boolean) As string if b then Return "yes" else return "no" end if End Function
End Module
Class MyWindowsBlueToothLEMBS Inherits WindowsBlueToothLEMBS
EventHandler Sub ChangeEvent(ChangedAttributeHandle as Integer, CharacteristicValue as MemoryBlock) list.log CurrentMethodName+" "+str(ChangedAttributeHandle)+": "+EncodeHex(CharacteristicValue) // show BPM based on the package content dim data as MemoryBlock = CharacteristicValue if data <> nil and data.size >= 2 then dim bpm as integer if BitwiseAnd(data.UInt8Value(0), 1) = 0 then bpm = data.uint8Value(1) else bpm = data.uint8Value(1) * 256 + data.uint8Value(2) end if list.Log "BPM: "+str(bpm) end if End EventHandler
Property list As listbox
End Class
End Project

See also:

Feedback, Comments & Corrections

The items on this page are in the following plugins: MBS Bluetooth Plugin.

The biggest plugin in space...

MBS Xojo Plugins

Start Chat