Tweet
Code:
' BlueTooth Framework Demo - Mike Trader Oct 2007
' This demonstrates the detecting of Paired bluetooth devices, selecting of the first device found
' and sending an AT command to that device to dial (800)555-1212.
' (The first device should be a cell phone - or you will need to adjust the code)
' Requires Bluetooth Framework: Bluetooth® Framework X Demo
' available at: http://www.btframework.com/download.htm
' If you have the Widdcom Stack put the bftowdthunk.dll in the SYSTEM folder
' BluetoothFrameworkX.ocx may be local to the app or in the system folder
' Also required: "BTF.inc" wrappers
' available at: http://www.jose.it-berater.org/smfforum/index.php?topic=1391.0
' Many thanks to Mike Petrichenko, Dominic Mitchell and the amazing Jose Roca for making this possible.
' COM info
' A useable COM Object comprises a Dispatch Interface whose member Methods and Properties
' can be accessed by a COM client.
' An Object's Dispatch Interface is uniquely identifiable by its PROGID and CLSID.
' Broadly speaking, a Dispatch Interface is the actual mechanism that is used by a COM-aware
' application to communicate with the COM Object
' Further, a PROGID and a CLSID must be present to uniquely identify each Dispatch
' Interface exposed by a COM Object.
' The term COM is often used in the software development world as an umbrella term
' that encompasses the OLE, OLE Automation, ActiveX, COM+ and DCOM technologies.
' Different component types are identified by class IDs (CLSIDs), which are Globally Unique Identifiers
' Because the location of each component is stored in a system-wide location
' (the Windows registry), there can be only one version of a certain component installed.
' Thus, COM seriously suffers from DLL hell, where two or more applications require
' different versions of the same component.
' use DllRegisterServer to register the OCX Dll
' A COM object is basically a C++ class (structure) that always starts with a pointer to its VTable
' (an array of function pointers). The first three pointers in the VTable will always be named:
' QueryInterface, AddRef, and Release.
' What additional functions may be in its VTable, and what the name of their pointers are,
' depends upon what type of object it is.
'
' Globally Universal Identifier (GUID) is a 16 byte array that is filled in with a unique series of bytes.
' And when I say unique, I do mean unique, it cannot have the same series of bytes as another GUID...
' anywhere in the world. Every GUID ever created has a unique series of 16 bytes.
'
' Microsoft has defined a COM object known as an IUnknown. An IUnknown objects VTable contains only the
' QueryInterface, AddRef, and Release functions
' In other words, an IUnknown is the bare minimum COM object
' Microsoft created a special GUID for an IUnknown object, But Our IExample object can also masquerade
' as an IUnknown object because it has the QueryInterface, AddRef, and Release functions in it.
'
' Microsoft's include files give the IUnknown GUID the C variable name IID_IUnknown:
'
' - Bluetooth® Framework VCL™ can be uses with following Bluetooth® APIs:
' - Microsoft® Bluetooth® API (Windows XP® + SP2 and high)
' - WidComm® (BroadComm®) Bluetooth® API (1.4.2.10 SP5 and high)
' - BlueSoleil® (IVT®) Bluetooth® API (1.6 and high)
' - Toshiba® Bluetooth® API (4.0 and high) (Servers not supported).
'
' Tested Devices List - http://www.btframework.com/devices.htm
#COMPILE EXE "BTFDemo.exe"
#DIM ALL
#INCLUDE "WIN32API.inc" ' Power Basic Win32 API Declares
#INCLUDE "BTF.inc" ' Interface Definitions for BluetoothFrameworkX Library
%CLSCTX_INPROC_SERVER = 1 ' The code that creates and manages objects of this class is a DLL that
' runs IN the same process AS the caller OF the FUNCTION specifying the class context.
%CLSCTX_INPROC_HANDLER = 2 ' The code that manages objects of this class is an in-process handler.
%CLSCTX_LOCAL_SERVER = 4 ' The EXE code that creates and manages objects of this class runs on
' same machine but is loaded in a separate process space.
%CLSCTX_REMOTE_SERVER = 16 ' A remote machine context.
%CLSCTX_SERVER = 21 ' %CLSCTX_INPROC_SERVER OR %CLSCTX_LOCAL_SERVER OR %CLSCTX_REMOTE_SERVER
%CLSCTX_ALL = 23 ' %CLSCTX_INPROC_HANDLER OR %CLSCTX_SERVER
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤'
' Decrements the reference Count for the calling interface on a object. If the reference
' Count on the object falls to 0, the object is freed from memory.
FUNCTION IUnknown_Release(BYVAL pthis AS DWORD PTR) AS DWORD
LOCAL DWRESULT AS DWORD
IF pthis = %NULL THEN EXIT FUNCTION
CALL DWORD @@pthis[2] USING IUnknown_Release(pthis) TO DWRESULT
FUNCTION = DWRESULT
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤'
FUNCTION PBMAIN
LOCAL i, RetVal, Count, lReturn, hFile, NeedLF AS LONG
LOCAL iReturn, iAuth, iBluetooth AS INTEGER
LOCAL dReturn AS DOUBLE
LOCAL dwReturn AS DWORD
LOCAL dwContext, pInfo, pDiscovery, pDevices, pDevice, pSerial, pTransport AS DWORD
LOCAL s, sReturn, sDeviceAddr, sCommand, sResponse AS STRING
LOCAL CLSID, IID AS GUID
LOCAL tAPIs AS BFBluetoothAPIsX
LOCAL tTransports AS BFAPITransportsX
dwContext = %CLSCTX_INPROC_SERVER
' Get a reference to Info
CLSID = $CLSID_BFAPIInfoX
IID = $IID_IBFAPIInfoX
RetVal = CoCreateInstance(CLSID, BYVAL %NULL, dwContext, IID, pInfo)
IF pInfo = 0 THEN
MSGBOX "Error="+HEX$(RetVal)+", pInfo="+STR$(pInfo),48,"CoCreateInstance Error"
EXIT FUNCTION
END IF
RetVal = BTF_IBFAPIInfoX_get_HasBluetooth(pInfo, iBluetooth)
s = s + "HasBluetooth = " + STR$(iBluetooth) + $CRLF + $CRLF
IF iBluetooth = 0 THEN MSGBOX "No BlueTooth Stack found",48,"BlueTooth Error"
BTF_IBFAPIInfoX_get_BluetoothAPIs pInfo, tAPIs
s = s + "BlueSoleil = " + STR$(tAPIs.baBlueSoleil) + $CRLF + _
"Toshiba = " + STR$(tAPIs.baToshiba) + $CRLF + _
"WidComm = " + STR$(tAPIs.baWidComm) + $CRLF + _
"WinSock = " + STR$(tAPIs.baWinSock) + $CRLF + $CRLF
RetVal = BTF_IBFAPIInfoX_get_Transports(pInfo, tTransports)
s = s + "Bluetooth = " + STR$(tTransports.Bluetooth) + $CRLF + _
"COMPort = " + STR$(tTransports.COMPort) + $CRLF + _
"IrDA = " + STR$(tTransports.IrDA) + $CRLF + $CRLF
IUnknown_Release pInfo
'=====================
MSGBOX "Search for Bluetooth Devices?"+$CRLF+"(This may take a minute)",64,"BlueTooth"
' Get a reference to Discovery
CLSID = $CLSID_BFBluetoothDiscoveryX
IID = $IID_IBFBluetoothDiscoveryX
RetVal = CoCreateInstance(CLSID, BYVAL %NULL, dwContext, IID, pDiscovery)
IF pDiscovery = 0 THEN
MSGBOX "Error="+HEX$(RetVal)+", pDiscovery="+STR$(pDiscovery),48,"CoCreateInstance Error"
EXIT FUNCTION
END IF
' Get a reference to the Devices collection Object
RetVal = BTF_IBFBluetoothDiscoveryX_Discovery(pDiscovery, 0, -1, 0, -1, pDevices)
IF pDevices = 0 THEN
MSGBOX "Error="+HEX$(RetVal)+", pDevices="+STR$(pDevices),48,"Devices Error"
EXIT FUNCTION
END IF
RetVal = BTF_IBFBluetoothDevicesX_get_Count(pDevices, Count)
FOR i = 0 TO Count-1
s = s + "Device="+STR$(i) + $CRLF
RetVal = BTF_IBFBluetoothDevicesX_get_Device(pDevices, i, pDevice)
IF pDevice = 0 THEN
s = s + "Device Error" + $CRLF + $CRLF
ITERATE
END IF
RetVal = BTF_IBFBluetoothDeviceX_get_Name(pDevice, sReturn)
s = s + "Name="+sReturn + $CRLF
RetVal = BTF_IBFBluetoothDeviceX_get_Address(pDevice, sReturn)
s = s + "Address="+sReturn + $CRLF
IF i = 0 THEN sDeviceAddr = sReturn
RetVal = BTF_IBFBluetoothDeviceX_get_ClassOfDevice(pDevice, lReturn)
s = s + "ClassOfDevice="+HEX$(lReturn) + $CRLF
RetVal = BTF_IBFBluetoothDeviceX_get_ClassOfDeviceName(pDevice, sReturn)
s = s + "ClassOfDeviceName="+sReturn + $CRLF
RetVal = BTF_IBFBluetoothDeviceX_get_Services(pDevice, dwReturn)
s = s + "Services="+HEX$(dwReturn) + $CRLF
RetVal = BTF_IBFBluetoothDeviceX_get_Remembered(pDevice, iReturn)
s = s + "Remembered="+STR$(iReturn) + $CRLF
RetVal = BTF_IBFBluetoothDeviceX_get_Authenticated(pDevice, iReturn)
s = s + "Authenticated="+STR$(iReturn) + $CRLF
IF i = 0 THEN iAuth = iReturn
RetVal = BTF_IBFBluetoothDeviceX_get_BTAddress(pDevice, dReturn)
s = s + "BTAddress="+STR$(dReturn) + $CRLF
RetVal = BTF_IBFBluetoothDeviceX_get_Connected(pDevice, iReturn)
s = s + "Connected="+STR$(iReturn) + $CRLF
RetVal = BTF_IBFBluetoothDeviceX_get_LastSeen(pDevice, dReturn)
s = s + "LastSeen="+STR$(dReturn) + $CRLF
RetVal = BTF_IBFBluetoothDeviceX_get_LastUsed(pDevice, dReturn)
s = s + "LastUsed="+STR$(dReturn) + $CRLF
s = s + $CRLF + $CRLF
NEXT
IUnknown_Release pDevice
IUnknown_Release pDevices
'=====================
s = s + "Dial number on First Device?"
MSGBOX s,64,"BlueTooth"
' Get a reference to SerialPortClient
CLSID = $CLSID_BFSerialPortClientX
IID = $IID_IBFSerialPortClientX
RetVal = CoCreateInstance(CLSID, BYVAL %NULL, dwContext, IID, pSerial)
IF pSerial = 0 THEN
MSGBOX "Error="+HEX$(RetVal)+", pSerial="+STR$(pSerial),48,"CoCreateInstance Error"
EXIT FUNCTION
END IF
' Get a reference to the BluetoothTransport object
RetVal = BTF_IBFSerialPortClientX_get_BluetoothTransport(pSerial, pTransport)
IF RetVal THEN
MSGBOX "Error="+HEX$(RetVal),48,"OpenDevice Error"
EXIT FUNCTION
END IF
RetVal = BTF_IBFBluetoothClientTransportX_put_Address(pTransport, sDeviceAddr) ' Set the Device Address
RetVal = BTF_IBFSerialPortClientX_Open(pSerial) ' Open a connection to the specified Device
IF RetVal THEN
MSGBOX "Error="+HEX$(RetVal),48,"OpenDevice Error"
EXIT FUNCTION
END IF
sCommand = "ATD8005551212;" ' 800 Directory Assistance - ";" indicates a voice call
NeedLF = 0 ' Need a Line Feed?
RetVal = BTF_IBFSerialPortClientX_ExecuteATCommand(pSerial, sCommand, sResponse, NeedLF) ' Send the AT Command
MSGBOX "Response: "+sResponse,64,"AT Command: "+sCommand
IUnknown_Release pSerial
IUnknown_Release pTransport
'=====================
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤'