ミュート設定

Module1.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)
    
    Dim IMMDevice As IUnknown
    
    Dim Vnt
    ReDim Vnt(0 To 2)
    Vnt(0) = 0&
    Vnt(1) = 0&
    Vnt(2) = VarPtr(IMMDevice)

    Dim pArgs&()
    ReDim pArgs(0 To 2)
    Dim i As Long
    
    Dim vt() As Integer
    ReDim vt(0 To 2)
    For i = 0 To 2
        pArgs(i) = VarPtr(Vnt(i))
        vt(i) = VarType(Vnt(i))
    Next

    Dim VTBLIndex As Long
    VTBLIndex = 4
#If Win64 Then
    VTBLIndex = VTBLIndex * 8
#Else
    VTBLIndex = VTBLIndex * 4
#End If

    Dim vntResult As Variant
    'IMMDeviceEnumerator::GetDefaultAudioEndpoint method
    hr = DispCallFunc(ObjPtr(IMMDeviceEnumerator), VTBLIndex, _
                        CC_STDCALL, vbLong, _
                        3, vt(0), pArgs(0), vntResult)
    Debug.Print Hex$(hr), Hex$(vntResult)
    Debug.Print IMMDevice Is Nothing

    Set IMMDeviceEnumerator = Nothing


    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

    Erase Vnt, pArgs, vt
    ReDim Vnt(0 To 3)
    Vnt(0) = VarPtr(IID_IAudioEndpointVolume)
    Vnt(1) = 17&
    Vnt(2) = 0&
    Vnt(3) = VarPtr(IAudioEndpointVolume)

    ReDim pArgs(0 To 3)
    ReDim vt(0 To 3)
    For i = 0 To 3
        pArgs(i) = VarPtr(Vnt(i))
        vt(i) = VarType(Vnt(i))
    Next

    VTBLIndex = 3
#If Win64 Then
    VTBLIndex = VTBLIndex * 8
#Else
    VTBLIndex = VTBLIndex * 4
#End If

    'IMMDevice::Activate method
    hr = DispCallFunc(ObjPtr(IMMDevice), VTBLIndex, _
                        CC_STDCALL, vbLong, _
                        4, vt(0), pArgs(0), vntResult)
    Debug.Print Hex$(hr), Hex$(vntResult)
    Debug.Print IAudioEndpointVolume Is Nothing

    Set IMMDevice = Nothing
    
    
    
    Erase Vnt, pArgs, vt
    Dim tmp As Long
    ReDim Vnt(0)
    Vnt(0) = VarPtr(tmp)

    ReDim pArgs(0)
    ReDim vt(0)
    pArgs(0) = VarPtr(Vnt(0))
    vt(0) = VarType(Vnt(0))

    VTBLIndex = 15
#If Win64 Then
    VTBLIndex = VTBLIndex * 8
#Else
    VTBLIndex = VTBLIndex * 4
#End If

    'IAudioEndpointVolume::GetMute method
    hr = DispCallFunc(ObjPtr(IAudioEndpointVolume), VTBLIndex, _
                        CC_STDCALL, vbLong, _
                        1, vt(0), pArgs(0), vntResult)
    Debug.Print Hex$(hr), Hex$(vntResult)
    Debug.Print tmp
    'Set IAudioEndpointVolume = Nothing


    Erase Vnt, pArgs, vt
    ReDim Vnt(0 To 1)
    Dim guid_null As GUID
    Vnt(0) = 1&
    Vnt(1) = VarPtr(guid_null)


    ReDim pArgs(0 To 1)
    ReDim vt(0 To 1)
    For i = 0 To 1
        pArgs(i) = VarPtr(Vnt(i))
        vt(i) = VarType(Vnt(i))
    Next

    VTBLIndex = 14
#If Win64 Then
    VTBLIndex = VTBLIndex * 8
#Else
    VTBLIndex = VTBLIndex * 4
#End If

    'IAudioEndpointVolume::SetMute method
    hr = DispCallFunc(ObjPtr(IAudioEndpointVolume), VTBLIndex, _
                        CC_STDCALL, vbLong, _
                        2, vt(0), pArgs(0), vntResult)
    Debug.Print Hex$(hr), Hex$(vntResult)
    Debug.Print IAudioEndpointVolume Is Nothing

    Set IAudioEndpointVolume = Nothing

End Sub