vb.net - waveout 有时会出现内存问题

Question

此代码可通过平台调用服务使用 winmm.dll 输出 2 秒的钢琴音，在 XP 上似乎可以正常工作，但在 windows 7 rc 中 waveoutopen 失败

根据 John Knoeller 的反馈更新

导入 System.Runtime.InteropServices
公共(public)类音频流

<StructLayout(LayoutKind.Sequential)> _
Private Structure WAVEHDR
    Public lpData As Integer
    Public dwBufferLength As Integer
    Public dwBytesRecorded As Integer
    Public dwUser As Integer
    Public dwFlags As Integer
    Public dwLoops As Integer
    Public lpNext As Integer
    Public Reserved As Integer
End Structure

<StructLayout(LayoutKind.Sequential)> _
Private Structure WAVEFORMATEX
    Public wFormatTag As Int16
    Public nChannels As Int16
    Public nSamplesPerSec As Int32
    Public nAvgBytesPerSec As Int32
    Public nBlockAlign As Int16
    Public wBitsPerSample As Int16
    Public cbSize As Int16
End Structure

Private Declare Function waveOutOpen Lib "winmm.dll" (ByRef lphWaveOut As Int32, ByVal uDeviceID As Int32, ByRef lpFormat As WAVEFORMATEX, ByVal dwCallback As WaveDelegate, ByVal dwInstance As Int32, ByVal dwFlags As Int32) As Int32
Private Declare Function waveOutClose Lib "winmm.dll" (ByVal hWaveOut As Int32) As Int32
Private Declare Function waveOutPrepareHeader Lib "winmm.dll" (ByVal hWaveOut As Int32, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Int32) As Int32
Private Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveOut As Int32, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Int32) As Int32
Private Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Int32, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Int32) As Int32
Private Delegate Sub WaveDelegate(ByVal hwo As IntPtr, ByVal uMsg As Integer, ByVal dwInstance As Integer, ByRef wavhdr As WAVEHDR, ByVal dwParam2 As Integer)

Private Const WAVE_MAPPER = -1&
Private Const WAVE_FORMAT_PCM = 1
Private Const CALLBACK_FUNCTION = &H30000                   ' to set up a callback to a function
Private Const WHDR_DONE = &H1                               ' done bit
Private Const WHDR_PREPARED = &H2                           ' set if this header has been prepared
Private Const WHDR_BEGINLOOP = &H4                          ' loop start block
Private Const WHDR_ENDLOOP = &H8                            ' loop end block
Private Const WHDR_INQUEUE = &H10                           ' reserved for driver
Private Const MM_WOM_OPEN = &H3BB                           ' waveform output
Private Const MM_WOM_CLOSE = &H3BC
Private Const MM_WOM_DONE = &H3BD
Private Const WOM_OPEN = MM_WOM_OPEN
Private Const WOM_CLOSE = MM_WOM_CLOSE
Private Const WOM_DONE = MM_WOM_DONE
Private Const MMSYSERR_BASE = 0
Private Const MMSYSERR_NOERROR = 0                          ' no error
Private Const MMSYSERR_ERROR = (MMSYSERR_BASE + 1)          ' unspecified error
Private Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)    ' device ID out of range
Private Const MMSYSERR_NOTENABLED = (MMSYSERR_BASE + 3)     ' driver failed enable
Private Const MMSYSERR_ALLOCATED = (MMSYSERR_BASE + 4)      ' device already allocated
Private Const MMSYSERR_INVALHANDLE = (MMSYSERR_BASE + 5)    ' device handle is invalid
Private Const MMSYSERR_NODRIVER = (MMSYSERR_BASE + 6)       ' no device driver present
Private Const MMSYSERR_NOMEM = (MMSYSERR_BASE + 7)          ' memory allocation error
Private Const MMSYSERR_NOTSUPPORTED = (MMSYSERR_BASE + 8)   ' function isn't supported
Private Const MMSYSERR_BADERRNUM = (MMSYSERR_BASE + 9)      ' error value out of range
Private Const MMSYSERR_INVALFLAG = (MMSYSERR_BASE + 10)     ' invalid flag passed
Private Const MMSYSERR_INVALPARAM = (MMSYSERR_BASE + 11)    ' invalid parameter passed
Private Const MMSYSERR_HANDLEBUSY = (MMSYSERR_BASE + 12)    ' handle being used simultaneously on another thread (eg callback) */
Private Const MMSYSERR_INVALIDALIAS = (MMSYSERR_BASE + 13)  ' specified alias not found
Private Const MMSYSERR_BADDB = (MMSYSERR_BASE + 14)         ' bad registry database
Private Const MMSYSERR_KEYNOTFOUND = (MMSYSERR_BASE + 15)   ' registry key not found
Private Const MMSYSERR_READERROR = (MMSYSERR_BASE + 16)     ' registry read error
Private Const MMSYSERR_WRITEERROR = (MMSYSERR_BASE + 17)    ' registry write error
Private Const MMSYSERR_DELETEERROR = (MMSYSERR_BASE + 18)   ' registry delete error
Private Const MMSYSERR_VALNOTFOUND = (MMSYSERR_BASE + 19)   ' registry value not found
Private Const MMSYSERR_NODRIVERCB = (MMSYSERR_BASE + 20)    ' driver does not call DriverCallback
Private Const MMSYSERR_MOREDATA = (MMSYSERR_BASE + 21)      ' more data to be returned
Private Const MMSYSERR_LASTERROR = (MMSYSERR_BASE + 21)     ' last error in range
Private Const WAVERR_BASE = 32
Private Const WAVERR_BADFORMAT = (WAVERR_BASE + 0)          ' unsupported wave format
Private Const WAVERR_STILLPLAYING = (WAVERR_BASE + 1)       ' still something playing
Private Const WAVERR_UNPREPARED = (WAVERR_BASE + 2)         ' header not prepared
Private Const WAVERR_SYNC = (WAVERR_BASE + 3)               ' device is synchronous
Private Const WAVERR_LASTERROR = (WAVERR_BASE + 3)          ' last error in range

Private FinishedPlaying As Boolean                          ' local flag to track playback status
Private mCallBack As WaveDelegate = AddressOf WaveCallBack  ' function pointer to our callback function
Private pmem As IntPtr                                      ' heap memory pointer

''' <summary>
''' Play a tone of a specified hz frequency for a specified duration in seconds
''' </summary>
Public Sub Play(ByVal Frequency As Single, ByVal Seconds As Single)

    Dim wavFormat As WAVEFORMATEX
    Dim wavHead As WAVEHDR
    Dim hWaveOut As Int32

    With wavFormat
        .wFormatTag = WAVE_FORMAT_PCM
        .nChannels = 2
        .wBitsPerSample = 16
        .nSamplesPerSec = 44100
        .nBlockAlign = .nChannels * .wBitsPerSample / 8
        .nAvgBytesPerSec = .nBlockAlign * .nSamplesPerSec
    End With

    Dim BufferSamples As Integer = wavFormat.nSamplesPerSec * Seconds
    Dim BufferBytes As Integer = BufferSamples * wavFormat.nBlockAlign
    'allocate memory on the heap
    pmem = Marshal.AllocHGlobal(BufferBytes)

    With wavHead
        .lpData = pmem.ToInt32
        .dwBufferLength = BufferBytes
    End With

    waveOutOpen(hWaveOut, WAVE_MAPPER, wavFormat, mCallBack, 0, CALLBACK_FUNCTION)
    waveOutPrepareHeader(hWaveOut, wavHead, Len(wavHead))
    FinishedPlaying = False

    ' fill buffer with specific frequency
    Dim SamplesPerCycle As Double = wavFormat.nSamplesPerSec / Frequency
    For i As Integer = 0 To BufferSamples - 1
        ' 16-bit samples are stored as 2's-complement signed integers, ranging from -32768 to 32767
        Dim RotationPercent As Double = (i Mod SamplesPerCycle) / SamplesPerCycle
        Dim RotationRadians As Double = RotationPercent * Math.PI * 2
        Dim SampleValue As Int16 = Math.Sin(RotationRadians) * Int16.MaxValue
        ' blocks are 4 bytes - 2 bytes for left channel then 2 bytes for right channel
        ' left channel
        Marshal.WriteInt16(pmem, i * wavFormat.nBlockAlign, SampleValue)
        ' right channel
        Marshal.WriteInt16(pmem, (i * wavFormat.nBlockAlign) + 2, SampleValue)
    Next

    ' play buffer
    waveOutWrite(hWaveOut, wavHead, Len(wavHead))

    Do While (Not FinishedPlaying)
        Application.DoEvents()
    Loop

    waveOutUnprepareHeader(hWaveOut, wavHead, Len(wavHead))
    waveOutClose(hWaveOut)

    'free memory we allocated on the heap
    Marshal.FreeHGlobal(pmem)

End Sub

''' <summary>
''' This is our handler for the waveout API callback
''' </summary>
Private Sub WaveCallBack(ByVal hwo As IntPtr, ByVal uMsg As Integer, ByVal dwInstance As Integer, ByRef wavhdr As WAVEHDR, ByVal dwParam2 As Integer)

    Select Case uMsg
        Case MM_WOM_OPEN
            Debug.WriteLine("Open")
        Case WOM_DONE
            FinishedPlaying = True
        Case Else
            Debug.WriteLine(uMsg)
    End Select

End Sub

''' <summary>
''' This is a convienient entry point to allow the class to be executed standalone (by configuring project properties)
''' </summary>
Public Shared Sub Main()

    Dim BeatsPerMinute As Double = 120
    Dim BeatsPerSecond As Double = BeatsPerMinute / 60
    Dim ScaleSteps() As Integer = {0, 2, 2, 1, 2, 2, 2, 1}       ' tone steps for major scale

    Dim MyAudioStream As New AudioStream
    Dim ToneFrequency As Double = 261.626                        ' 261.626hz middle c piano tone
    For t As Integer = 0 To ScaleSteps.Length - 1
        For s As Integer = 1 To ScaleSteps(t)
            ToneFrequency *= 1.05946309435929                    ' Twelfth root of two for next tone
        Next
        MyAudioStream.Play(ToneFrequency, 1 / BeatsPerSecond)    ' play tone for one second
    Next

End Sub

结束类

Answer 1

你的缓冲区太小，改变这个

Dim BufferSize As Integer = 44100 * Length - 1

对此

Dim BufferSize As Integer = 44100 * Length * 2 * 2
...
For i As Integer = 0 To (BufferSize/(2*2)) - 1

编辑:我根本不明白这是如何工作的，您将音频声明为 44khz、16 位立体声。

但是然后你用 32 位单声道填充音频缓冲区。所以数据的大小是可行的，但音频数据本身是错误的。

此外，nBlockAlign 应该是每个样本的字节数 * channel 数。

.nBlockAlign = 2*2

Edit2:我不断发现更多问题。我不是 VB 人，但我会尝试写出代码应该是什么样子，您可能需要修复语法错误。

       With wavFormat
        .wFormatTag = WAVE_FORMAT_PCM
        .nChannels = 2
        .wBitsPerSample = 16
        .nSamplesPerSec = 44100
        .nBlockAlign = .nChannels * .wBitsPerSample/8
        .nAvgBytesPerSec = .nBlockAlign * .nSamplesPerSec
       End With

    Dim BufferSamples As Integer = 44100 * Length
    Dim BufferBytes   As Integer = BufferSamples * wavFormat.nBlockAlign
    pmem = Marshal.AllocHGlobal(BufferBytes)


        With wavHead
        .lpData = pmem.ToInt32
        .dwBufferLength = BufferBytes
        End With

        waveOutOpen(hWaveOut, WAVE_MAPPER, wavFormat, mCallBack, 0, CALLBACK_FUNCTION)

        waveOutPrepareHeader(hWaveOut, wavHead, Len(wavHead))
        FinishedPlaying = False

        ' fill buffer

    ' Specific frequency:
    FreqConst = 44100 / (Math.PI * 2) / Freq
    For i As Integer = 0 To BufferSamples - 1
        Dim IntValue As Int16 = Math.Sin((i Mod 44100) / FreqConst)
        Marshal.WriteInt16(pmem, i*4, IntValue)
        Marshal.WriteInt16(pmem, i*4+2, IntValue)
    Next