waveout sometimes memory issue

Question

This code works to output a piano tone for 2 seconds using winmm.dll via platform invocation services, it seems to work fine on XP but waveoutopen fails in windows 7 rc

updated based on feedback from John Knoeller

Imports System.Runtime.InteropServices Public Class AudioStream

<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

End Class

Answer 1

Your buffer is too small, change this

Dim BufferSize As Integer = 44100 * Length - 1

to this

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

Edit: I don't see how this works at all, you declare the audio as 44khz, 16 bit stereo.

but then you fill the audio buffer with 32bit mono. So the size of the data works out, but the audio data itself is wrong.

Also, nBlockAlign should be number of bytes per sample * number of channels.

.nBlockAlign = 2*2

Edit2: I keep finding more problems. I'm not a VB guy, but I'll try and write out what the code should look like, you may have to fix syntax errors.

       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