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
Last edited by fafalone; Nov 24th, 2016 at 04:23 PM.
Reason: Attached project updated to reference oleexp.tlb 4.0 or higher
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.
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
------------------------------
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.
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.
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.
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.
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
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
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
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..
Last edited by fafalone; May 24th, 2016 at 03:39 PM.
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:
In Native compile:
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?
Last edited by The trick; May 24th, 2016 at 03:54 PM.
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.
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)
Last edited by fafalone; May 25th, 2016 at 05:07 PM.
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.
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.
Last edited by fafalone; May 26th, 2016 at 02:41 AM.
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.
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.
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.
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.
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.
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.
Last edited by fafalone; Jan 15th, 2020 at 02:57 PM.
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.
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.
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.
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.
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.
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?
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).
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.
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.