WaveOut parfois de problème de mémoire

Question

Ce code fonctionne pour produire un son de piano pendant 2 secondes à l'aide winmm.dll via les services d'invocation de plate-forme, il semble fonctionner très bien sur XP mais WaveOutOpen échoue dans Windows 7 rc

jour à base sur les commentaires de John Knoeller

Importations System.Runtime.InteropServices classe publique 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

Votre tampon est trop petit, changer cette

Dim BufferSize As Integer = 44100 * Length - 1 

à cette

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

Edit: Je ne vois pas comment cela fonctionne à tous, vous déclarez l'audio 44kHz , Stéréo 16 bits.

mais ensuite vous remplissez le tampon audio avec 32 bits mono. Donc, la taille des données fonctionne, mais les données audio elles-mêmes sont fausses.

En outre, nBlockAlign doit être le nombre d'octets par échantillon * nombre de canaux.

.nBlockAlign = 2*2 

Édition2: Je continue à trouver plus de problèmes. Je ne suis pas un gars VB, mais je vais essayer d'écrire à quoi le code devrait ressembler, vous devrez peut-être corriger les erreurs de syntaxe.

 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