How to set microphone recording levels

Hmmm. Isn't it kind of obscene that it requires 260+ lines of code to change the microphone volume? I haven't found any other way of doing it, however.

Force accepting proposed answer.

costello
Community Support Moderator @ Experts-Exchange

Here is the VB.NET code
Option Strict Off
Option Explicit On
Module TEST
      Private Const MMSYSERR_NOERROR As Short = 0
      Private Const MAXPNAMELEN As Short = 32
      Private Const MIXER_LONG_NAME_CHARS As Short = 64
      Private Const MIXER_SHORT_NAME_CHARS As Short = 16
      Private Const MIXER_GETLINEINFOF_COMPONENTTYPE As Integer = &H3
      Private Const MIXER_GETLINEINFOF_SOURCE As Integer = &H1
      Private Const MIXER_GETCONTROLDETAILSF_VALUE As Integer = &H0
      Private Const MIXER_GETLINECONTROLSF_ONEBYTYPE As Integer = &H2
      Private Const MIXERLINE_COMPONENTTYPE_DST_FIRST As Integer = &H0
      Private Const MIXERLINE_COMPONENTTYPE_SRC_FIRST As Integer = &H1000
      Private Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS As Decimal = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)
      Private Const MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE As Decimal = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 3)
      Private Const MIXERLINE_COMPONENTTYPE_SRC_LINE As Decimal = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 2)
      Private Const MIXERCONTROL_CT_CLASS_FADER As Integer = &H50000000
      Private Const MIXERCONTROL_CT_UNITS_UNSIGNED As Integer = &H30000
      Private Const MIXERCONTROL_CONTROLTYPE_FADER As Boolean = (MIXERCONTROL_CT_CLASS_FADER Or MIXERCONTROL_CT_UNITS_UNSIGNED)
      Private Const MIXERCONTROL_CONTROLTYPE_VOLUME As Boolean = (CShort(MIXERCONTROL_CONTROLTYPE_FADER) + 1)
      Private Const MIXERLINE_COMPONENTTYPE_DST_WAVEIN As Decimal = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 7)
      Private Const MIXER_SETCONTROLDETAILSF_VALUE As Integer = &H0
      
      Private Structure MIXERCAPS
            Dim wMid As Short '  manufacturer id
            Dim wPid As Short '  product id
            Dim vDriverVersion As Integer '  version of the driver
            <VBFixedString(MAXPNAMELEN),System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr,SizeConst:=MAXPNAMELEN)> Public szPname As String '  product name
            Dim fdwSupport As Integer '  misc. support bits
            Dim cDestinations As Integer '  count of destinations
      End Structure
      
      Private Structure MIXERCONTROL
            Dim cbStruct As Integer '  size in Byte of MIXERCONTROL
            Dim dwControlID As Integer '  unique control id for mixer device
            Dim dwControlType As Integer '  MIXERCONTROL_CONTROLTYPE_xxx
            Dim fdwControl As Integer '  MIXERCONTROL_CONTROLF_xxx
            Dim cMultipleItems As Integer '  if MIXERCONTROL_CONTROLF_MULTIPLE set
            <VBFixedString(MIXER_SHORT_NAME_CHARS),System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr,SizeConst:=MIXER_SHORT_NAME_CHARS)> Public szShortName As String ' short name of control
            <VBFixedString(MIXER_LONG_NAME_CHARS),System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr,SizeConst:=MIXER_LONG_NAME_CHARS)> Public szName As String ' long name of control
            Dim lMinimum As Integer '  Minimum value
            Dim lMaximum As Integer '  Maximum value
            <VBFixedArray(10)> Dim reserved() As Integer '  reserved structure space
            
            'UPGRADE_TODO: "Initialize" must be called to initialize instances of this structure. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1026"'
            Public Sub Initialize()
                  ReDim reserved(10)
            End Sub
      End Structure
      
      Private Structure MIXERCONTROLDETAILS
            Dim cbStruct As Integer '  size in Byte of MIXERCONTROLDETAILS
            Dim dwControlID As Integer '  control id to get/set details on
            Dim cChannels As Integer '  number of channels in paDetails array
            Dim item As Integer '  hwndOwner or cMultipleItems
            Dim cbDetails As Integer '  size of _one_ details_XX struct
            Dim paDetails As Integer '  pointer to array of details_XX structs
      End Structure
      
      Private Structure MIXERCONTROLDETAILS_UNSIGNED
            Dim dwValue As Integer '  value of the control
      End Structure
      
      Private Structure MIXERLINE
            Dim cbStruct As Integer '  size of MIXERLINE structure
            Dim dwDestination As Integer '  zero based destination index
            Dim dwSource As Integer '  zero based source index (if source)
            Dim dwLineID As Integer '  unique line id for mixer device
            Dim fdwLine As Integer '  state/information about line
            Dim dwUser As Integer '  driver specific information
            Dim dwComponentType As Integer '  component type line connects to
            Dim cChannels As Integer '  number of channels line supports
            Dim cConnections As Integer '  number of connections (possible)
            Dim cControls As Integer '  number of controls at this line
            <VBFixedString(MIXER_SHORT_NAME_CHARS),System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr,SizeConst:=MIXER_SHORT_NAME_CHARS)> Public szShortName As String
            <VBFixedString(MIXER_LONG_NAME_CHARS),System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr,SizeConst:=MIXER_LONG_NAME_CHARS)> Public szName As String
            Dim dwType As Integer
            Dim dwDeviceID As Integer
            Dim wMid As Short
            Dim wPid As Short
            Dim vDriverVersion As Integer
            <VBFixedString(MAXPNAMELEN),System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr,SizeConst:=MAXPNAMELEN)> Public szPname As String
      End Structure
      
      Private Structure MIXERLINECONTROLS
            Dim cbStruct As Integer '  size in Byte of MIXERLINECONTROLS
            Dim dwLineID As Integer '  line id (from MIXERLINE.dwLineID)
            '  MIXER_GETLINECONTROLSF_ONEBYID or
            Dim dwControl As Integer '  MIXER_GETLINECONTROLSF_ONEBYTYPE
            Dim cControls As Integer '  count of controls pmxctrl points to
            Dim cbmxctrl As Integer '  size in Byte of _one_ MIXERCONTROL
            Dim pamxctrl As Integer '  pointer to first MIXERCONTROL array
      End Structure
      
      Private Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Integer) As Integer
      'UPGRADE_WARNING: Structure MIXERCONTROLDETAILS may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"'
      Private Declare Function mixerGetControlDetails Lib "winmm.dll"  Alias "mixerGetControlDetailsA"(ByVal hmxobj As Integer, ByRef pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Integer) As Integer
      'UPGRADE_WARNING: Structure MIXERCAPS may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"'
      Private Declare Function mixerGetDevCaps Lib "winmm.dll"  Alias "mixerGetDevCapsA"(ByVal uMxId As Integer, ByVal pmxcaps As MIXERCAPS, ByVal cbmxcaps As Integer) As Integer
      Private Declare Function mixerGetID Lib "winmm.dll" (ByVal hmxobj As Integer, ByRef pumxID As Integer, ByVal fdwId As Integer) As Integer
      'UPGRADE_WARNING: Structure MIXERLINECONTROLS may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"'
      Private Declare Function mixerGetLineControls Lib "winmm.dll"  Alias "mixerGetLineControlsA"(ByVal hmxobj As Integer, ByRef pmxlc As MIXERLINECONTROLS, ByVal fdwControls As Integer) As Integer
      'UPGRADE_WARNING: Structure MIXERLINE may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"'
      Private Declare Function mixerGetLineInfo Lib "winmm.dll"  Alias "mixerGetLineInfoA"(ByVal hmxobj As Integer, ByRef pmxl As MIXERLINE, ByVal fdwInfo As Integer) As Integer
      Private Declare Function mixerGetNumDevs Lib "winmm.dll" () As Integer
      Private Declare Function mixerMessage Lib "winmm.dll" (ByVal hmx As Integer, ByVal uMsg As Integer, ByVal dwParam1 As Integer, ByVal dwParam2 As Integer) As Integer
      Private Declare Function mixerOpen Lib "winmm.dll" (ByRef phmx As Integer, ByVal uMxId As Integer, ByVal dwCallback As Integer, ByVal dwInstance As Integer, ByVal fdwOpen As Integer) As Integer
      'UPGRADE_WARNING: Structure MIXERCONTROLDETAILS may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"'
      Private Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj As Integer, ByRef pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Integer) As Integer
      'UPGRADE_ISSUE: Declaring a parameter 'As Any' is not supported. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1016"'
      Private Declare Sub CopyStructFromPtr Lib "kernel32"  Alias "RtlMoveMemory"(ByRef struct As Any, ByVal ptr As Integer, ByVal cb As Integer)
      'UPGRADE_ISSUE: Declaring a parameter 'As Any' is not supported. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1016"'
      Private Declare Sub CopyPtrFromStruct Lib "kernel32"  Alias "RtlMoveMemory"(ByVal ptr As Integer, ByRef struct As Any, ByVal cb As Integer)
      Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Integer, ByVal dwBytes As Integer) As Integer
      Private Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Integer) As Integer
      Private Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Integer) As Integer
      
      Private lMixerHnd As Integer
      'UPGRADE_WARNING: Arrays in structure tMIC may need to be initialized before they can be used. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1063"'
      Private tMIC As MIXERCONTROL
      Private bHasMic As Boolean
      
      Private Function GetMixer() As Boolean
            Dim lReturn As Object
            ' Get a Handle to the Mixer
            ' If we've already got one, return
            If lMixerHnd Then
                  GetMixer = True
                  Exit Function
            End If
            ' Get a new handle to the Mizer
            'UPGRADE_WARNING: Couldn't resolve default property of object lReturn. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
            lReturn = mixerOpen(lMixerHnd, 0, 0, 0, 0)
            'UPGRADE_WARNING: Couldn't resolve default property of object lReturn. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
            If lReturn = MMSYSERR_NOERROR Then
                  GetMixer = True
            Else
                  ' Problems opening the Mixer
                  MsgBox("Unable to open mixer.")
            End If
      End Function
      
      Public Function GetMicrophoneRecordVolume() As Integer
            ' Retreives the current volume of the Microphone control (Recording)
            Dim lResult, lMemHnd As Integer
            Dim tMIXERCONTROLDETAILS As MIXERCONTROLDETAILS
            Dim tVOLUME As MIXERCONTROLDETAILS_UNSIGNED
            
            ' If we haven't gotten the Microphone Control yet, do so.
            If Not bHasMic Then bHasMic = GetMicControl()
            If Not bHasMic Then
                  ' Unable to get the Microphone
                  MsgBox("Unable to open Microphone Control")
                  Exit Function
            End If
            
            ' Prep a MICERCONTROLDETAILS structure for retreiving info. about a specific control
            tMIXERCONTROLDETAILS.item = 0
            tMIXERCONTROLDETAILS.dwControlID = tMIC.dwControlID
            tMIXERCONTROLDETAILS.cbStruct = Len(tMIXERCONTROLDETAILS)
            tMIXERCONTROLDETAILS.cbDetails = Len(tVOLUME)
            
            ' Allocate a buffer for the control's value
            lMemHnd = GlobalAlloc(&H40s, Len(tVOLUME))
            tMIXERCONTROLDETAILS.paDetails = GlobalLock(lMemHnd)
            tMIXERCONTROLDETAILS.cChannels = 1
            
            ' Get the controls details
            Call mixerGetControlDetails(lMixerHnd, tMIXERCONTROLDETAILS, MIXER_GETCONTROLDETAILSF_VALUE)
            
            ' Copy the data into the control's VOLUME struct
            'UPGRADE_WARNING: Couldn't resolve default property of object tVOLUME. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
            CopyStructFromPtr(tVOLUME, tMIXERCONTROLDETAILS.paDetails, Len(tVOLUME))
            
            ' Release the memory buffer
            Call GlobalFree(lMemHnd)
            
            ' Return the current value
            GetMicrophoneRecordVolume = tVOLUME.dwValue
      End Function
      
      Public Sub SetMicrophoneRecordVolume(ByVal lVolume As Integer)
            ' Set the Microphone volume used for recording
            Dim lResult, lMemHnd As Integer
            Dim tMIXERCONTROLDETAILS As MIXERCONTROLDETAILS
            Dim tVOLUME As MIXERCONTROLDETAILS_UNSIGNED
            
            ' If we haven't got the Microphone yet, do so..
            If Not bHasMic Then bHasMic = GetMicControl()
            If Not bHasMic Then
                  MsgBox("Unable to open Microphone Control")
                  Exit Sub
            End If
            
            ' Prep the MIXERCONTROLDETAILS struct to set info. about this control
            tMIXERCONTROLDETAILS.item = 0
            tMIXERCONTROLDETAILS.dwControlID = tMIC.dwControlID
            tMIXERCONTROLDETAILS.cbStruct = Len(tMIXERCONTROLDETAILS)
            tMIXERCONTROLDETAILS.cbDetails = Len(tVOLUME)
            
            ' Allocate a buffer for the control's volume value
            lMemHnd = GlobalAlloc(&H40s, Len(tVOLUME))
            tMIXERCONTROLDETAILS.paDetails = GlobalLock(lMemHnd)
            tMIXERCONTROLDETAILS.cChannels = 1
            tVOLUME.dwValue = lVolume
            
            ' Copy the data from the VOLUME struct into the memory buffer
            'UPGRADE_WARNING: Couldn't resolve default property of object tVOLUME. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
            CopyPtrFromStruct(tMIXERCONTROLDETAILS.paDetails, tVOLUME, Len(tVOLUME))
            
            ' Set the new volume
            Call mixerSetControlDetails(lMixerHnd, tMIXERCONTROLDETAILS, MIXER_SETCONTROLDETAILSF_VALUE)
            
            ' Release the memory buffer
            Call GlobalFree(lMemHnd)
      End Sub
      
      Private Function GetMicControl() As Boolean
            ' Get the Microphone Control (from the Recording Line)
            Dim tMIXERLINECONTROLS As MIXERLINECONTROLS
            Dim tMIXERLINE As MIXERLINE
            Dim lMemHnd As Integer
            Dim lReturn As Integer
            Dim lConnections As Integer
            Dim lIndex As Integer
            
            ' Get a handle to the Mixer
            If Not GetMixer() Then Exit Function
            
            ' First find the WAVEIN Line
            tMIXERLINE.cbStruct = Len(tMIXERLINE)
            tMIXERLINE.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_WAVEIN
            
            lReturn = mixerGetLineInfo(lMixerHnd, tMIXERLINE, MIXER_GETLINEINFOF_COMPONENTTYPE)
            
            If lReturn <> MMSYSERR_NOERROR Then Exit Function
            
            ' Next enumerate the connections for this line, checking for the Microphone
            lConnections = tMIXERLINE.cConnections - 1
            
            For lIndex = 0 To lConnections
                  tMIXERLINE.dwSource = lIndex
                  Call mixerGetLineInfo(lMixerHnd, tMIXERLINE, MIXER_GETLINEINFOF_SOURCE)
                  If tMIXERLINE.dwComponentType = MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE Then
                        Exit For
                  End If
            Next
            
            ' If no microphone was found, exit
            If lIndex > lConnections Then Exit Function
            
            ' Extract the control for the Microphone from the line
            tMIXERLINECONTROLS.cbStruct = Len(tMIXERLINECONTROLS)
            tMIXERLINECONTROLS.dwLineID = tMIXERLINE.dwLineID
            tMIXERLINECONTROLS.dwControl = MIXERCONTROL_CONTROLTYPE_VOLUME
            tMIXERLINECONTROLS.cControls = 1
            tMIXERLINECONTROLS.cbmxctrl = Len(tMIC)
            
            ' Create a buffer for the Microphone
            lMemHnd = GlobalAlloc(&H40s, Len(tMIC))
            tMIXERLINECONTROLS.pamxctrl = GlobalLock(lMemHnd)
            tMIC.cbStruct = Len(tMIC)
            
            ' Get the Microphone
            lReturn = mixerGetLineControls(lMixerHnd, tMIXERLINECONTROLS, MIXER_GETLINECONTROLSF_ONEBYTYPE)
            
            If (MMSYSERR_NOERROR = lReturn) Then
                  GetMicControl = True
                  ' Copy the Microphone control into the tMIC structure
                  'UPGRADE_WARNING: Couldn't resolve default property of object tMIC. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
                  CopyStructFromPtr(tMIC, tMIXERLINECONTROLS.pamxctrl, Len(tMIC))
            End If
            
            ' Release the buffer
            Call GlobalFree(lMemHnd)
      End Function
End Module
Hope this is useful