1 Attachment(s)
[VB6, Vista+] Core Audio - Change the system default audio device
Changing the system-wide default input and output audio devices
WARNING: This feature is not designed to be accessible to programs and uses a COM interface that is undocumented and unsupported by Microsoft. As such, it may not function in future versions of Windows.
Several times I've come across people asking how to change the default input/output devices through code, and usually the reply is that it isn't possible. Changing the device per-app is well documented, but many people want to be able to set the system-wide default like the Sound control panel applet does. Tonight I was looking into that a little deeper, and the applet does it through an undocumented private COM interface called IPolicyConfig. So naturally I immediately found the definition and added it to oleexp.
There's two versions of the interface included, one for Windows Vista (IPolicyConfigVista / CPolicyConfigVistaClient) and one for Windows 7 and higher (IPolicyConfig / PolicyConfigClient).
Using this interface to set the defaults is very easy:
Code:
Private pPolicyCfg As PolicyConfigClient
If (pPolicyCfg Is Nothing) Then
Set pPolicyCfg = New PolicyConfigClient
End If
pPolicyCfg.SetDefaultEndpoint StrPtr(sDeviceID), eMultimedia
pPolicyCfg.SetDefaultEndpoint StrPtr(sDeviceID), eCommunications
It's actually far more complicated to figure out the device ID string that you need, as it's not name, it's a string like {0.0.1.00000000}.{b12f40bc-c3ec-4a74-afcc-4b6d0eb6914a}. The good news is enumerating all the devices and their IDs (as well as enabling them if you need to, as they need to be active to be set as default) was covered in my Core Audio Basics demo. The enumeration code is copied right out of that project.
Requirements
-Windows Vista or higher
-oleexp.tlb v4.11 or higher (new release for this demo)
-oleexp addon mIID.bas (included in oleexp download)
-oleexp addon mCoreAudio.bas (included in oleexp download)
-oleexp addon mPKEY.bas (included in oleexp download)
---------------------
twinBASIC 64bit-compatible version can be found at: https://github.com/fafalone/CoreAudioDemos
Re: [VB6, Vista+] Core Audio - Change the system default audio device
Code:
Option Explicit
Private pPolicyCfg As PolicyConfigClient
Public Sub var_dump(Text() As String)
Dim temp As Long
Debug.Print "var_dump"
For temp = 0 To UBound(Text)
Debug.Print temp, Text(temp)
Next
End Sub
Public Function EnumAudioDevices(Optional InputDevices As Boolean = True) As String()
Dim sOut As String
Dim i As Long
Dim lp As Long
Dim s1 As String
Dim RET() As String
Dim pDvEnum As MMDeviceEnumerator
Set pDvEnum = New MMDeviceEnumerator
Dim pDvCol As IMMDeviceCollection
If InputDevices Then
pDvEnum.EnumAudioEndpoints eCapture, DEVICE_STATE_ACTIVE, pDvCol
Else
pDvEnum.EnumAudioEndpoints eRender, DEVICE_STATE_ACTIVE, pDvCol
End If
If (pDvCol Is Nothing) = False Then
Dim nCount As Long
If pDvCol.GetCount(nCount) = S_OK Then
ReDim RET(nCount - 1)
For i = 0 To (nCount - 1)
RET(i) = GetDeviceName(pDvCol, i)
Next
End If
End If
EnumAudioDevices = RET
End Function
Private Function GetDeviceName(pCol As IMMDeviceCollection, nIdx As Long) As String
Dim pDevice As IMMDevice
Dim sID As String
Dim pStore As IPropertyStore
Dim pDesc As IPropertyDescription
Dim lp As Long
Dim lpID As Long
Dim vrProp As Variant
Dim vProp As Variant
Dim j As Long
If (pCol.Item(nIdx, pDevice)) = S_OK Then
pDevice.GetId lpID
sID = LPWSTRtoStr(lpID)
'Debug.Print "Got device(" & nIdx & ") id=" & sID
If (sID = "") Or (sID = vbNullChar) Then
GetDeviceName = "<Invalid DeviceID>"
Exit Function
End If
pDevice.OpenPropertyStore STGM_READ, pStore
If (pStore Is Nothing) = False Then
'these property stores aren't as full-featured as other ones
'such as those associated with IShellItem's of files.. for
'example we can't use the superior PSFormatPropertyValue b/c
'we can't get an IPropertyDescription, or a property name
'So we're stuck using PropVariants, a nightmare in VB
Dim pcnt As Long
pStore.GetCount pcnt
'Debug.Print "prop cnt=" & pcnt & " outputting propvariant..."
Dim pk As PROPERTYKEY
pStore.GetValue PKEY_Device_FriendlyName, vProp
PropVariantToVariant vProp, vrProp
Dim vte As VbVarType
vte = VarType(vrProp)
If (vte And vbArray) = vbArray Then 'this always seems to be vbString and vbArray, haven't encountered other types
For j = LBound(vrProp) To UBound(vrProp)
Debug.Print "Array Value(" & j & ")=" & CStr(vrProp(j))
Next j
Else
Select Case vte
Case vbDataObject, vbObject, vbUserDefinedType
GetDeviceName = "<cannot display this type>"
Case vbEmpty, vbNull
GetDeviceName = "<empty or null>"
Case vbError
GetDeviceName = "<vbError>"
Case Else
GetDeviceName = CStr(vrProp) & "|" & sID
End Select
End If
Else
GetDeviceName = "<Failed to get IPropertyStore>"
End If
Else
GetDeviceName = "<Failed to get device with pCol.Item, nIdx=" & nIdx & ">"
End If
End Function
Private Function GetDeviceNameDirect(pDevice As IMMDevice) As String
Dim sID As String
Dim pStore As IPropertyStore
Dim pDesc As IPropertyDescription
Dim lp As Long
Dim lpID As Long
Dim vrProp As Variant
Dim vProp As Variant
Dim j As Long
pDevice.GetId lpID
sID = LPWSTRtoStr(lpID)
Debug.Print "GetDeviceNameDirect------------"
Debug.Print "Got device id=" & sID
If (sID = "") Or (sID = vbNullChar) Then
GetDeviceNameDirect = "<Invalid DeviceID>"
Exit Function
End If
pDevice.OpenPropertyStore STGM_READ, pStore
If (pStore Is Nothing) = False Then
'these property stores aren't as full-featured as other ones
'such as those associated with IShellItem's of files.. for
'example we can't use the superior PSFormatPropertyValue b/c
'we can't get an IPropertyDescription, or a property name
'So we're stuck using PropVariants, a nightmare in VB
Dim pcnt As Long
pStore.GetCount pcnt
Debug.Print "prop cnt=" & pcnt & " outputting propvariant..."
Dim pk As PROPERTYKEY
pStore.GetValue PKEY_Device_FriendlyName, vProp
PropVariantToVariant vProp, vrProp
Dim vte As VbVarType
vte = VarType(vrProp)
If (vte And vbArray) = vbArray Then 'this always seems to be vbString and vbArray, haven't encountered other types
For j = LBound(vrProp) To UBound(vrProp)
Debug.Print "Array Value(" & j & ")=" & CStr(vrProp(j))
Next j
Else
Select Case vte
Case vbDataObject, vbObject, vbUserDefinedType
GetDeviceNameDirect = "<cannot display this type>"
Case vbEmpty, vbNull
GetDeviceNameDirect = "<empty or null>"
Case vbError
GetDeviceNameDirect = "<vbError>"
Case Else
GetDeviceNameDirect = CStr(vrProp) & "|" & sID
End Select
End If
Else
GetDeviceNameDirect = "<Failed to get IPropertyStore>"
End If
End Function
Public Function getSID(sID As String, Optional UseAsDefault As Boolean = False) As String
Dim temp As Long
If Left(sID, 1) <> "<" And Right(sID, 1) <> ">" Then
temp = InStr(sID, "|")
If temp > 0 Then sID = Mid$(sID, temp + 1)
If UseAsDefault Then
If (pPolicyCfg Is Nothing) Then Set pPolicyCfg = New PolicyConfigClient
pPolicyCfg.SetDefaultEndpoint StrPtr(sID), eMultimedia
pPolicyCfg.SetDefaultEndpoint StrPtr(sID), eCommunications
End If
Else
sID = ""
End If
getSID = sID
End Function
Public Function FindDevice(Name As String, Optional InputDevices As Boolean = True, Optional UseAsDefault As Boolean = False) As String
Dim AudioDevices() As String, temp As Long, sID As String, temp2 As Long
AudioDevices = EnumAudioDevices(InputDevices)
For temp = 0 To UBound(AudioDevices)
sID = AudioDevices(temp)
temp2 = InStr(sID, "|")
If Left(sID, 1) <> "<" And Right(sID, 1) <> ">" And temp2 > 0 Then
sID = Trim(Left(sID, temp2 - 1))
If StrComp(Name, sID, vbTextCompare) = 0 Then
FindDevice = getSID(AudioDevices(temp), UseAsDefault)
Exit Function
End If
End If
Next
End Function
I redid the code so it wasn't hardcoded to usercontrols, so I could re-use it in a command line interface.
EnumRenderDevices and EnumCaptureDevices were combined into EnumAudioDevices since there was only 1 word different between the 2.
It returns the list as a string array instead of putting it in a usercontrol
GetDeviceName and GetDeviceNameDirect had the debug.prints switched to returning a text in the form of "<error>" like the other errors.
Command1_Click and Command2_Click were combined into getSID which takes the ID text (example: BBY LCD TV-4 (NVIDIA High Definition Audio)|{0.0.0.00000000}.{a3654c19-7934-4b6b-8102-b0bb9f1921bf}) and spits out the ID code after the |
If UseAsDefault is true, it sets the input/output device to that ID code
FindDevice looks for the first device name (before the | ) and calls getSID
I don't want to sound rude, but I wish more developers would make code this way. That way the code is reusable from the start
Re: [VB6, Vista+] Core Audio - Change the system default audio device
If you want to pay me to make it how you want instead of a 10 minute proof-of-concept job using whatever method strikes my mood, I'd be happy to oblige :p
