Запись файла в WAV формате.

[-=alp=-]

1) Как записать файл в WAV формате?
Нужно производить запись со звуковой карты и модема.

2) А самое главное нужно узнавать звук какой частоты, в каждую частоту дискретизации, записан в этом файле?

p.s. Объясняю, что такое частота дискретизации: заходите в свойства файла там, в сводке есть параметр «частота дискретизации» (например 22 кГц) это значит в файле записано в одной секунде 22000 разных звуков с разной частотой (именно эти частоты и нужно узнать)

[alibek]

Код: Выделить всё

'Заголовок RIFF файла
Private Type wavHeaderType
  wtID As String * 4                   ' идентификатор файла = "RIFF" = 0x46464952
  wtLength As Long                     ' длина файла без этого заголовка
End Type

'Сам WAV-файл может состоять из нескольких кусков,
'а эти куски, могут содержать по несколько выборок,
'или какую-то другую информацию.
'Но чаще всего (пока - всегда) часть одна и выборка одна.

'Заголовок куска WAV
Private Type wavPartHeaderType
  wtID As String * 4                   ' идентификатор = "WAVE" = 0x45564157
  wtFormat As String * 4               ' идентификатор = "fmt " = 0x20746D66
  wtLength As Long                     ' длина этого куска WAV - файла
End Type

'За нимне посредственно кусок WAV
Private Type wavPartType
  wtType As Integer                    ' тип звуковых данных (wavDataTypeEnum)
  wtChannels As Integer                ' число каналов (1, 2)
  wtSamplesPerSec As Long              ' частота выборки (сэмплов в секунду)
  wtAvgBytesPerSec As Long             ' частота выдачи байтов
  wtAlign As Integer                   ' выравнивание
  wtBits As Integer                    ' число бит на выборку
End Type

'Идентификатор выборки
Private Type wavWaveIDType
  wtID As String * 4                   ' идентификатор ="data" =0x61746164
  wtLength As Long                     ' длина выборки (кратно 2)
End Type

Private Type wavGeneralWaveType
  wtRIFF_ID As String * 4
  wtRIFF_Len As Long
  wtChuck_ID As String * 4
  wtChuck_Format As String * 4
  wtChuck_Len As Long
  wtType As Integer
  wtChannels As Integer
  wtFreq As Long
  wtBytes As Long
  wtAlign As Integer
  wtBits As Integer
  wtData_ID As String * 4
  wtData_Len As Long
End Type


Public Enum SoundStreamDataTypes 'Тип звуковых данных
  General = 1      ' просто выборка
  MuLaw = &H101&   ' IBM mu-law
  ALaw = &H102&    ' IBM a-law
  ADPCM = &H103&   ' ADPCM
End Enum


[MEMBER]

это значит в файле записано в одной секунде 22000 разных звуков с разной частотой

Это значит совсем другое.
И ещё, зачем узнавать частоту дискретизации, если при записи ты её и выставляешь?

[-=alp=-]

частоту частоту дискретизации не надо узновать

Это значит что в файле записано в одной секунде 22000 разных УРОВНЕЙ СИГНАЛА, которые представляют собой звуковую волну длительностью 1 секунда (в общем случае несинусоидальную).

нужно узнать эти уровни

[MEMBER]

Это уже ближе к телу...
А вот как узнать - рой, наверное, в направлении создания программного осциллографа, на основе звуковой карты.

[-=alp=-]

Спасибо всем я уже разобрался в данном вопросе

[MEMBER]

Поделись. Если не жалко.

[-=alp=-]

я пьяный говорю прямо

пишу чистый код разбирайся по стандиртизации английской
запись

на форме три кнопки и ocx commond diolog
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 2000 Microsoft Corporation. All Rights Reserved.
'
' File: frmCapture.frm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'This tutorial will show basic functionality. You will capture a buffer to memory,
'and then write it out to a file.

'Variable declarations for our app
Private dx As New DirectX8
Private dsc As DirectSoundCapture8
Private dscb As DirectSoundCaptureBuffer8
Private dscd As DSCBUFFERDESC
Private capFormat As WAVEFORMATEX
Private ds As DirectSound8

Private Sub InitCapture()

Dim cCaps As DSCCAPS
On Local Error Resume Next
'We need to create a direct sound object before the capture object
If ds Is Nothing Then Set ds = dx.DirectSoundCreate(vbNullString)
If Err Then
MsgBox "Unable to create a DirectSound object", vbOKOnly Or vbCritical, "Cannot continue"
Cleanup
End
End If
'First we need to create our capture buffer on the default object
Set dsc = dx.DirectSoundCaptureCreate(vbNullString)
If Err Then
MsgBox "Unable to create a Capture object", vbOKOnly Or vbCritical, "Cannot continue"
Cleanup
End
End If

'Lets get the caps for our object
dsc.GetCaps cCaps

'Check for a capture format we will support in the sample
'If cCaps.lFormats And WAVE_FORMAT_4M08 Then
capFormat = CreateWaveFormatEx(44100, 2, 16)
'ElseIf cCaps.lFormats And WAVE_FORMAT_2M08 Then
' capFormat = CreateWaveFormatEx(22050, 1,
'ElseIf cCaps.lFormats And WAVE_FORMAT_1M08 Then
' capFormat = CreateWaveFormatEx(11025, 1,
'Else
' MsgBox "Could not get the caps we need on this card.", vbOKOnly Or vbCritical, "Exiting."
' Cleanup
' End
'End If

End Sub

Private Sub CreateCaptureBuffer()
dscd.fxFormat = capFormat
dscd.lBufferBytes = capFormat.lAvgBytesPerSec * 20
dscd.lFlags = DSCBCAPS_WAVEMAPPED

Set dscb = dsc.CreateCaptureBuffer(dscd)
End Sub
Private Sub Cleanup()
Set ds = Nothing
Set dscb = Nothing
Set dsc = Nothing
Set dx = Nothing
End Sub
Private Function CreateWaveFormatEx(Hz As Long, Channels As Integer, BITS As Integer) As WAVEFORMATEX

'Create a WaveFormatEX structure using the vars we provide
With CreateWaveFormatEx
.nFormatTag = WAVE_FORMAT_PCM
.nChannels = Channels
.lSamplesPerSec = Hz
.nBitsPerSample = BITS
.nBlockAlign = Channels * BITS / 8
.lAvgBytesPerSec = .lSamplesPerSec * .nBlockAlign
.nSize = 0
End With
End Function

Private Sub cmdSave_Click()
On Local Error Resume Next
With cdlSave
'Set our initial properties
.FileName = vbNullString
.flags = cdlOFNHideReadOnly
.Filter = "Wave files(*.WAV)|*.wav"
.ShowOpen
If Err Then Exit Sub 'We clicked cancel
If .FileName = vbNullString Then Exit Sub 'No file
'Save the file to disk
GetSoundBufferFromCapture(dscb).SaveToFile .FileName
End With
End Sub

Private Sub cmdStart_Click()
'We want to record sound now.

'First we need to get rid of any sound we may have
Set dscb = Nothing
'Now get our capture buffer once more
CreateCaptureBuffer

'Now start recording
dscb.Start DSCBSTART_DEFAULT
'Disable/Enable our buttons accordingly
cmdStop.Enabled = True
cmdStart.Enabled = False
cmdSave.Enabled = False
End Sub

Private Sub cmdStop_Click()
Dim lbufferStatus As Long

'Stop the buffer
dscb.Stop

'Disable/Enable our buttons accordingly
cmdStop.Enabled = False
cmdStart.Enabled = True
cmdSave.Enabled = True
End Sub

Private Sub Form_Load()

'Lets init our capture device
InitCapture
End Sub

Private Sub Form_Unload(Cancel As Integer)
Cleanup
End Sub

Private Function GetSoundBufferFromCapture(ByVal oCaptureBuffer As DirectSoundCaptureBuffer8) As DirectSoundSecondaryBuffer8
Dim lbufferStatus As Long
Dim capCURS As DSCURSORS
Dim dsd As DSBUFFERDESC
Dim ByteBuffer() As Integer 'Our digital data from our capture buffer

'Are we still capturing? If so, stop
oCaptureBuffer.Stop

'Get the capture info
oCaptureBuffer.GetCurrentPosition capCURS
dsd.lBufferBytes = capCURS.lWrite + 1
dsd.fxFormat = dscd.fxFormat
'If there is nothing to write, then exit
If capCURS.lWrite = 0 Then Exit Function

Set GetSoundBufferFromCapture = ds.CreateSoundBuffer(dsd)
'Set the size for our new Data
ReDim ByteBuffer(capCURS.lWrite)
'Read the data from our capture buffer
oCaptureBuffer.ReadBuffer 0, capCURS.lWrite, ByteBuffer(0), DSCBLOCK_DEFAULT
'Write the data to our sound buffer
GetSoundBufferFromCapture.WriteBuffer 0, capCURS.lWrite, ByteBuffer(0), DSBLOCK_DEFAULT

End Function



чтение

Private dx As New DirectX8
Private ds As DirectSound8
Private dsb As DirectSoundSecondaryBuffer8
Private msFile As String
Private dsBuf As DSBUFFERDESC
Private i As Long
Private BuFMy As Long
Private Sub Command1_Click()
msFile = App.Path & "\111.wav"
Set dsb = ds.CreateSoundBufferFromFile(msFile, dsBuf)
dsb.Play 0
i = 100000
End Sub

Private Sub Form_Load()
InitDSound
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set dsb = Nothing
Set ds = Nothing
Set dx = Nothing
End Sub
Private Function InitDSound() As Boolean
On Error GoTo FailedInit
InitDSound = True
Set ds = dx.DirectSoundCreate(vbNullString)
ds.SetCooperativeLevel Me.hWnd, DSSCL_PRIORITY
Exit Function

FailedInit:
InitDSound = False
End Function

Private Sub Timer1_Timer()
i = i + 1
On Local Error Resume Next
dsb.ReadBuffer i, 1, BuFMy, DSBLOCK_DEFAULT
If i = 20000000 Then i = 0
Me.Caption = i & " \ " & BuFMy
PSet (i - 100000, BuFMy), RGB(255, 0, 0)
VScroll1.Value = BuFMy
End Sub

Private Sub VScroll2_Change()
Timer1.Interval = VScroll2.Value
End Sub

не забудь в progect referenc подключить direcX8 for VB