Respuesta: microfono vb.net encontre esto pero solo graba
Private Type MIXERLINECONTROLS
cbStruct As Long ' size in Byte of MIXERLINECONTROLS
dwLineID As Long ' line id (from MIXERLINE.dwLineID)
' MIXER_GETLINECONTROLSF_ONEBYID or
dwControl As Long ' MIXER_GETLINECONTROLSF_ONEBYTYPE
cControls As Long ' count of controls pmxctrl points to
cbmxctrl As Long ' size in Byte of _one_ MIXERCONTROL
pamxctrl As Long ' pointer to first MIXERCONTROL array
End Type
Private Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Long) As Long
Private Declare Function mixerGetControlDetails Lib "winmm.dll" Alias "mixerGetControlDetailsA" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Private Declare Function mixerGetDevCaps Lib "winmm.dll" Alias "mixerGetDevCapsA" (ByVal uMxId As Long, ByVal pmxcaps As MIXERCAPS, ByVal cbmxcaps As Long) As Long
Private Declare Function mixerGetID Lib "winmm.dll" (ByVal hmxobj As Long, pumxID As Long, ByVal fdwId As Long) As Long
Private Declare Function mixerGetLineControls Lib "winmm.dll" Alias "mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As MIXERLINECONTROLS, ByVal fdwControls As Long) As Long
Private Declare Function mixerGetLineInfo Lib "winmm.dll" Alias "mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long
Private Declare Function mixerGetNumDevs Lib "winmm.dll" () As Long
Private Declare Function mixerMessage Lib "winmm.dll" (ByVal hmx As Long, ByVal uMsg As Long, ByVal dwParam1 As Long, ByVal dwParam2 As Long) As Long
Private Declare Function mixerOpen Lib "winmm.dll" (phmx As Long, ByVal uMxId As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal fdwOpen As Long) As Long
Private Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Private Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)
Private Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" (ByVal ptr As Long, struct As Any, ByVal cb As Long)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long
Private lMixerHnd As Long
Private tMIC As MIXERCONTROL
Private bHasMic As Boolean
Private Function GetMixer() As Boolean
' 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
lReturn = mixerOpen(lMixerHnd, 0, 0, 0, 0)
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 Long
' Retreives the current volume of the Microphone control (Recording)
Dim lResult As Long, lMemHnd As Long
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(&H40, 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
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 Long)
' Set the Microphone volume used for recording
Dim lResult As Long, lMemHnd As Long
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(&H40, Len(tVOLUME))
tMIXERCONTROLDETAILS.paDetails = GlobalLock(lMemHnd)
tMIXERCONTROLDETAILS.cChannels = 1
tVOLUME.dwValue = lVolume
' Copy the data from the VOLUME struct into the memory buffer
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 Long
Dim lReturn As Long
Dim lConnections As Long
Dim lIndex As Long
' 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(&H40, 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
CopyStructFromPtr tMIC, tMIXERLINECONTROLS.pamxctrl, Len(tMIC)
End If
' Release the buffer
Call GlobalFree(lMemHnd)
End Function |