Платные хостинги     Раскрутка сайта     Книги по программированию

запись звука с источника в RAM, как записать без DirectX

- Как без использования DirectX записать звук используя MMControl 6 c микрофонного входа или с линейного, если кто знает, если нельзя, то буду использовать DirectX.Кто-нибудь знает по WIn-API MMControl ссылочку?

- Код Option ExplicitImplements DirectXEvent8'Сам DirectX8Private objDX8 As DirectX8'Объект для захвата звукаPrivate objDSCapture As DirectSoundCapture8'Буфер, куда пудет записываться звукPrivate objDSCaptureBuffer As DirectSoundCaptureBuffer8'Дескриптор для создания буфераPrivate CaptureDesc As DSCBUFFERDESC'Это для обработки событий буфера'   последняя позиция, на которой произошло событиеPrivate lastPos As Long'   сколько всего байтов записалиPrivate BytesWritten As Long'   идентификатор события остановкиPrivate EventStop As Long'   идентификатор собый, возникающих во время записиPrivate EventNotify As Long'возможности захватывающего устройстваPrivate CaptureCaps As DSCCAPS'Эти три типа нужны для записи в WAV-файл'   заголовок файлаPrivate Type FileHeader  lRiff As Long  lFileSize As Long  lWave As Long  lFormat As Long  lFormatLength As LongEnd Type'   формат WAVPrivate Type WaveFormat  wFormatTag As Integer  nChannels As Integer  nSamplesPerSec As Long  nAvgBytesPerSec As Long  nBlockAlign As Integer  wBitsPerSample As IntegerEnd TypePrivate Type ChunkHeader  lType As Long  lLen As LongEnd TypeDim fh As FileHeaderDim wf As WaveFormatDim ch As ChunkHeaderPrivate Sub cmdCreateBuffer_Click()    'Здесь создадим и проинициализируем буфер        'Будет 3 уведомления    Dim tmp(0 To 2)  As DSBPOSITIONNOTIFY        'первые два - по ходу записи    With tmp(0)        .lOffset = 10000        .hEventNotify = EventNotify    End With    With tmp(1)        .lOffset = 30000        .hEventNotify = EventNotify    End With    'а это по завершении    With tmp(2)        .lOffset = DSBPN_OFFSETSTOP        .hEventNotify = EventStop    End With        'укажем формат захвата звука    With CaptureDesc.fxFormat        .nFormatTag = WAVE_FORMAT_PCM        .nChannels = 2        .lSamplesPerSec = 22050        .nBitsPerSample = 16        .nBlockAlign = .nBitsPerSample / 8 * .nChannels        .lAvgBytesPerSec = .lSamplesPerSec * .nBlockAlign        .nSize = 0    End With        CaptureDesc.lFlags = DSCBCAPS_DEFAULT    'Размер буфера. В данном случае 5 секунд    CaptureDesc.lBufferBytes = CaptureDesc.fxFormat.lAvgBytesPerSec * 5        'Создадим буфер    Set objDSCaptureBuffer = objDSCapture.CreateCaptureBuffer(CaptureDesc)        'Добавим три уведомления    objDSCaptureBuffer.SetNotificationPositions 3, tmpEnd SubPrivate Sub cmdStart_Click()        'Здесь инициализируются необходимые объекты    '   это для определния поддерживаемых форматов    Dim lngFormats As CONST_WAVEFORMATFLAGS    'создаем экзепляр DirectX8    Set objDX8 = New DirectX8        'Создаем два события    '   остановка захвата    EventStop = objDX8.CreateEvent(Me)    '   во время захвата    EventNotify = objDX8.CreateEvent(Me)        'Создаем объект для захвата. В параметре указана vbNullString, что означает, что    'нами будет использоваться устройство захвата по умолчанию    Set objDSCapture = objDX8.DirectSoundCaptureCreate(vbNullString)        'Получим возможность устройства    objDSCapture.GetCaps CaptureCaps    '---------------------------------------------------------------------------------------------    'Здесь создадим и проинициализируем буфер        'Будет 3 уведомления    Dim tmp(0 To 2)  As DSBPOSITIONNOTIFY        'первые два - по ходу записи    With tmp(0)        .lOffset = 10000        .hEventNotify = EventNotify    End With    With tmp(1)        .lOffset = 30000        .hEventNotify = EventNotify    End With    'а это по завершении    With tmp(2)        .lOffset = DSBPN_OFFSETSTOP        .hEventNotify = EventStop    End With        'укажем формат захвата звука    With CaptureDesc.fxFormat        .nFormatTag = WAVE_FORMAT_PCM        .nChannels = 2        .lSamplesPerSec = 22050        .nBitsPerSample = 16        .nBlockAlign = .nBitsPerSample / 8 * .nChannels        .lAvgBytesPerSec = .lSamplesPerSec * .nBlockAlign        .nSize = 0    End With        CaptureDesc.lFlags = DSCBCAPS_DEFAULT    'Размер буфера. В данном случае 1 секунда    CaptureDesc.lBufferBytes = CaptureDesc.fxFormat.lAvgBytesPerSec * 1 '5        'Создадим буфер    Set objDSCaptureBuffer = objDSCapture.CreateCaptureBuffer(CaptureDesc)        'Добавим три уведомления    objDSCaptureBuffer.SetNotificationPositions 3, tmp'---------------------------------------------------------------------------------------------        'Путь к файлу    Dim strPath As String    strPath = txtPath.Text        'Откроем файл для двоичного доступа на запись    Open strPath For Binary Access Write As #1      'Запишем заголовки    With fh        .lRiff = &H46464952        .lFileSize = 0   ' Размер файла узнаем позже        .lWave = &H45564157        .lFormat = &H20746D66        .lFormatLength = Len(wf)    End With    Put #1, , fh    With wf        .wFormatTag = CaptureDesc.fxFormat.nFormatTag        .nChannels = CaptureDesc.fxFormat.nChannels        .nSamplesPerSec = CaptureDesc.fxFormat.lSamplesPerSec        .wBitsPerSample = CaptureDesc.fxFormat.nBitsPerSample        .nBlockAlign = CaptureDesc.fxFormat.nBlockAlign        .nAvgBytesPerSec = CaptureDesc.fxFormat.lAvgBytesPerSec    End With    Put #1, , wf    ch.lType = &H61746164    Put #1, , ch'---------------------------------------------------------------------------------------------    'Начнем запись. DSCBSTART_LOOPING означает, что захват будет вестись бесконечно,    'пока не будет остановлен вручную.    objDSCaptureBuffer.Start DSCBSTART_LOOPING    End SubPrivate Sub cmdStop_Click()    'А вот и эта ручная остановка    objDSCaptureBuffer.StopEnd Sub'А вот и обработка событий буфераPrivate Sub DirectXEvent8_DXCallback(ByVal eventid As Long)        'Здесь будет текущее положение курсора    Dim curPos As Long    Dim curs As DSCURSORS        'Это считанные данные    Dim dataBuf() As Byte    'А это размер считанных данных    Dim dataSize As Long        'Узнаем текущую позицию    objDSCaptureBuffer.GetCurrentPosition curs    curPos = curs.lWrite  ' Вполть до этой позиции можно считывать данные               'Узнаем, сколько байт накопилось с прошлой записи в файл,    'получив разность между текущим положением курсора и прошлым    dataSize = curPos - lastPos    'Если эта разница меньше 0, то значит, что с прошлой записи    'курсор дошел до конца и запись вновь началась с начала буфера.    'Тогда размер данных складывается из двух: того, что прошел с начала    'буфера (curPos), и того, что оставался с момента прошлого вызова:    '<размер буфера>-lastPos.    If dataSize < 0 Then        dataSize = (CaptureDesc.lBufferBytes - lastPos) + curPos    End If        'Переопределим размер локального буфера    ReDim dataBuf(dataSize - 1)    'И считаем в него данные    objDSCaptureBuffer.ReadBuffer lastPos, dataSize, dataBuf(0), DSCBLOCK_DEFAULT            'Запишем эти данные и увеличим счетчик записанных байтов    Put #1, , dataBuf    BytesWritten = BytesWritten + dataSize        lblBytesWritten.Caption = BytesWritten    lastPos = curPos        'Это так, для отладки    Select Case eventid        Case EventStop            Debug.Print "DxEvent::Stop:: всего байт записали " & BytesWritten        Case EventNotify            Debug.Print "DxEvent::Notify:: в этом событии записали " & dataSize & " байт"    End Select        'Если событие "Остановка", то завершим запись в файл    If (eventid = EventStop) Then        CloseFile    End IfEnd SubPrivate Sub CloseFile()  Dim fsize As Long    'А теперь вернемся к прощенному: размер файла - теперь он нам известен  fsize = Len(fh) + Len(wf) + Len(ch) + BytesWritten  Put #1, 5, fsize    ' Rewrite data chunk header with size.    'То же и с Chunk  ch.lLen = BytesWritten  Put #1, Len(fh) + Len(wf) + 1, ch    Close #1End SubPrivate Sub Form_Unload(Cancel As Integer)    'Ну а теперь надо зачистить все за собой        'Для начала проверим, остановлен ли захват    'Если нет, то нажмем на кнопку "Стоп"    If (objDSCaptureBuffer.GetStatus And DSCBSTATUS_CAPTURING) > 1 Then        cmdStop.Value = True    End If        'Удалим события    objDX8.DestroyEvent EventStop    objDX8.DestroyEvent EventNotify        'А теперь уничтожим объекты    Set objDSCaptureBuffer = Nothing    Set objDSCapture = Nothing    Set objDX8 = NothingEnd SubhighlightSyntax('vbWZkNmJ','vb');вот нашел учебный пример, показывающий запись в Wav-файл с микрофона,что значит строкаКод  Set objDSCapture = objDX8.DirectSoundCaptureCreate(vbNullString)highlightSyntax('vbNDA3ZT','vb');в комментариях написано, что vbNullString - устройство захвата по умолчанию - микрофонных вход на звуковухе что-ли?. Тогда как инициализировать Line-in. Неуж-то никто не знает?

Интернет казино     Онлайн игры     Увеличение члена     Купить DVD