[VB6, Vista+] Core Audio Basics

http://www.vbforums.com/images/ieimages/2016/05/1.jpg
Core Audio Demos

A few days ago I released the latest version of my oleexp typelib containing all of the Core Audio interfaces. Here's a demo of some of the basic features.

All of the functions shown in the above screenshot work, and additionally the 'Mute Default Multimedia Device' button also demonstrates how to set a callback for that device-- if any other app, like the volume mixer, then unmutes or does something else with that device, your app will be notified of the change. Note that all interfaces used for the callback must be module-level and not released while the callback is active, otherwise your app will freeze.

Requirements
-Windows Vista or higher
-oleexp v4.0 (released 24 Nov 2016): Add oleexp.tlb as a reference-- for IDE only, does not need to be redistributed with compiled app.
-oleexp addons: mCoreAudio.bas, mIID.bas, and mPKEY.bas (all of which are now included in main oleexp download).

Code Example: Muting all active capture devices (e.g. microphones)

Code:

---

Dim sOut As String
Dim i As Long
Dim lp As Long
Dim s1 As String
Dim sName As String

Dim pDvEnum As MMDeviceEnumerator
Set pDvEnum = New MMDeviceEnumerator

Dim pDvCol As IMMDeviceCollection

pDvEnum.EnumAudioEndpoints eCapture, DEVICE_STATE_ACTIVE, pDvCol

If (pDvCol Is Nothing) = False Then
    Dim nCount As Long
    Dim pDevice As IMMDevice
    If pDvCol.GetCount(nCount) = S_OK Then
        If nCount > 0 Then
            For i = 0 To (nCount - 1)
                sName = GetDeviceName(pDvCol, i)
                sOut = sOut & "Muting Device(" & i & ", Name=" & sName & ")..." & vbCrLf
                pDvCol.Item i, pDevice
                If (pDevice Is Nothing) = False Then
                    Dim pAEV As IAudioEndpointVolume
                    pDevice.Activate IID_IAudioEndpointVolume, CLSCTX_INPROC_SERVER, CVar(0), pAEV
                    If (pAEV Is Nothing) = False Then
                        If pAEV.SetMute(1, UUID_NULL) = S_OK Then
                            sOut = sOut & "...Device successfully muted!" & vbCrLf
                        Else
                            sOut = sOut & "...Failed to mute device " & i & " (" & sName & "). Already muted?" & vbCrLf
                        End If
                    Else
                        Debug.Print "Failed to set pAEV"
                        sOut = sOut & "...An error occured accessing the volume control." & vbCrLf
                    End If
                Else
                    Debug.Print "Failed to set pDevice"
                    sOut = sOut & "...Failed to get pointer to device." & vbCrLf
                End If
            Next
        Else
            sOut = "No active devices found." & vbCrLf
        End If
    Else
        Debug.Print "Failed to get device count."
        sOut = sOut & "An error occured getting the device count." & vbCrLf
    End If
Else
    Debug.Print "Failed to set pDvCol"
    sOut = "Failed to get device collection (no active devices or an error occured)"
End If
Text1.Text = sOut

---

---------------------

twinBASIC 64bit-compatible version can be found at: https://github.com/fafalone/CoreAudioDemos

Regarding,

Code:

---

IMMNotificationClient
{
    [id(5), helpstring("method OnPropertyValueChanged")]
    HRESULT OnPropertyValueChanged([in] LONG pwstrDeviceId, [in] PROPERTYKEY *key);
};

---

It's actually an [in] PROPERTYKEY not an PROPERTYKEY* or REFPROPERTYKEY...
If you catch my drift on this can of worms. you have to pass all the struct members individually in order for VB6 to implement it. I've seen shortcuts where (GDIPlus typelib's) you just break it out to the correct number of Bytes/Longs.

from VB6 it looks like

Code:

---

Private Sub IMMNotificationClient_OnPropertyValueChanged(ByVal pwstrDeviceId As Long, _
    ByVal L As Long, _
    ByVal w1 As Integer, _
    ByVal w2 As Integer, _
    ByVal B0 As Byte, _
    ByVal b1 As Byte, _
    ByVal b2 As Byte, _
    ByVal B3 As Byte, _
    ByVal b4 As Byte, _
    ByVal b5 As Byte, _
    ByVal b6 As Byte, _
    ByVal b7 As Byte, _
    ByVal pid As Long)
   
End Sub

---

Code:

---

    [id(5), helpstring("method OnPropertyValueChanged")]
    HRESULT OnPropertyValueChanged([in] LONG pwstrDeviceId,
                [in] LONG key,
                [in] short w1,
                [in] short w2,
                [in] BYTE b0,
                [in] BYTE b1,
                [in] BYTE b2,
                [in] BYTE B3,
                [in] BYTE b4,
                [in] BYTE b5,
                [in] BYTE b6,
                [in] BYTE b7,
                [in] LONG pid);

---

I see what you're saying... there seems to be a deeper problem though as now with that change it's causing an app crash when that event fires.
I thought it might be a conflict with also having the endpoint callback, so I disabled that, and it got even weirder. The app crashed before the code in the property changed event fired before (as it does with the byref PROPERTYKEY); but now the code there executes before the app crash, and it output the PROPERTYKEY pid as 17502305 or something, which is obviously completely invalid. There's no pids with more than 3 digits.

All it consists of is

Code:

---

If (cMMNotify Is Nothing) Then
    Set cMMNotify = New cMMNotificationClient
    hr = mDeviceEnum.RegisterEndpointNotificationCallback(cMMNotify)
    Debug.Print "Registered cMMNotify, hr=" & Hex$(hr)
End If

---

and in the class

Code:

---

Private Sub IMMNotificationClient_OnPropertyValueChanged(ByVal pwstrDeviceId As Long, _
    ByVal L As Long, _
    ByVal w1 As Integer, _
    ByVal w2 As Integer, _
    ByVal B0 As Byte, _
    ByVal b1 As Byte, _
    ByVal b2 As Byte, _
    ByVal B3 As Byte, _
    ByVal b4 As Byte, _
    ByVal b5 As Byte, _
    ByVal b6 As Byte, _
    ByVal b7 As Byte, _
    ByVal pid As Long)
Debug.Print "IMMNotificationClient_OnPropertyValueChanged data1=" & Hex$(L) & ",pid=" & pid
End Sub

---

I changed the icon to trigger the call to that event. The other events appear to work normally with no crashes.

I thought I was on to something when I tried to just get a memory pointer to the PKEY by making it a single long... it passes a non-zero number and doesn't crash, but it doesn't seem to be a valid memory address since CopyMemory crashes the app.

With the full pkey members passed ByVal, I tried to dig a little deeper and apparently it's trying to read invalid memory (no code in sub; even removed Debug.Print statement)... callstack:
> 00000000()
MMDevAPI.dll!CDeviceEnumerator::OnPropertyValueChanged() + 0x11c bytes
MMDevAPI.dll!CLocalEndpointEnumerator::OnMediaNotification() + 0xbe bytes
MMDevAPI.dll!CMediaNotifications::OnMediaNotificationWorkerHandler() - 0x2f bytes
MMDevAPI.dll!CMediaNotifications::MediaNotificationWorkerHandler() + 0x10 bytes
ntdll.dll!_TppSimplepExecuteCallback@8() + 0x7b bytes
ntdll.dll!_TppWorkerThread@4() + 0x5a4 bytes

Unhandled exception at 0x00000000 in VB6.EXE: 0xC0000005: Access violation reading location 0x00000000.

If I swap the sub out to a function (SwapVTableEntry), which still gives a garbage PID before the crash, I get an error writing a non-zero location (why is it even trying to read and write after the function exits anyway)

Unhandled exception at 0x77212289 (ntdll.dll) in VB6.EXE: 0xC0000005: Access violation writing location 0x66ce8db3.
77212289 add dword ptr [esi+8],0FFFFFFFFh

> ntdll.dll!_RtlLeaveCriticalSection@4() + 0x9 bytes
MMDevAPI.dll!CDeviceEnumerator::OnPropertyValueChanged() + 0x106 bytes
MMDevAPI.dll!CLocalEndpointEnumerator::OnMediaNotification() + 0xbe bytes
MMDevAPI.dll!CMediaNotifications::OnMediaNotificationWorkerHandler() - 0x2f bytes
MMDevAPI.dll!CMediaNotifications::MediaNotificationWorkerHandler() + 0x10 bytes
ntdll.dll!_TppSimplepExecuteCallback@8() + 0x7b bytes


------------------------------
Edit: So this continues to get more bizarre. Above I mentioned no crash if I had a single long? Well, that first long is 259ABFFC. I added the members back one by one.
L and W1 = 259ABFFC-50A7 which is how the expected PROPERTYKEY begins for PKEY_DeviceClass_xxxx where xxxx here could be Icon or IconPath.
The weird thing it, w2 doesn't match, and the bytes change at random despite being the same for every PKEY_DeviceClass_ entry (only the PIDs differ).
Weirder still, the bytes began to vary at b3.
When b5 was added back in, the app froze.
And finally, adding b6 in the app begins to crash again.

Needless to say, I'm completely dumbfounded about what to do.

Code:

---

    [id(5), helpstring("method OnPropertyValueChanged")]
    HRESULT OnPropertyValueChanged([in] LONG pwstrDeviceId,
                [in] LONG key,
                [in] short w1,
                [in] short w2,
                [in] BYTE b0,
                [in] BYTE b1,
                [in] BYTE b2,
                [in] BYTE b3,
                [in] BYTE b4);

---

Any more values result in freeze/crash, but this declare gives the beginning of what the PROPERTYKEY should be...
w2, b0, b1, b2 are always 08AF-A7 0C 98
b3 and on vary, pid is always garbage
Btw, pwstrDeviceId points to a valid id string retrieved with SysReallocString, no error crash or bad data.

This is a giant W-T-F at this point.

Quote:

---

Originally Posted by fafalone

This is a giant W-T-F at this point.

---

Alignement. Use `offsetof` in a C/C++ console app to detect how the struct gets packed according SDK declaration.

Note that all stack params are 4-bytes aligned so b/n param BYTE b0 and BYTE b1 there are 3 bytes padding where "missing" data might be hidden.

cheers,
</wqw>

I thought in alignment the total structure size would be padded to an interval... are you saying each member of the PKEY is padded to 4 bytes? short is two bytes right? So that would be padded too? And how would I recover the proper data?

Edit: I tried padding each byte argument to 4. Crash + garbage data. I tried also padding the short's to 4. Crash + garbage data. (garbage data meaning the pid is a long random number instead of 1-99 like it should be)

Code:

---

HRESULT OnPropertyValueChanged([in] LONG pwstrDeviceId, [in] LONG GUID_Data1, [in] LONG GUID_Data2, [in] LONG GUID_Data3, [in] LONG GUID_Data4, [in] LONG pid);

---

Code:

---

IMMNotificationClient_OnPropertyValueChanged(ByVal pwstrDeviceId As Long, ByVal GUID_Data1 As Long, ByVal GUID_Data2 As Long, ByVal GUID_Data3 As Long, ByVal GUID_Data4 As Long, ByVal pid As Long)

---

Crash occurs because OnPropertyValueChanged is called in other thread.

Quote:

---

Originally Posted by fafalone

are you saying each member of the PKEY is padded to 4 bytes?

---

Most probably -- default behavior is alignment to apply for each member (in VB too). Could be changed with pragma packed and that's why I suggested using SDK declaration and printf + offsetof(Struct, member) in a small C/C++ app to "measure" what's going on. Passing structs byval on the stack is quite rare though.

But threading issues here would be devastating IMO.

cheers,
</wqw>

Each the member is aligned to this size boundary. In the stack each member is aligned to 4.
For example:

Code:

---

Type ZZZ
    q As Long
    b As Byte
    j As Integer
    c As Currency
    k As Byte
    l As Long
End Type

---

q occupies [0;3] bytes; b - [4] byte; j - [6;7]; c - [8;15]; k - [16]; l - [20;23]

It generally seems to be working now with setting everything to a Long... I guess I thought alignment meant something else. I thought it meant as described in post #8 above... but that's not the same thing..
b is at byte 4, but then j would start at byte 5, not byte 6 (how is that aligned to 4 anyway? it's aligned to 2.) or byte 8 if each member was padded to 4 bytes.
And I also would really like to know out of the hundreds of interfaces I've worked with in the past 18 months why this one member of this one function is displaying this uniquely odd behavior.

Anyway, this works:

Code:

---

Private Sub IMMNotificationClient_OnPropertyValueChanged(ByVal pwstrDeviceId As Long, _
    ByVal L As Long, _
    ByVal w12 As Long, _
    ByVal B0123 As Long, _
    ByVal B4567 As Long, _
    ByVal pid As Long)

Dim bt1(3) As Byte
Dim bt2(3) As Byte
Dim w1 As Integer
Dim w2 As Integer

CopyMemory ByVal VarPtr(w1), ByVal VarPtr(w12), 2&
CopyMemory ByVal VarPtr(w2), ByVal (VarPtr(w12) + 2), 2&
CopyMemory ByVal VarPtr(bt1(0)), ByVal VarPtr(B0123), 4&
CopyMemory ByVal VarPtr(bt2(0)), ByVal VarPtr(B4567), 4&

    Debug.Print "PVC key={" & Hex$(L) & "-" & Hex$(w1) & "-" & Hex$(w2) & "-(" & Hex$(bt1(0)) & "," & Hex$(bt1(1)) & "," & Hex$(bt1(2)) & "," & Hex$(bt1(3)) & "," & Hex$(bt2(0)) & "," & Hex$(bt2(1)) & "," & Hex$(bt2(2)) & "," & Hex$(bt2(3)) & ")" & ",pid=" & pid

End Sub

---

PVC key={259ABFFC-50A7-47CE-(AF,8,68,C9,A7,D7,33,66),pid=12

Quote:

---

Originally Posted by fafalone

b is at byte 4, but then j would start at byte 5, not byte 6 (how is that aligned to 4 anyway? it's aligned to 2.) or byte 8 if each member was padded to 4 bytes.

---

Look:

Code:

---

Option Explicit

Private Type ZZZ
    q As Long
    b As Byte
    j As Integer
    c As Currency
    k As Byte
    l As Long
End Type

Private Sub Form_Load()
    Dim p As ZZZ
   
    Debug.Print String$(20, "-")
    Debug.Print VarPtr(p.q) - VarPtr(p)
    Debug.Print VarPtr(p.b) - VarPtr(p)
    Debug.Print VarPtr(p.j) - VarPtr(p)
    Debug.Print VarPtr(p.c) - VarPtr(p)
    Debug.Print VarPtr(p.k) - VarPtr(p)
    Debug.Print VarPtr(p.l) - VarPtr(p)
    Debug.Print String$(20, "-")
   
End Sub

---

Quote:

---

--------------------
0
4
6
8
16
20
--------------------

---

A byte field is never padded, an integer field is padded to the 2 boundary (Len(Integer)), a Long is padded to the 4 boundary (Len(Long)), etc...
There is other behavior when you pass parameters in the stack (each parameter is padded to 4 boundary:

Code:

---

Option Explicit

Private Sub Form_Load()
    XXX 1, 2, 3, 4, 5, 6
End Sub

Private Sub XXX(ByVal q As Long, _
                ByVal b As Byte, _
                ByVal j As Integer, _
                ByVal c As Currency, _
                ByVal k As Byte, _
                ByVal l As Long)
               
    Debug.Print String$(20, "-")
    Debug.Print VarPtr(q) - VarPtr(q)
    Debug.Print VarPtr(b) - VarPtr(q)
    Debug.Print VarPtr(j) - VarPtr(q)
    Debug.Print VarPtr(c) - VarPtr(q)
    Debug.Print VarPtr(k) - VarPtr(q)
    Debug.Print VarPtr(l) - VarPtr(q)
    Debug.Print String$(20, "-")
   
End Sub

---

Quote:

---

--------------------
0
4
8
12
20
24
--------------------

---

Quote:

---

Originally Posted by fafalone

Anyway, this works:

---

Sure, works in P-code (unstable) in my PC too, try to call a MsgBox and access to the form. Try to compile to Native code and run it with MsgBox - i have crash. You should pass the call to main thread.
FYI, you can do so:

Code:

---

Private Sub IMMNotificationClient_OnPropertyValueChanged(ByVal pwstrDeviceId As Long, ByVal GUID_Data1 As Long, ByVal GUID_Data2 As Long, ByVal GUID_Data3 As Long, ByVal GUID_Data4 As Long, ByVal pid As Long)
    Dim k As UUID
    Dim s As String
   
    CopyMemory k, GUID_Data1, Len(k)
    s = Space(40)
    StringFromGUID2 k, s, Len(s)
   
    Debug.Print "PVC key=" & s & ", pid=" & pid

End Sub

---

Because all the variables lay in the stack successively.

Pass what call to what main thread? Crashes without even a MsgBox call when compiled; using both how I was originally copying out the variables and using your code.

And even worse it's not limited to just the stupid propertykey either, everything in every function is making it crash when compiled.


...the f is it with this one callback that is so radically different than the other two dozen shell interface callbacks in my tlb..

Quote:

---

Originally Posted by fafalone

Pass what call to what main thread? Crashes without even a MsgBox call when compiled; using both how I was originally copying out the variables and using your code.

---

I told call the MsgBox in order to see that MsgBox is shown modally. If so, it means that calling was in the main thread otherwise in other.
In IDE:
Attachment 138291
In Native compile:
Attachment 138293
BTW, i unplugged my microphone.
As you can see the MsgBox is called in other thread (look at ThreadID). I think it is the normal behavior because imagine that your application does the 'heavy' cycle without DoEvents and device sends a notification to your callback interface. How should the application processes this notification? Wait?

In order to bypass the threading issues you should route the call to main thread. You can send the APC query, PostMessage or other method, but you should do it from the already compiled code (DLL, AsmCode or something else) because in IDE crashes occur too. It is better if you make the DLL that provides the same routed interface.

How could I even pass the data to another thread if I can't access it?

I tried sending it to a new thread in a DLL that then used SendMessage to send it back to my form, but again it only works in the IDE, presumably because I still have to get the value of the arguments to pass them off.

I v-table swapped the whole function out to a module, and that didn't help either.

Code:

---

        extern "C" CSUPPORT_API HRESULT __stdcall MessageAsync(HWND hOwner, UINT uOps)
{
        DWORD ThreadID;
        MBArgs args = {hOwner, uOps};
HANDLE hThread=CreateThread(0,0,(LPTHREAD_START_ROUTINE)DispApiMsg, &args,0,&ThreadID);

(...)
DWORD CALLBACK DispApiMsg(LPVOID pArgs_) {
        MBArgs *pArgs = (MBArgs*)pArgs_;
        ::SendMessage(pArgs->hOwner,(UINT)0x8033,(WPARAM)pArgs->uOps,NULL);

---

or

Code:

---

Public Function SwapVtableEntry(pObj As Long, EntryNumber As Integer, ByVal lpfn As Long) As Long

    Dim lOldAddr As Long
    Dim lpVtableHead As Long
    Dim lpfnAddr As Long
    Dim lOldProtect As Long

    CopyMemory lpVtableHead, ByVal pObj, 4
    lpfnAddr = lpVtableHead + (EntryNumber - 1) * 4
    CopyMemory lOldAddr, ByVal lpfnAddr, 4

    Call VirtualProtect(lpfnAddr, 4, PAGE_EXECUTE_READWRITE, lOldProtect)
    CopyMemory ByVal lpfnAddr, lpfn, 4
    Call VirtualProtect(lpfnAddr, 4, lOldProtect, lOldProtect)

    SwapVtableEntry = lOldAddr

End Function
Public Function OnPropertyValueChangedVB(ByVal this As IMMNotificationClient, ByVal pwstrDeviceId As Long, _

---

Sending the whole thing to a different thread to begin with might be a little beyond my abilities at the moment...

I think what Trick is saying is that the callback itself is called from an already created new thread. (standard practice with multi-media APIs)

you need to send the data back to the Main thread using something like PostMessage :) or APC.
Also you can't call any VB runtime functions in your callback, you can only call typelib'd API routines that return long (not HRESULT)

But how can you send the data anywhere if even calling a DLL function with it causes a crash... in post 14 the only code in the callback function is a single line calling MessageAsync, but even passing the value to that causes a crash.

Just a single line in OnPropertyValueChanged calling PostMessage (to form hwnd) still has to access the arguments, so as I expected, worked in IDE, crashed in compiled app.

Edit:
So why does putting the declare in a typelib make a difference? Just to be thorough I tried it, and FINALLY no crash in IDE or compiled. (previously it was in a public module, not the callback class)

Wait. I'm doing the example...

Quote:

---

Originally Posted by DEXWERX

Also you can't call any VB runtime functions in your callback

---

Can. Redim, Space$, Ubound, and many others.
@fafalone, i've done simple example. It is the proxy object that routes the call to main thread. You should create a proxy object and set your callback object then register notification to proxy. When call is being occurred proxy routes the call to main thread.

Code:

---

Set pReceiver = New IMMNotifyReceiver
Set pReceiver.ReceiverObject = Me

Set pDvEnum = New MMDeviceEnumerator
pDvEnum.RegisterEndpointNotificationCallback pReceiver

---

Seems it works.
Attachment 138325
ActiveX DLL code:
A class:

Code:

---

Option Explicit

Implements IMMNotificationClient

Private mReceiverObject As IMMNotificationClient
Private mRouterHwnd    As Long

Public Property Get ReceiverObject() As IMMNotificationClient
    Set ReceiverObject = mReceiverObject
End Property
Public Property Set ReceiverObject( _
                    ByVal NewValue As IMMNotificationClient)
    Set mReceiverObject = NewValue
End Property

Private Sub Class_Initialize()
    mRouterHwnd = CreateRouterWindow()
End Sub

Private Sub Class_Terminate()
    DestroyRouterWindow mRouterHwnd
End Sub

Private Sub IMMNotificationClient_OnDefaultDeviceChanged( _
            ByVal flow As EDataFlow, _
            ByVal role As ERole, _
            ByVal pwstrDefaultDeviceId As Long)
    Dim ddc As DefaultDeviceChanged
   
    ddc.flow = flow
    ddc.role = role
    ddc.pwstrDefaultDeviceId = AllocateData(pwstrDefaultDeviceId, (lstrlen(ByVal pwstrDefaultDeviceId) + 1) * 2)
   
    PostMessage mRouterHwnd, WM_OnDefaultDeviceChanged, ObjPtr(mReceiverObject), ByVal AllocateData(VarPtr(ddc), Len(ddc))
   
End Sub

Private Sub IMMNotificationClient_OnDeviceAdded( _
            ByVal pwstrDeviceId As Long)
    PostMessage mRouterHwnd, WM_OnDeviceAdded, ObjPtr(mReceiverObject), ByVal AllocateData(pwstrDeviceId, (lstrlen(ByVal pwstrDeviceId) + 1) * 2)
End Sub

Private Sub IMMNotificationClient_OnDeviceRemoved( _
            ByVal pwstrDeviceId As Long)
    PostMessage mRouterHwnd, WM_OnDeviceRemoved, ObjPtr(mReceiverObject), ByVal AllocateData(pwstrDeviceId, (lstrlen(ByVal pwstrDeviceId) + 1) * 2)
End Sub

Private Sub IMMNotificationClient_OnDeviceStateChanged( _
            ByVal pwstrDeviceId As Long, _
            ByVal dwNewState As DEVICE_STATE)
    Dim dsc As DeviceStateChanged
   
    dsc.pwstrDeviceId = AllocateData(pwstrDeviceId, (lstrlen(ByVal pwstrDeviceId) + 1) * 2)
    dsc.dwNewState = dwNewState
   
    PostMessage mRouterHwnd, WM_OnDeviceStateChanged, ObjPtr(mReceiverObject), ByVal AllocateData(VarPtr(dsc), Len(dsc))
   
End Sub

Private Sub IMMNotificationClient_OnPropertyValueChanged( _
            ByVal pwstrDeviceId As Long, _
            ByVal GUID_Data1 As Long, _
            ByVal GUID_Data2 As Long, _
            ByVal GUID_Data3 As Long, _
            ByVal GUID_Data4 As Long, _
            ByVal pid As Long)
    Dim pvc As PropertyValueChanged
   
    pvc.pwstrDeviceId = AllocateData(pwstrDeviceId, (lstrlen(ByVal pwstrDeviceId) + 1) * 2)
    pvc.GUID_Data1 = GUID_Data1
    pvc.GUID_Data2 = GUID_Data2
    pvc.GUID_Data3 = GUID_Data3
    pvc.GUID_Data4 = GUID_Data4
    pvc.pid = pid
   
    PostMessage mRouterHwnd, WM_OnPropertyValueChanged, ObjPtr(mReceiverObject), ByVal AllocateData(VarPtr(pvc), Len(pvc))
   
End Sub

---

A module:

Code:

---

Option Explicit

Public Type DefaultDeviceChanged
    flow                    As EDataFlow
    role                    As ERole
    pwstrDefaultDeviceId    As Long
End Type

Public Type DeviceStateChanged
    pwstrDeviceId          As Long
    dwNewState              As DEVICE_STATE
End Type

Public Type PropertyValueChanged
    pwstrDeviceId          As Long
    GUID_Data1              As Long
    GUID_Data2              As Long
    GUID_Data3              As Long
    GUID_Data4              As Long
    pid                    As Long
End Type

Public Const ROUTE_WND_CLASS            As String = "TrickRouteClass"
Public Const HWND_MESSAGE              As Long = -3
Public Const HEAP_NO_SERIALIZE          As Long = &H1
Public Const WM_USER                    As Long = &H400

Public Const WM_OnDefaultDeviceChanged  As Long = WM_USER
Public Const WM_OnDeviceAdded          As Long = WM_USER + 1
Public Const WM_OnDeviceRemoved        As Long = WM_USER + 2
Public Const WM_OnDeviceStateChanged    As Long = WM_USER + 3
Public Const WM_OnPropertyValueChanged  As Long = WM_USER + 4

' // Create a router window
Public Function CreateRouterWindow() As Long
    Dim Class  As WNDCLASSEX
    Dim hwnd    As Long
    Dim count  As Long
   
    Class.cbSize = Len(Class)
   
    If GetClassInfoEx(GetModuleHandle(ByVal 0&), ROUTE_WND_CLASS, Class) = 0 Then

        Class.hInstance = GetModuleHandle(ByVal 0&)
        Class.lpfnwndproc = GetAddr(AddressOf WindowProc)
        Class.lpszClassName = ROUTE_WND_CLASS
        Class.cbClsextra = 4

        If RegisterClassEx(Class) = 0 Then Exit Function

    End If
   
    hwnd = CreateWindowEx(0, ROUTE_WND_CLASS, vbNullString, 0, 0, 0, 0, 0, HWND_MESSAGE, 0, GetModuleHandle(ByVal 0&), ByVal 0&)
    If hwnd = 0 Then Exit Function

    count = GetClassLong(hwnd, 0) + 1
    SetClassLong hwnd, 0, count
   
    CreateRouterWindow = hwnd
   
End Function

' // Destroy the router window
Public Function DestroyRouterWindow( _
                ByVal hwnd As Long) As Boolean
    Dim count  As Long
   
    count = GetClassLong(hwnd, 4) - 1
    DestroyWindow hwnd
   
    If count = 0 Then

        UnregisterClass ROUTE_WND_CLASS, App.hInstance
       
    End If
   
End Function

' // Allocate data
Public Function AllocateData( _
                ByVal lpData As Long, _
                ByVal size As Long) As Long
    Dim lpNewData  As Long
   
    lpNewData = HeapAlloc(GetProcessHeap(), HEAP_NO_SERIALIZE, size)
    If lpNewData = 0 Then Exit Function
   
    memcpy ByVal lpNewData, ByVal lpData, size
   
    AllocateData = lpNewData
   
End Function

' // Callback proc
Private Function WindowProc( _
                ByVal hwnd As Long, _
                ByVal uMsg As Long, _
                ByVal wParam As Long, _
                ByVal lParam As Long) As Long
    Dim notifyClient    As IMMNotificationClient
   
    Select Case uMsg
    Case WM_OnDefaultDeviceChanged
        Dim ddc As DefaultDeviceChanged
       
        GetMem4 wParam, notifyClient
        memcpy ddc, ByVal lParam, Len(ddc)
        notifyClient.OnDefaultDeviceChanged ddc.flow, ddc.role, ddc.pwstrDefaultDeviceId
        HeapFree GetProcessHeap(), HEAP_NO_SERIALIZE, ddc.pwstrDefaultDeviceId
        HeapFree GetProcessHeap(), HEAP_NO_SERIALIZE, lParam
        GetMem4 0&, notifyClient
       
    Case WM_OnDeviceAdded
       
        GetMem4 wParam, notifyClient
        notifyClient.OnDeviceAdded lParam
        HeapFree GetProcessHeap(), HEAP_NO_SERIALIZE, lParam
        GetMem4 0&, notifyClient
       
    Case WM_OnDeviceRemoved
   
        GetMem4 wParam, notifyClient
        notifyClient.OnDeviceRemoved lParam
        HeapFree GetProcessHeap(), HEAP_NO_SERIALIZE, lParam
        GetMem4 0&, notifyClient
       
    Case WM_OnDeviceStateChanged
        Dim dsc As DeviceStateChanged
       
        GetMem4 wParam, notifyClient
        memcpy dsc, ByVal lParam, Len(dsc)
        notifyClient.OnDeviceStateChanged dsc.pwstrDeviceId, dsc.dwNewState
        HeapFree GetProcessHeap(), HEAP_NO_SERIALIZE, dsc.pwstrDeviceId
        HeapFree GetProcessHeap(), HEAP_NO_SERIALIZE, lParam
        GetMem4 0&, notifyClient
       
    Case WM_OnPropertyValueChanged
        Dim pvc As PropertyValueChanged
       
        GetMem4 wParam, notifyClient
        memcpy pvc, ByVal lParam, Len(pvc)
        notifyClient.OnPropertyValueChanged pvc.pwstrDeviceId, pvc.GUID_Data1, pvc.GUID_Data2, pvc.GUID_Data3, pvc.GUID_Data4, pvc.pid
        HeapFree GetProcessHeap(), HEAP_NO_SERIALIZE, pvc.pwstrDeviceId
        HeapFree GetProcessHeap(), HEAP_NO_SERIALIZE, lParam
        GetMem4 0&, notifyClient
       
    Case Else
       
        WindowProc = DefWindowProc(hwnd, uMsg, wParam, ByVal lParam)
       
    End Select
   
End Function

Private Function GetAddr( _
                ByVal value As Long) As Long
    GetAddr = value
End Function

---

All the APIs declared in the TLB (Import.tlb). I don't test it enough.

Yeah putting the PostMessage declare in the TLB fixes it... but why? Not sure why putting the declare in a module or the class doesn't work, but putting the declare in a TLB does. The TLB info just gets compiled into the exe anyway.

Too many people only care IF it works, but I still care WHY it works. (and for that matter, I went back and checked the other callback interfaces I've worked with, and they all work fine when compiled. this one seems to have the evil bit set and I still want to know why)


-----------------
Edit: PostMessage alone seems sufficient; no crashes in either IDE or compiled app... is there a particular reason to use a DLL in light of that?

Code:

---

Public Type MM_PropValStruct
    lpszID As Long
    GUID_Data1 As Long
    GUID_Data2 As Long
    GUID_Data3 As Long
    GUID_Data4 As Long
    pid As Long
End Type
Public tPVC As MM_PropValStruct

Private Sub IMMNotificationClient_OnPropertyValueChanged(ByVal pwstrDeviceId As Long, ByVal L As Long, ByVal w12 As Long, ByVal B0123 As Long, ByVal B4567 As Long, ByVal pid As Long)    ',
tPVC.lpszID = pwstrDeviceId
tPVC.GUID_Data1 = L
tPVC.GUID_Data2 = w12
tPVC.GUID_Data3 = B0123
tPVC.GUID_Data4 = B4567
tPVC.pid = pid
PostMessage hFrm, WM_MMONPROPERTYVALUECHANGED, 0, ByVal 0&
End Sub

        Case WM_MMONPROPERTYVALUECHANGED
            Form1.Text1.Text = Form1.Text1.Text & vbCrLf & "Got WM_MMONPROPERTYVALUECHANGED"
            Dim sPtr As String
            Dim tPK As PROPERTYKEY
            sPtr = LPWSTRtoStr(tPVC.lpszID, False)
            Form1.Text1.Text = Form1.Text1.Text & vbCrLf & "Resolved ptr to: " & sPtr
            CopyMemory tPK, tPVC.GUID_Data1, LenB(tPK)
            Form1.Text1.Text = Form1.Text1.Text & vbCrLf & "Resolved pkk to: " & PKEYtoSTR(tPK)


'also didn't know if there was something like StringFromGUID2 for a PROPERTYKEY, so rolled my own:
Public Function PKEYtoSTR(tk As PROPERTYKEY) As String
PKEYtoSTR = "{" & Hex$(tk.fmtid.Data1) & "-" & Format(Hex$(tk.fmtid.Data2), "0000") & "-" & Format(Hex$(tk.fmtid.Data3), "0000") & _
            "-" & Format(Hex$(tk.fmtid.Data4(0)), "00") & Format(Hex$(tk.fmtid.Data4(1)), "00") & "-" & _
            Format(Hex$(tk.fmtid.Data4(2)), "00") & Format(Hex$(tk.fmtid.Data4(3)), "00") & Format(Hex$(tk.fmtid.Data4(4)), "00") & Format(Hex$(tk.fmtid.Data4(5)), "00") & Format(Hex$(tk.fmtid.Data4(6)), "00") & Format(Hex$(tk.fmtid.Data4(7)), "00") & _
            "}," & tk.pid
End Function

---

I'm sure it can be polished up a bit but unless I'm missing something there's no reason to add a DLL.

Edit: Setting two different callbacks on the same device is still crashville, but I'm going to close my eyes and pretend I didn't see that. Too rare a scenario to worry about.

Edit 2: Oh joy, looks like we have the same issue on the other audio callback in the project. But not in any of the non-Core Audio callbacks I tested today.

Quote:

---

Originally Posted by fafalone

Yeah putting the PostMessage declare in the TLB fixes it... but why?

---

Not always. There is usesgetlasterror attribute that enforces the runtime to call __vbaSetSystemError function that sets the property LastDllError of the Err object. If you had used this attribute it wouldn't have worked.

Quote:

---

Originally Posted by fafalone

Not sure why putting the declare in a module or the class doesn't work, but putting the declare in a TLB does. The TLB info just gets compiled into the exe anyway.

---

You can read this article. There is an explanation and bypass.

Quote:

---

Originally Posted by fafalone

Too many people only care IF it works, but I still care WHY it works. (and for that matter, I went back and checked the other callback interfaces I've worked with, and they all work fine when compiled. this one seems to have the evil bit set and I still want to know why)

---

You shouldn't use the non-main thread in P-Code anyway even with TLB-API. Code in IDE used global variables, for example EbMode that returns the current state of code execution. If you set a breakpoint to an other-thread function it'll occur the indeterminate state. You should use either the precompiled code or the native code that doesn't use runtime (asm).
Did you see the my example? This is thread-safe code, because the call is routed to main thread.

Quote:

---

Originally Posted by The trick

Can. Redim, Space$, Ubound, and many others.

---

Right, I've only given a rule of thumb as No-ones posted a difinitive list of what is/isn't usable without the runtime initialized on a new thread.
I actually didn't even think UBound was a function!... I was hoping it was an intrinsic. :D

Quote:

---

Originally Posted by fafalone

Edit: PostMessage alone seems sufficient; no crashes in either IDE or compiled app... is there a particular reason to use a DLL in light of that?

---

You shouldn't use global variable for routing the call because device sends several notifications and there is probability the main thread can't process them. You should allocate a variable for each notification. If you don't want use a DLL you can use an ASM code.

How do I set it to raise events on volume changes?

I tried the caudiosessionevents class, but IAudioSessionEvents_OnSimpleVolumeChanged doesn't get raised when I change my volume

Assuming you want volume notifications on the current default device (where audio is currently coming out of), you'll want to use IAudioEndpointVolumeCallback instead.

First a very simple class, cAudioEndpointVolumeCallback

Code:

---

Option Explicit

Implements IAudioEndpointVolumeCallback

Private Sub IAudioEndpointVolumeCallback_OnNotify(tNotify As AUDIO_VOLUME_NOTIFICATION_DATA)

Debug.Print "EndpointVolCallback: mute=" & tNotify.bMuted
Debug.Print "Master vol=" & tNotify.fMasterVolume & ",channels=" & tNotify.nChannels
End Sub

---

Here's what setting it up looks like:
Module-level:

Code:

---

Private mDeviceEnum As MMDeviceEnumerator
Private pEPVolMM As IAudioEndpointVolume
Private cVolCallback As cAudioEndpointVolumeCallback
Private mDefRenderMM As IMMDevice

---

Then...

Code:

---

Set mDeviceEnum = New MMDeviceEnumerator

mDeviceEnum.GetDefaultAudioEndpoint eRender, eMultimedia, mDefRenderMM

If (mDefRenderMM Is Nothing) = False Then
   
    mDefRenderMM.Activate IID_IAudioEndpointVolume, CLSCTX_INPROC_SERVER, CVar(0), pEPVolMM
    If (pEPVolMM Is Nothing) = False Then
        If (cVolCallback Is Nothing) Then
            Set cVolCallback = New cAudioEndpointVolumeCallback
            pEPVolMM.RegisterControlChangeNotify cVolCallback
            Debug.Print "Callback registered. Adjusting in Explorer or elsewhere will notify this app too."
        End If
    End If
End If

---

If you want volume notifications for the currently active input device, e.g. microphone, you'd change eRender to eCapture.
If you wanted to adjust volume via code, pEPVolMM will have a bunch of methods to set volume, mute, unmute, etc


Edit: Attaching a quick demo project:
https://i.imgur.com/Kmdf5WM.jpg

Just add mCoreAudio.bas and mIID.bas from the oleexp zip.

Can you expouse QueryInterface method of IConnector?! I am trying to get IPart of an IConnector in order to Activate IID_IKsJackDescription and get audio jacks description.

Code:

---

        HRESULT ( STDMETHODCALLTYPE *QueryInterface )(
            IConnector * This,
            /* [in] */ REFIID riid,
            /* [annotation][iid_is][out] */
            _COM_Outptr_  void **ppvObject);

---

The following code should return jack description of the default endpoint device (whatever set for mDefRenderMM)

Code:

---

    Dim mIConnFrom  As IConnector
    Dim mIConnTo    As IConnector
    Dim mIConnToPart As IPart
    Dim mIKsJackDesc As IKsJackDescription
    Dim pKsJackDesc  As KSJACK_DESCRIPTION

    Set mDeviceEnum = New MMDeviceEnumerator
    mDeviceEnum.GetDefaultAudioEndpoint eRender, eMultimedia, mDefRenderMM
    mDefRenderMM.Activate IID_IAudioEndpointVolume, CLSCTX_INPROC_SERVER, CVar(0), pEPVolMM
    mDefRenderMM.Activate IID_IDeviceTopology, CLSCTX_INPROC_SERVER, CVar(0), mDevTopoogy

    If (mDevTopoogy Is Nothing) = False Then
        Call mDevTopoogy.GetConnector(0, mIConnFrom)

        If (mIConnFrom Is Nothing) = False Then
            Call mIConnFrom.GetConnectedTo(mIConnTo)

            If (mIConnTo Is Nothing) = False Then
                mIConnToPart = mIConnTo.QueryInterface(IID_IPart) ' ?????

                Call mIConnToPart.Activate(CLSCTX_INPROC_SERVER, IID_IKsJackDescription, mIKsJackDesc)

                If (mIKsJackDesc Is Nothing) = False Then
                    Call mIKsJackDesc.GetJackDescription(0, pKsJackDesc)
                End If
            End If
        End If
    End If

---

Thank you.

Instead of

mIConnToPart = mIConnTo.QueryInterface(IID_IPart)

you can try this

Set mIConnToPart = mIConnTo

and VB6 will take care of necessary QueryInterface calls.

cheers,
</wqw>

Thanks a lot, it works now :) I wasn't sure how to do it :)

Does anybody have observations of Core Audio Events, like IAudioEndpointVolumeCallback, IMMNotificationClient, IControlChangeNotify ? Are the stable and crash-free? What is the solution for the cross-thread calls? VB doesn't manage them very well. I am thinking to replace current interfaces with OLEEXP but want to make sure it won't crash my app.

Thank you.

For deleting.

IAudioEndpointVolumeCallback has no crash issues. IMMNotificationClient on the other hand, is a complete nightmare that works in a way completely different from every other interface I've ever used. But, it's a solved problem, see this project; the method used there is stable without crashing for both the IDE and compiled apps. Haven't worked with IControlChangeNotify yet.

Thank you for the response.

Unfortunately, IMMNotificationClient is not stable enough - plugging and unplugging headphones a few times causing a crash of compiled EXE.

This report is useless, but...

Code:

---

Faulting application name: Project1.exe, version: 1.0.0.0, time stamp: 0x5e284733
Faulting module name: OLEAUT32.dll, version: 10.0.17763.914, time stamp: 0x4cb0e2f5
Exception code: 0xc0000005
Fault offset: 0x00028259
Faulting process id: 0xbd0
Faulting application start time: 0x01d5d247530c96a5
Faulting application path: d:\Downloads\DevStatus\Project1.exe
Faulting module path: C:\Windows\System32\OLEAUT32.dll
Report Id: 8199b8b2-b4cd-48dd-bf7f-6b31e98d28f0

---

All the events are nightmare...

The IDE crashes randomly - once on the first change, sometimes on exit, sometimes...when it decide. One clever man said - the notifications should not touch VB code at all.

How is the IAudioEndpointVolumeCallback fixed?! It's not crashing.

Hi,

I've read through this and I was wondering if it could be used to check for 'no sound' coming out of the speakers?

For example if there was music playing then could I check every second or so, and if there's no sound for 2 or 3 'polls' then assume that the music has ended and trigger some other code?

If so, what would I need to do please?

Regards
Peter

I believe you could make a few queries to the peak meter... if you continuously got zero that would mean no audio playing (but of course could also mean a stretch of silence in playing audio).

https://docs.microsoft.com/en-us/win...io/peak-meters

Edit: Turns out you can do exactly that. See this new demo:
[VB6, Vista+] Core Audio - Peak Meter

In the timer, you'll see where it sets the audio/no audio label by checking if the peak is zero.

You'll probably want to check a couple times... the demo doesn't wait to change the status but does include the set up to do so:

Code:

---

Private nCount As Long
'Then modify the Timer1_Timer routine:
    If snValue = 0 Then
        Label4.Caption = "No audio."
        nCount = nCount + 1
        If nCount > 5 Then
            'definitely not playing
        End If
    Else
        nCount = 0
        Label4.Caption = "Audio detected"
    End If

---

Hi,

thanks, I found some references to this later yesterday but not that particular page.

Regards
Peter

Just fyi, i used some of this code in a project of mine and it wouldn't compile because my app name combined with IAudioEndpointVolumeCallback hit the 39 character COM name limit (ie applicationname.IAudioEndpointVolumeCallback) I change the class name to IAudioEndpointVolCB to fix it. thanks for creating this amazing code and example.

Testing - downloaded the zip at the very top, a few errors opening the project due to references present that point to missing folders/files.

Path not found: 'E:\vb6\tl_ole\mIID.bas'--Continue Loading Project?
Path not found: 'E:\vb6\tl_ole\mCoreAudio.bas'--Continue Loading Project?
Path not found: 'E:\vb6\tl_ole\mPKEY.bas'--Continue Loading Project?
Could not create reference: 'E:\vb6\tl_ole\oleexp.tlb'.

Downloaded the addons, added them to the project and those reference errors go away. A bit initimidating though thus far.

Subsequently, can't compile - User-defined type not defined - Implements IAudioEndpointVolumeCallback

Added the reference to oleexp.tlb and was successful - but the current oleexp.tlb in syswow64 on my system seems to be a little old, I want to replace it with a later version but no matter what I try I cannot unregister it as it complains about regsvr32 being a 32bit/64 bit version. Tried all of them in syswow64 and system32, nothing works, any clues?

Just overwrite it. I've avoided using registered types at the expense of UDT use in public methods specifically to avoid needing to mess around with unregistering old versions.

Only exception if it's *really* old (more than 9 years from oleexp 3.x or earlier). If that is the case, the readme has instructions.

If you now have duplicates you unregister typelibs with something like RegTLib.

Of course in VB6 that also depends on its own typelib... so the other zip is a twinproj using WDL to avoid typelibs all together :)

Done that, I was making it too complicated, for some reason I still imagined that if it was registered, it was also locked. That mistaken belief has now been repaired.

Sorry for the multiple addon modules but since you can't put actual code in a TLB... and they're supposed to be in a common shared folder for the same reasons as the TLB, to limit proliferation of multiple versions. Then mIID.bas alone already runs up against VB6s limits when placed in larger projects, so everything couldn't be put in one module.

So much easier in tB with WinDevLib... you check one box everything is there, and tB can handle it even as part of a giant project.