APIのBeep

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

Private Declare PtrSafe Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) 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)
    
    'CLSID_MMDeviceEnumerator
    hr = CoGetObject(StrPtr("new:BCDE0395-E52F-467C-8E3D-C4579291692E"), 0, IID_IMMDeviceEnumerator, IMMDeviceEnumerator)

    'IMMDeviceEnumerator::GetDefaultAudioEndpoint method
    Dim IMMDevice As IUnknown
    hr = CallComMethod(IMMDeviceEnumerator, 4, 0&, 0&, VarPtr(IMMDevice))
    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))
    Set IMMDevice = Nothing

    'IAudioEndpointVolume::GetMute method
    Dim tmp As Long
    hr = CallComMethod(IAudioEndpointVolume, 15, VarPtr(tmp))

    '鳴る
    Call Beep(750, 300)

    'IAudioEndpointVolume::SetMute method
    Dim guid_null As GUID
    'ミュート状態設定
    hr = CallComMethod(IAudioEndpointVolume, 14, 1&, VarPtr(guid_null))

    '鳴らない
    Call Beep(750, 300)

    'IAudioEndpointVolume::SetMute method
    'ミュート状態戻す
    hr = CallComMethod(IAudioEndpointVolume, 14, 0&, VarPtr(guid_null))
    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