ミュート設定2

Module3.bas

Option Explicit


Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Declare PtrSafe _
Function IIDFromString Lib "ole32.dll" ( _
    ByVal lpsz As LongPtr, _
    ByRef lpiid As GUID _
) As Long

Private Declare PtrSafe _
Function DispCallFunc Lib "OleAut32.dll" ( _
    ByVal pvInstance As LongPtr, _
    ByVal oVft As LongPtr, _
    ByVal cc_ As Long, _
    ByVal vtReturn As Integer, _
    ByVal cActuals As Long, _
    ByRef prgvt As Integer, _
    ByRef prgpvarg As LongPtr, _
    ByRef pvargResult As Variant _
    ) As Long
Const CC_STDCALL = 4&

Private Declare PtrSafe _
Function CoGetObject Lib "Ole32" ( _
        ByVal pszName As LongPtr, _
        ByVal pBindOptions As LongPtr, _
        ByRef riid As GUID, _
        ByRef ppv As Any) As Long

Private Declare PtrSafe _
Function CoCreateInstance Lib "Ole32" ( _
        ByRef rclsid As GUID, _
        ByVal pUnkOuter As LongPtr, _
        ByVal dwClsContext As Long, _
        ByRef riid As GUID, _
        ByRef ppv As Any) As Long

Sub hoge()

    Dim hr&
    Dim IMMDeviceEnumerator As IUnknown
    Const str_IID_IMMDeviceEnumerator = "{A95664D2-9614-4F35-A746-DE8DB63617E6}"
    Dim IID_IMMDeviceEnumerator As GUID

    hr = IIDFromString(StrPtr(str_IID_IMMDeviceEnumerator), IID_IMMDeviceEnumerator)
    Debug.Print Hex$(hr)
    
    'CLSID_MMDeviceEnumerator
    hr = CoGetObject(StrPtr("new:BCDE0395-E52F-467C-8E3D-C4579291692E"), 0, IID_IMMDeviceEnumerator, IMMDeviceEnumerator)
    Debug.Print Hex$(hr)


    'IMMDeviceEnumerator::GetDefaultAudioEndpoint method
    Dim IMMDevice As IUnknown
    hr = CallComMethod(IMMDeviceEnumerator, 4, 0&, 0&, VarPtr(IMMDevice))
    Debug.Print Hex$(hr)
    Debug.Print IMMDevice Is Nothing

    Set IMMDeviceEnumerator = Nothing

    'IMMDevice::Activate method
    Dim IID_IAudioEndpointVolume As GUID
    Const str_IID_IAudioEndpointVolume = "{5CDF2C82-841E-4546-9722-0CF74078229A}"
    hr = IIDFromString(StrPtr(str_IID_IAudioEndpointVolume), IID_IAudioEndpointVolume)

    Dim IAudioEndpointVolume As IUnknown
    hr = CallComMethod(IMMDevice, 3, VarPtr(IID_IAudioEndpointVolume), 17&, 0&, VarPtr(IAudioEndpointVolume))
    Debug.Print Hex$(hr)
    Debug.Print IAudioEndpointVolume Is Nothing

    Set IMMDevice = Nothing

    'IAudioEndpointVolume::GetMute method
    Dim tmp As Long
    hr = CallComMethod(IAudioEndpointVolume, 15, VarPtr(tmp))
    Debug.Print Hex$(hr)
    Debug.Print tmp
    'Set IAudioEndpointVolume = Nothing

    'IAudioEndpointVolume::SetMute method
    Dim guid_null As GUID
    hr = CallComMethod(IAudioEndpointVolume, 14, 1&, VarPtr(guid_null))
    Debug.Print Hex$(hr)
    Debug.Print IAudioEndpointVolume Is Nothing

    Set IAudioEndpointVolume = Nothing

End Sub

Private Function CallComMethod(unk As IUnknown, _
ByVal VTBLIndex As Long, ParamArray Args() As Variant) As Long

    Dim pArgs() As Long
    Dim vt() As Integer
    Dim vntResult As Variant
    Dim lngCount As Long
    Dim hr As Long
    Dim i As Long

    If unk Is Nothing Then Err.Raise 91
    lngCount = UBound(Args) + 1
    ReDim pArgs(0 To lngCount + (lngCount > 0))
    ReDim vt(0 To UBound(pArgs))
    For i = 0 To lngCount - 1
        vt(i) = VarType(Args(i))
        pArgs(i) = VarPtr(Args(i))
    Next
    hr = DispCallFunc(ObjPtr(unk), VTBLIndex * 4, _
                        CC_STDCALL, vbLong, _
                        lngCount, vt(0), pArgs(0), vntResult)
    If hr < 0 Then Err.Raise hr
    CallComMethod = vntResult

End Function