нашел с форума код который принимает но сразу сохраняет на харддиск
- Код: Выделить всё
Imports System.ComponentModel
Public Class SoundRecorder
Inherits Component
Sub main()
End Sub
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
Dim lSamples, lRet, lBits, lChannels As Integer
Dim iBlockAlign As Short
Dim lBytesPerSec As Integer
Private _SoundFormat As SoundFormats
Private FName As String = "C:\rrr\temp.wav"
Public Enum SoundFormats
Mono_6kbps_8_Bit
Mono_8kbps_8_Bit
Mono_11kbps_8_Bit
Mono_16kbps_8_Bit
Mono_22kbps_8_Bit
Mono_32kbps_8_Bit
Mono_44kbps_8_Bit
Mono_48kbps_8_Bit
Stereo_24kbps_16_Bit
Stereo_32kbps_16_Bit
Stereo_44kbps_16_Bit
Stereo_64kbps_16_Bit
Stereo_88kbps_16_Bit
Stereo_1288kbps_16_Bit
Stereo_176kbps_16_Bit
Stereo_192kbps_16_Bit
End Enum
Public Property SoundFormat() As SoundFormats
Get
SoundFormat = _SoundFormat
End Get
Set(ByVal Value As SoundFormats)
_SoundFormat = Value
End Set
End Property
Public Property FileName() As String
Get
FileName = FName
End Get
Set(ByVal Value As String)
FName = Value
End Set
End Property
Private Sub GetSoundFormat()
_SoundFormat = SoundFormats.Stereo_88kbps_16_Bit
If _SoundFormat = SoundFormats.Mono_6kbps_8_Bit Then
lSamples = 6000 : lBits = 8 : lChannels = 1
ElseIf _SoundFormat = SoundFormats.Mono_8kbps_8_Bit Then
lSamples = 8000 : lBits = 8 : lChannels = 1
ElseIf _SoundFormat = SoundFormats.Mono_11kbps_8_Bit Then
lSamples = 11025 : lBits = 8 : lChannels = 1
ElseIf _SoundFormat = SoundFormats.Mono_16kbps_8_Bit Then
lSamples = 16000 : lBits = 8 : lChannels = 1
ElseIf _SoundFormat = SoundFormats.Mono_22kbps_8_Bit Then
lSamples = 22050 : lBits = 8 : lChannels = 1
ElseIf _SoundFormat = SoundFormats.Mono_32kbps_8_Bit Then
lSamples = 32000 : lBits = 8 : lChannels = 1
ElseIf _SoundFormat = SoundFormats.Mono_44kbps_8_Bit Then
lSamples = 44100 : lBits = 8 : lChannels = 1
ElseIf _SoundFormat = SoundFormats.Mono_48kbps_8_Bit Then
lSamples = 48000 : lBits = 8 : lChannels = 1
ElseIf _SoundFormat = SoundFormats.Stereo_24kbps_16_Bit Then
lSamples = 6000 : lBits = 16 : lChannels = 2
ElseIf _SoundFormat = SoundFormats.Stereo_32kbps_16_Bit Then
lSamples = 8000 : lBits = 16 : lChannels = 2
ElseIf _SoundFormat = SoundFormats.Stereo_44kbps_16_Bit Then
lSamples = 11025 : lBits = 16 : lChannels = 2
ElseIf _SoundFormat = SoundFormats.Stereo_64kbps_16_Bit Then
lSamples = 16000 : lBits = 16 : lChannels = 2
ElseIf _SoundFormat = SoundFormats.Stereo_88kbps_16_Bit Then
lSamples = 22050 : lBits = 16 : lChannels = 2
ElseIf _SoundFormat = SoundFormats.Stereo_1288kbps_16_Bit Then
lSamples = 32000 : lBits = 16 : lChannels = 2
ElseIf _SoundFormat = SoundFormats.Stereo_176kbps_16_Bit Then
lSamples = 44100 : lBits = 16 : lChannels = 2
ElseIf _SoundFormat = SoundFormats.Stereo_192kbps_16_Bit Then
lSamples = 48000 : lBits = 16 : lChannels = 2
End If
iBlockAlign = lChannels * lBits / 8
lBytesPerSec = lSamples * iBlockAlign
End Sub
Public Function StartRecord() As Boolean
If FName.Length <> 0 Then
Call GetSoundFormat()
Dim i As Integer
' i=mciSendString(
i = mciSendString("open new type waveaudio alias capture", vbNullString, 0, 3)
i = mciSendString("set capture samplespersec " & lSamples & " channels " & lChannels & " bitspersample " & lBits & " alignment " & iBlockAlign & " bytespersec " & lBytesPerSec, vbNullString, 0, 0)
i = mciSendString("record capture", vbNullString, 0, 0)
Return True
Else
MsgBox("Вы не указали имя файла для сохранения!", MsgBoxStyle.Critical, "Внимание!")
Return False
End If
End Function
Public Function StopRecord() As Boolean
Try
Dim i As Integer
i = mciSendString("save capture " & FName, vbNullString, 0, 0)
i = mciSendString("close capture", vbNullString, 0, 0)
Return True
Catch
Return False
End Try
End Function
Public Sub CloseRecord()
Dim i As Integer
i = mciSendString("close capture", vbNullString, 0, 0)
End Sub
End Class
мне надо чтоб биты сохранялись в оперативке.если кто может помочь я буду очень благодарен
