Results 1 to 34 of 34

Thread: [VB6, Vista+] Core Audio Basics

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    [VB6, Vista+] Core Audio Basics


    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
    Attached Files Attached Files
    Last edited by fafalone; Nov 24th, 2016 at 04:23 PM. Reason: Attached project updated to reference oleexp.tlb 4.0 or higher

  2. #2
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: [VB6, Vista+] Core Audio Basics

    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);
    Last edited by DEXWERX; May 20th, 2016 at 04:40 PM.

  3. #3

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6, Vista+] Core Audio Basics

    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.
    Last edited by fafalone; May 22nd, 2016 at 01:36 PM.

  4. #4
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,094

    Re: [VB6, Vista+] Core Audio Basics

    Quote Originally Posted by fafalone View Post
    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>

  5. #5

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6, Vista+] Core Audio Basics

    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)
    Last edited by fafalone; May 23rd, 2016 at 08:24 PM.

  6. #6

  7. #7
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,094

    Re: [VB6, Vista+] Core Audio Basics

    Quote Originally Posted by fafalone View Post
    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>

  8. #8

  9. #9

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6, Vista+] Core Audio Basics

    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

  10. #10
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6, Vista+] Core Audio Basics

    Quote Originally Posted by fafalone View Post
    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
    --------------------
    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
    --------------------
    0
    4
    8
    12
    20
    24
    --------------------
    Quote Originally Posted by fafalone View Post
    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.

  11. #11

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6, Vista+] Core Audio Basics

    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..
    Last edited by fafalone; May 24th, 2016 at 03:39 PM.

  12. #12
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6, Vista+] Core Audio Basics

    Quote Originally Posted by fafalone View Post
    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:
    Name:  ??????????.jpg
Views: 3342
Size:  33.5 KB
    In Native compile:
    Name:  ??????????2.jpg
Views: 3156
Size:  31.4 KB
    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?

  13. #13

  14. #14

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6, Vista+] Core Audio Basics

    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...

  15. #15
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: [VB6, Vista+] Core Audio Basics

    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)

  16. #16

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6, Vista+] Core Audio Basics

    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)
    Last edited by fafalone; May 25th, 2016 at 05:07 PM.

  17. #17

  18. #18
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6, Vista+] Core Audio Basics

    Quote Originally Posted by DEXWERX View Post
    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.
    Name:  ??????????.jpg
Views: 3344
Size:  82.8 KB
    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.
    Attached Files Attached Files

  19. #19

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6, Vista+] Core Audio Basics

    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.
    Last edited by fafalone; May 26th, 2016 at 02:41 AM.

  20. #20
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6, Vista+] Core Audio Basics

    Quote Originally Posted by fafalone View Post
    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 View Post
    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 View Post
    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.

  21. #21
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: [VB6, Vista+] Core Audio Basics

    Quote Originally Posted by The trick View Post
    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.

  22. #22

  23. #23
    Member
    Join Date
    Apr 2009
    Posts
    48

    Re: [VB6, Vista+] Core Audio Basics

    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

  24. #24

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6, Vista+] Core Audio Basics

    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:


    Just add mCoreAudio.bas and mIID.bas from the oleexp zip.
    Attached Files Attached Files
    Last edited by fafalone; Jan 15th, 2020 at 02:57 PM.

  25. #25
    Member
    Join Date
    Apr 2019
    Posts
    51

    Re: [VB6, Vista+] Core Audio Basics

    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.
    Last edited by npac4o; Jan 23rd, 2020 at 05:37 AM.

  26. #26
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,094

    Re: [VB6, Vista+] Core Audio Basics

    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>

  27. #27
    Member
    Join Date
    Apr 2019
    Posts
    51

    Re: [VB6, Vista+] Core Audio Basics

    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.
    Last edited by npac4o; Jan 23rd, 2020 at 05:55 AM.

  28. #28
    Member
    Join Date
    Apr 2019
    Posts
    51

    Re: [VB6, Vista+] Core Audio Basics

    For deleting.
    Last edited by npac4o; Jan 23rd, 2020 at 05:56 AM. Reason: duplicate

  29. #29

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6, Vista+] Core Audio Basics

    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.

  30. #30
    Member
    Join Date
    Apr 2019
    Posts
    51

    Re: [VB6, Vista+] Core Audio Basics

    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.
    Last edited by npac4o; Jan 23rd, 2020 at 07:18 PM.

  31. #31
    New Member
    Join Date
    Apr 2021
    Posts
    11

    Re: [VB6, Vista+] Core Audio Basics

    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

  32. #32

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6, Vista+] Core Audio Basics

    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
    Last edited by fafalone; Apr 28th, 2021 at 07:27 PM.

  33. #33
    New Member
    Join Date
    Apr 2021
    Posts
    11

    Re: [VB6, Vista+] Core Audio Basics

    Hi,

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

    Regards
    Peter

  34. #34
    Lively Member vbLewis's Avatar
    Join Date
    Feb 2009
    Location
    USA
    Posts
    126

    Re: [VB6, Vista+] Core Audio Basics

    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.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width