Mit VBnet ermitteln der Soundeinstellungen (Win11)

dherr · 6. April 2024, 22:34

Hallo zusammen,

Windows zeigt in den Einstellungen für Sound alle im System verfügbaren Lautsprecher, siehe dazu den Screenshot.
Meine Frage ist: Kann man mittels VBnet genau diese Einstellungen abfragen und dann eventuell in einer ListBox anzeigen?
Bin für einen Tipp dankbar!

Grüße - Dietrich

*Topic verschoben*

RodFromGermany · 7. April 2024, 08:55

@dherr Schau mal hier rein:
Mini-Audio-Manager - System-Sound bedienen

-Franky- · 7. April 2024, 09:29

@dherr k.A. ob @RodFromGermany dafür das gleiche nutzt. Mein erster Gedanke geht hier her: learn.microsoft.com/en-us/wind…enumerating-audio-devices Mein zweiter Gedanke geht in Richtung WinRT: learn.microsoft.com/de-de/uwp/…meration?view=winrt-22621 Hier würde ich dich sogar auf den DevicePicker verweisen der einen Dialog mit den entsprechenden Geräten (Filter) anzeigt.

dherr · 7. April 2024, 10:22

@RodFromGermany: Das hilft mir nicht weiter.
@Franky: Ich kann nicht ermitteln, wie ich MMDeviceAPI finden und in VS2022 einbinden kann.

-Franky- · 7. April 2024, 10:42

Hi

Solche Sachen sind standardmäßig nicht in .NET vorhanden. Das muss man entweder selbst programmieren oder falls vorhanden, entsprechende Nuget-Pakete oder Drittanbieter-DLLs verwenden. Ich bin mir sehr sicher das Du einige Beispiele zu den von mir vorgeschlagenen Möglichkeiten im Internet findest.

-Franky- · 7. April 2024, 16:29

@dherr Weil heute Sonntag ist und ich etwas Zeit hatte. Auf die schnelle zusammengeklöppelt und alles in einer Form. Daher sicher Verbesserungswürdig. Einige Interface-Funktionen sind nicht komplett da diese sowieso nicht benötigt werden. Wenn man die entsprechenden PKeys kennt, kann man die Info direkt auslesen anstatt durch alle Properties zu enumerieren.

Spoiler anzeigen

VB.NET-Quellcode

Imports System.Runtime.InteropServices
Public Class Form1
Private Const S_OK As Integer = 0
Private Const CLSID_MMDeviceEnumerator As String = "bcde0395-e52f-467c-8e3d-c4579291692e"
Private Const IID_IMMDeviceEnumerator As String = "a95664d2-9614-4f35-a746-de8db63617e6"
Private Const IID_IMMDeviceCollection As String = "0bd7a1be-7a1a-44db-8397-cc5392387b5e"
Private Const IID_IMMDevice As String = "d666063f-1587-4e43-81f1-b948e807363f"
Private Const IID_IPropertyStore As String = "886d8eeb-8cf2-4446-8d02-cdba1dbdcf99"
Private Enum DATA_FLOW As Integer
Render = 0
Capture = 1
All = 2
DataFlow_Enum_Count = 3
End Enum
Private Enum DEVICE_STATE As Integer
Active = 1
Disabled = 2
NotPresent = 4
Unplugged = 8
End Enum
Private Enum STGM_ACCESS As Integer
Read = 0
Write = 1
ReadWrite = 2
End Enum
Private Enum VARENUM As UShort
VT_EMPTY = 0
VT_NULL = 1
VT_I2 = 2
VT_I4 = 3
VT_R4 = 4
VT_R8 = 5
VT_CY = 6
VT_DATE = 7
VT_BSTR = 8
VT_DISPATCH = 9
VT_ERROR = 10
VT_BOOL = 11
VT_VARIANT = 12
VT_UNKNOWN = 13
VT_DECIMAL = 14
VT_I1 = 16
VT_UI1 = 17
VT_UI2 = 18
VT_UI4 = 19
VT_I8 = 20
VT_UI8 = 21
VT_INT = 22
VT_UINT = 23
VT_VOID = 24
VT_HRESULT = 25
VT_PTR = 26
VT_SAFEARRAY = 27
VT_CARRAY = 28
VT_USERDEFINED = 29
VT_LPSTR = 30
VT_LPWSTR = 31
VT_RECORD = 36
VT_INT_PTR = 37
VT_UINT_PTR = 38
VT_FILETIME = 64
VT_BLOB = 65
VT_STREAM = 66
VT_STORAGE = 67
VT_STREAMED_OBJECT = 68
VT_STORED_OBJECT = 69
VT_BLOB_OBJECT = 70
VT_CF = 71
VT_CLSID = 72
VT_VERSIONED_STREAM = 73
VT_BSTR_BLOB = 4095
VT_VECTOR = 4096
VT_ARRAY = 8192
VT_BYREF = 16384
VT_RESERVED = 32768
VT_ILLEGAL = 65535
VT_ILLEGALMASKED = 4095
VT_TYPEMASK = 4095
End Enum
Private Structure PROPERTYKEY
Dim fmtid As Guid
Dim pid As UInteger
End Structure
Private Structure CArray
Dim cElems As UInteger
Dim pElems As IntPtr
End Structure
<StructLayout(LayoutKind.Explicit, Size:=16)> 'gekürzt
Private Structure PROPVARIANT
<FieldOffset(0)> Dim vt As VARENUM
<FieldOffset(2)> Dim wReserved1 As UShort
<FieldOffset(4)> Dim wReserved2 As UShort
<FieldOffset(6)> Dim wReserved3 As UShort
<FieldOffset(8)> Dim bVal As Byte
<FieldOffset(8)> Dim cVal As SByte
<FieldOffset(8)> Dim uiVal As UShort
<FieldOffset(8)> Dim iVal As Short
<FieldOffset(8)> Dim uintVal As UInteger
<FieldOffset(8)> Dim intVal As Integer
<FieldOffset(8)> Dim ulVal As ULong
<FieldOffset(8)> Dim lVal As Long
<FieldOffset(8)> Dim fltVal As Single
<FieldOffset(8)> Dim dblVal As Double
<FieldOffset(8)> Dim boolVal As Short
<FieldOffset(8)> Dim pclsidVal As IntPtr
<FieldOffset(8)> Dim pszVal As IntPtr
<FieldOffset(8)> Dim pwszVal As IntPtr
<FieldOffset(8)> Dim punkVal As IntPtr
<FieldOffset(8)> Dim cArray As CArray
End Structure
<DllImport("Ole32.dll", EntryPoint:="PropVariantClear")>
<PreserveSig> Private Shared Function PropVariantClear(<[In]> ByRef pvar As PROPVARIANT) As Integer
End Function
<DllImport("Propsys.dll", EntryPoint:="PSGetNameFromPropertyKey")>
<PreserveSig> Private Shared Function PSGetNameFromPropertyKey(<[In]> ByRef propkey As PROPERTYKEY,
<Out> ByRef ppszCanonicalName As IntPtr) As Integer
End Function
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
Dim MMDeviceEnumerator As IMMDeviceEnumerator = CType(Activator.CreateInstance(Type.GetTypeFromCLSID(New Guid(CLSID_MMDeviceEnumerator))), IMMDeviceEnumerator)
If MMDeviceEnumerator IsNot Nothing Then
Dim MMDeviceCollection As IMMDeviceCollection = Nothing
If MMDeviceEnumerator.EnumAudioEndpoints(DATA_FLOW.Render, DEVICE_STATE.Active, MMDeviceCollection) = S_OK Then
If MMDeviceCollection IsNot Nothing Then
Dim Devices As UInteger
If MMDeviceCollection.GetCount(Devices) = S_OK Then
Debug.Print("Devices: " & Devices.ToString)
If Devices > 0 Then
For Device As UInteger = 0 To Devices - 1UI
Dim MMDevive As IMMDevice = Nothing
If MMDeviceCollection.Item(Device, MMDevive) = S_OK Then
If MMDevive IsNot Nothing Then
Dim DevId As String = Nothing
If MMDevive.GetId(DevId) = S_OK Then
Debug.Print("DEVICE_ID: " & DevId)
End If
Dim DevState As New DEVICE_STATE
If MMDevive.GetState(DevState) = S_OK Then
Debug.Print("DEVICE_STATE: " & DevState.ToString)
End If
Dim PropertyStore As IPropertyStore = Nothing
If MMDevive.OpenPropertyStore(STGM_ACCESS.Read, PropertyStore) = S_OK Then
If PropertyStore IsNot Nothing Then
Dim Props As UInteger
If PropertyStore.GetCount(Props) = S_OK Then
Debug.Print("Properties: " & Props.ToString)
If Props > 0 Then
For Prop As UInteger = 0 To Props - 1UI
Dim PropKey As New PROPERTYKEY
If PropertyStore.GetAt(Prop, PropKey) = S_OK Then
Debug.Print("PKey: " & PropKey.fmtid.ToString & "," & PropKey.pid.ToString)
Dim pCanonicalName As IntPtr
If PSGetNameFromPropertyKey(PropKey, pCanonicalName) = S_OK Then
Debug.Print("CanonicalName: " & Marshal.PtrToStringUni(pCanonicalName))
Marshal.FreeCoTaskMem(pCanonicalName)
End If
Dim PropVar As New PROPVARIANT
If PropertyStore.GetValue(PropKey, PropVar) = S_OK Then
Debug.Print("PropVar.vt: " & PropVar.vt.ToString)
Select Case PropVar.vt
Case VARENUM.VT_BOOL
Debug.Print(CBool(PropVar.boolVal).ToString)
Case VARENUM.VT_I2
Debug.Print(PropVar.iVal.ToString)
Case VARENUM.VT_I4
Debug.Print(PropVar.intVal.ToString)
Case VARENUM.VT_I8
Debug.Print(PropVar.lVal.ToString)
Case VARENUM.VT_UI2
Debug.Print(PropVar.uiVal.ToString)
Case VARENUM.VT_UI4
Debug.Print(PropVar.uintVal.ToString)
Case VARENUM.VT_UI8
Debug.Print(PropVar.ulVal.ToString)
Case VARENUM.VT_LPWSTR
Debug.Print(Marshal.PtrToStringUni(PropVar.pwszVal))
End Select
PropVariantClear(PropVar)
End If
End If
Next
End If
End If
Marshal.ReleaseComObject(PropertyStore)
End If
End If
Marshal.ReleaseComObject(MMDevive)
End If
End If
Next
End If
End If
Marshal.ReleaseComObject(MMDeviceCollection)
End If
End If
Marshal.ReleaseComObject(MMDeviceEnumerator)
End If
End Sub
<ComImport>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
<Guid(IID_IMMDeviceEnumerator)>
Private Interface IMMDeviceEnumerator
<PreserveSig> Function EnumAudioEndpoints(<[In]> dataFlow As DATA_FLOW,
<[In]> dwStateMask As DEVICE_STATE,
<Out, MarshalAs(UnmanagedType.Interface)> ByRef ppDevices As IMMDeviceCollection) As Integer
<PreserveSig> Function GetDefaultAudioEndpoint() As Integer
<PreserveSig> Function GetDevice() As Integer
<PreserveSig> Function RegisterEndpointNotificationCallback() As Integer
<PreserveSig> Function UnregisterEndpointNotificationCallback() As Integer
End Interface
<ComImport>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
<Guid(IID_IMMDeviceCollection)>
Private Interface IMMDeviceCollection
<PreserveSig> Function GetCount(<Out> ByRef pcDevices As UInteger) As Integer
<PreserveSig> Function Item(<[In]> nDevice As UInteger,
<Out, MarshalAs(UnmanagedType.Interface)> ByRef ppDevice As IMMDevice) As Integer
End Interface
<ComImport>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
<Guid(IID_IMMDevice)>
Private Interface IMMDevice
<PreserveSig> Function Activate() As Integer
<PreserveSig> Function OpenPropertyStore(<[In]> stgmAccess As STGM_ACCESS,
<Out, MarshalAs(UnmanagedType.Interface)> ByRef ppProperties As IPropertyStore) As Integer
<PreserveSig> Function GetId(<Out, MarshalAs(UnmanagedType.LPWStr)> ByRef ppstrId As String) As Integer
<PreserveSig> Function GetState(<Out> ByRef pdwState As DEVICE_STATE) As Integer
End Interface
<ComImport>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
<Guid(IID_IPropertyStore)>
Private Interface IPropertyStore
<PreserveSig> Function GetCount(<Out> ByRef cProps As UInteger) As Integer
<PreserveSig> Function GetAt(<[In]> iProp As UInteger,
<Out> ByRef pkey As PROPERTYKEY) As Integer
<PreserveSig> Function GetValue(<[In]> ByRef pkey As PROPERTYKEY,
<Out> ByRef pv As PROPVARIANT) As Integer
<PreserveSig> Function SetValue() As Integer
<PreserveSig> Function Commit() As Integer
End Interface
End Class

dherr · 7. April 2024, 16:29

Mittlerweile wende ich folgenden Code an:
Es wird zunächst benötigt Imports System.Management

Quellcode

Function DeviceDetected() As Array
Dim info As ManagementObject, search As ManagementObjectSearcher
Dim Name, Manu As String, temp(0) As String, i As Short, actFlag As Boolean = False
search = New ManagementObjectSearcher("SELECT * From Win32_PnPEntity")
For Each info In search.Get()
Name = CType(info("Caption"), String)
Manu = CType(info("Manufacturer"), String)
If Not IsNothing(Name) AndAlso (Name.Contains("Lautsprecher") _
OrElse Name.Contains("Speaker") OrElse Name.Contains("Audio)")) Then
''Debug.Print("~~~~~~~~~~~~~~~~")
''For Each p In info.Properties
'' wert = p.Value
'' If Not wert Is Nothing Then
'' Debug.Print(p.Name & " = " & wert.ToString())
'' Else
'' Debug.Print(p.Name & " = (nicht belegt)")
'' End If
''Next
ReDim Preserve temp(i)
temp(i) = Name
i += 1
End If
Next
Return temp
End Function

Der doppelt auskommentierte Code zeigt folgende Properties an:
Availability= (nicht belegt)
Caption=C27F390 (NVIDIA High Definition Audio)
ClassGuid={c166523c-fe0c-4a94-a586-f1a80cfbbf3e}
CompatibleID=System.String[]
ConfigManagerErrorCode=0
ConfigManagerUserConfig=False
CreationClassName=Win32_PnPEntity
Description=Audioendpunkt
DeviceID=SWD\MMDEVAPI\{0.0.0.00000000}.{D8AAA027-616D-4C8E-80C4-53B80A8C191C}
ErrorCleared= (nicht belegt)
ErrorDescription= (nicht belegt)
HardwareID=System.String[]
InstallDate= (nicht belegt)
LastErrorCode= (nicht belegt)
Manufacturer=Microsoft
Name=C27F390 (NVIDIA High Definition Audio)
PNPClass=AudioEndpoint
PNPDeviceID=SWD\MMDEVAPI\{0.0.0.00000000}.{D8AAA027-616D-4C8E-80C4-53B80A8C191C}
PowerManagementCapabilities= (nicht belegt)
PowerManagementSupported= (nicht belegt)
Present=True
Service= (nicht belegt)
Status=OK
StatusInfo= (nicht belegt)
SystemCreationClassName=Win32_ComputerSystem

Leider ist da keine Eigenschaft dabei, die vermittelt, welches Soundgerät gerade aktuell ist (siehe Screenshot-Auswahl).

Grüße - Dietrich

-Franky- · 7. April 2024, 23:16

dherr schrieb:

Leider ist da keine Eigenschaft dabei, die vermittelt, welches Soundgerät gerade aktuell ist

Wenn Du Dir meinen Code anschaust, dann fällt Dir sicher IMMDeviceEnumerator::GetDefaultAudioEndpoint auf. Die MS-Doku sagt dazu: Die GetDefaultAudioEndpoint-Methode ruft den Standard-Audioendpunkt für die angegebene Datenflussrichtung und -rolle ab. Das wäre das, was Du noch suchst. Auch wenn ich diese Interface-Funktion nicht komplett übersetzt habe, sollte es Dir keine Probleme bereiten diese Funktion zu vervollständigen. Siehe dazu in die MS-Doku: learn.microsoft.com/de-de/wind…r-getdefaultaudioendpoint

dherr · 9. April 2024, 12:49

Hi, Franky, danke für deine Tipps. Leider habe ich doch ein Problem mit der Vervollständigung, respektive Aufruf der Funktion GetDefaultAudioEndpoint. Kenne C++ überhaupt nicht, weiß nicht, wie ich das auf VB übertragen kann...
Ich habe mittlerweile deinen Code in ein Module gepackt.
Vielleicht kannst du bitte noch den Code für GetDefaultAudioEndpoint bereitstellen?
Grüße - Dietrich

-Franky- · 9. April 2024, 13:11

Hi Zunächst brauchst Du eine zusätzliche Enum

VB.NET-Quellcode

Private Enum Role As Integer
Console = 0
Multimedia = 1
Communications = 2
End Enum

Im Interface IMMDeviceEnumerator entsprechend die Funktion GetDefaultAudioEndpoint anpassen.

VB.NET-Quellcode

<PreserveSig> Function GetDefaultAudioEndpoint(<[In]> dataFlow As DATA_FLOW,
<[In]> role As Role,
<Out, MarshalAs(UnmanagedType.Interface)> ByRef ppEndpoint As IMMDevice) As Integer

Im Grunde rufst "MMDeviceEnumerator.GetDefaultAudioEndpoint(DATA_FLOW.Render, Role.Multimedia, MMDevice)" auf, lass Dir dann mit MMDevice.GetId die Id ausgeben. Diese Id vergleichst mit der Id, die Du über die Enumeration aller Rendergeräte ermitteln kannst. Stimmen die Ids überein, hast Du das derzeit eingestellte Standardgerät.

dherr · 9. April 2024, 17:14

Also ich habe hinter die Zeile
For Device As UInteger = 0 To Devices - 1UI

die Zeile
Dim idd = MMDeviceEnumerator.GetDefaultAudioEndpoint(DATA_FLOW.Render, Role.Multimedia, MMDevice)
gesetzt. Da ergibt sich aber bei jedem Gerät immer nur 0 ...

-Franky- · 9. April 2024, 17:54

Hi Das was Du noch machen möchtest, kommt unter der Zeile If MMDeviceEnumerator IsNot Nothing Then und ja, der Aufruf von MMDeviceEnumerator.GetDefaultAudioEndpoint gibt 0 = S_Ok zurück, wenn der Aufruf erfolgreich war. Denn dann kannst Du MMDevice.GetId abfragen. Genauso wie nach der Zeile If MMDeviceCollection.Item(... nur das Du hier nur die ID brauchst. Den Rest nicht bis auf das Marshal.ReleaseComObject

dherr · 10. April 2024, 10:00

Danke für deine Tipps, aber ich komme nicht wirklich klar damit.
In deinen Code habe ich das jetzt folgendermaßen eingebaut:

VB.NET-Quellcode

..........
If MMDeviceCollection.Item(Device, MMDevive) = S_OK Then
If MMDevive IsNot Nothing Then
Dim DevId As String = Nothing
If MMDevive.GetId(DevId) = S_OK Then
'Device Ident-Nummer
outArt(StrDup(30, "~") & vbCrLf & "Nummer " _
& (Device + 1).ToString & vbCrLf _
& "DEVICE_ID: " & DevId & vbCrLf)
If MMDeviceEnumerator.GetDefaultAudioEndpoint(DATA_FLOW.Render, Role.Multimedia, MMDevice) = S_OK Then
outArt("EndPoint: " & DevId & vbCrLf)
End If
End If
..................

(outArt ist nur mein Ersatz für das einfache Debug.Print)
Das funktioniert so aber nicht. Was heißt "nur die ID" MMDevice.GetID bringt einen String...

(Ooops, wo kommt denn dieses Brainfuck her???)

Code-Tags korrigiert. (Brainfuck kommt daher, dass die Forensoftware versucht, die Sprache zu erkennen, wenn man nur [code] anstatt z. B. [vbnet] verwendet, und die vielen Punkte am Anfang wohl nach Brainfuck aussahen.) ~Thunderbolt

-Franky- · 10. April 2024, 16:43

Hi Also, ich hatte geschrieben das MMDeviceEnumerator.GetDefaultAudioEndpoint direkt unter "If MMDeviceEnumerator IsNot Nothing Then" kommt. Bei Dir steht der Code aber ganz wo anders. Dann fragst Du bei MMDeviceEnumerator.GetDefaultAudioEndpoint -> MMDevice gar nicht die ID ab (MMDevice.GetId(DevId)) -> String. Diesen String vergleichst mit der ID, die Du innerhalb von MMDeviceCollection.Item(Device, MMDevive) -> MMDevive.GetId(DevId) bekommst. Huch, da hab ich mich wohl vertippelt: MMDevive sollte eigentlich MMDevice benannt werden. Also aus v mach c.

dherr schrieb:

(Ooops, wo kommt denn dieses Brainfuck her???)

Wahrscheinlich wegen den Punkten in Zeile 1 und 14.

dherr · 11. April 2024, 12:33

Habs hinbekommen!!! Ich danke dir für die Tipps und Hinweise!!
Ich werde demnächst meine Programmversion hier einstellen. Ist das OK für dich?

Grüße - Dietrich

-Franky- · 11. April 2024, 13:03

dherr schrieb:

Ich werde demnächst meine Programmversion hier einstellen. Ist das OK für dich?

Ja klar, ich erhebe da keinen Anspruch auf den ursprünglichen Code.

dherr · 12. April 2024, 09:27

Wie macht man das mit einem Spoiler?

-Franky- · 12. April 2024, 12:44

Hi Entweder Du klickst auf dieses durchgestrichene Auge der die Tags automatisch einfügt, oder Du schreibst die Tags [spoiler][/spoiler] selber. Innerhalb dieser Tags kannst Du dann andere Tags einfügen.

dherr · 17. April 2024, 10:03

Mir wäre es lieber, den Code via Zip-File zur Verfügung zu stellen. Geht das auch irgendwie?
Grüße - Dietrich

-Franky- · 17. April 2024, 11:39

Hi. Das geht über "Erweiterte Antwort". Da kannst Du Dateianhänge hochladen. In der ZIP dürfen keine ausführbaren Dateien enthalten sein! Speziell die Ordner BIN und OBJ (bzw. deren UnterOrdner von BIN und OBJ) von Deinem Projekt sollten leer sein.

Mit VBnet ermitteln der Soundeinstellungen (Win11)

Mit VBnet ermitteln der Soundeinstellungen (Win11)

VB.NET-Quellcode

Quellcode

dherr schrieb:

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

dherr schrieb:

dherr schrieb:

Tags

Ähnliche Themen

3 Benutzer haben hier geschrieben