Звукозапись с микрофона в VB

file_ = cur_dir & ' ' & num_ & '.wav'
num_ = num_ + 1
Open file_ For Binary As #1
For i = 0 To 2057
DoEvents
Put #1, i + 1, Etalon_2(i)
Next
Close #1
MMControl1.Notify = False
MMControl1.Wait = True
MMControl1.Shareable = False
MMControl1.DeviceType = 'waveaudio'
MMControl1.FileName = file_
MMControl1.Command = 'Open'
MMControl1.TimeFormat = 0
MMControl1.RecordMode = mciRecordOverwrite
MMControl1.Notify = True
MMControl1.Wait = False
MMControl1.From = 0
Form1.BackColor = RGB(245, 23, 12)
MMControl1.Command = 'Record'
start_ = Timer
Do While Timer < start_ + 2
DoEvents
Loop
Shape1.BackStyle = 0
MMControl1.Command = 'Stop'
Form1.BackColor = &H8000000F
MMControl1.Notify = False
MMControl1.Wait = True
MMControl1.Command = 'Save'
MMControl1.Command = 'Close'

Private Declare Function mciSendString Lib 'winmm.dll' Alias _
'mciSendStringA' (ByVal lpstrCommand As String, ByVal lpstrReturnString As
String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
 
Private Sub cmdPlay_Click()
Dim L As Long, Res As String, cb As Long
On Error Resume Next
Res = Space$(128)
L = mciSendString('open new type waveaudio alias sound', Res, 128, cb)
L = mciSendString('set sound time format ms format tag pcm channels 1
samplespersec 22050 bytespersec 44100 alignment 2
bitspersample 16', Res, 128, cb)
L = mciSendString('record sound', Res, 128, cb)
End Sub
 
Private Sub cmdStop_Click()
Dim L As Long, Res As String, cb As Long
On Error Resume Next
Res = Space$(128)
L = mciSendString('stop sound', Res, 128, cb)
L = mciSendString('close sound', Res, 128, cb)
End Sub

Private lngStart As Long
Private Declare Function timeGetTime Lib 'winmm.dll' () As Long
Public Sub StartTimer()
lngStart = timeGetTime
End Sub
Public Function StopTimer() As Long
StopTimer = (timeGetTime - lngStart)
End Function
 
Private Sub Command1_Click()
Print Time
StartTimer
Do While StopTimer < 1000
DoEvents
Loop
Print Time
Debug.Print StopTimer
End Sub

Private Declare Function mciSendString Lib 'winmm.dll' _
Alias 'mciSendStringA' _
(ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
'выезжает
Private Sub Command1_Click()
Call mciSendString('Set CDAudio Door Open Wait', 0&, 0&, 0&)
End Sub
'заезжает
Private Sub Command2_Click()
Call mciSendString('Set CDAudio Door Closed Wait', 0&, 0&, 0&)
End Sub

Declare Function waveOutGetNumDevs Lib 'winmm.dll' () As Long
 
Private Sub Check_Click()
 
Dim rtn As Integer 'declare the needed variables
 
rtn = waveOutGetNumDevs() 'check for a sound card
 
If rtn = 1 Then 'Когда больше, чем 1- карта работает :-)
MsgBox 'Your system supports a sound card.'
Else 'А иначе карты нету :-(
MsgBox 'Your system cannot play Sound Files.'
End If
 
End Sub