Quantcast
Channel: VBForums - Visual Basic 6 and Earlier
Viewing all articles
Browse latest Browse all 21131

[RESOLVED] App Crashes Only If Shelled

$
0
0
I'm working on this sound application that uses waveIn/waveOut to capture sound and display a sine wave in real time. If I run the app as a stand-alone it works perfectly but if I shell it then it will crash. I have narrowed it down to where the crash takes place.

Code:

  '
  '
Public Type WAVEHDR
  lpData As Long
  dwBufferLength As Long
  dwBytesRecorded As Long
  dwUser As Long
  dwFlags As Long
  dwLoops As Long
  lpNext As Long
  reserved As Long
End Type

Private Type WaveInBuffer
  hdr As WAVEHDR
  intBuffer() As Integer
  pMem As Long
End Type

Public Function StartRecord(ByVal samplerate As Long, ByVal Channels As Integer) As Boolean
 Dim udtWFX As WAVEFORMATEX
 Dim res As Long
 Dim i As Long
 Dim j As Long
 
 ReDim udtBuffers(lngBufCnt - 1) As WaveInBuffer

 With udtWFX
  .wFormatTag = WAVE_FORMAT_PCM
  .nSamplesPerSec = samplerate
  .nChannels = Channels
  .wBitsPerSample = 16
  .nBlockAlign = Channels * (.wBitsPerSample / 8)
  .nAvgBytesPerSec = .nBlockAlign * .nSamplesPerSec
  .cbSize = 0
 End With

 Const CALLBACK_FUNCTION = &H30000
 res = waveInOpen(hWaveIn, lngCurDev, udtWFX, AddressOf waveInProc, 0, CALLBACK_FUNCTION)
   
 If res <> MMSYSERR_NOERROR Then
  Exit Function
 End If

 ' prepare headers/buffers
 For i = 0 To lngBufCnt - 1
  With udtBuffers(i)
    ReDim .intBuffer(lngBufSize / 2 - 1) As Integer
   
    .pMem = VarPtr(.intBuffer(0))
    .hdr.dwBufferLength = lngBufSize
    .hdr.lpData = .pMem
    .hdr.dwUser = i

    res = waveInPrepareHeader(hWaveIn, .hdr, Len(.hdr))
           
    If res <> MMSYSERR_NOERROR Then
      ' on error unprepare all prepared headers
      For j = (i - 1) To 0 Step -1
        waveInUnprepareHeader hWaveIn, .hdr, Len(.hdr)
      Next

      waveInClose hWaveIn
      hWaveIn = 0

      Exit Function
    End If
  End With
 Next
 
 res = waveInStart(hWaveIn)
 
 If res <> MMSYSERR_NOERROR Then
  For i = 0 To lngBufCnt - 1
    waveInUnprepareHeader hWaveIn, udtBuffers(i).hdr, Len(udtBuffers(i).hdr)
  Next

  waveInClose hWaveIn
  hWaveIn = 0

  Exit Function
 End If

 For i = 0 To lngBufCnt - 1
  '
  ' THIS IS WHAT CAUSES APP TO CRASH. IF I COMMENT OUT THEN
  ' APP WILL  NOT CRASH. IF I EXECUTE BELOW APP CRASHES
  '
  ' NOTE: THIS ONLY OCCURS IF THIS APP IS SHELLED BY ANOTHER APP
  '
  waveInAddBuffer hWaveIn, udtBuffers(i).hdr, Len(udtBuffers(i).hdr)
 Next
 
 StartRecord = True
End Function

Private Sub waveInProc(ByVal hwi As Long, _
                      ByVal uMsg As Integer, _
                      ByVal dwInstance As Long, _
                      ByVal dwParam1 As Long, _
                      ByVal dwParam2 As Long)

 Dim udtHdr As WAVEHDR
 
 Select Case uMsg
  Case MM_WIM_OPEN
   
  Case MM_WIM_DATA
    If IsBadReadPtr(ByVal dwParam1, Len(udtHdr)) = 0 Then
      CpyMem udtHdr, ByVal dwParam1, Len(udtHdr)
 
      GotData udtBuffers(udtHdr.dwUser).intBuffer, udtHdr.dwBytesRecorded
 
      ' place the buffer in the waveIn queue again
      waveInAddBuffer hWaveIn, udtBuffers(udtHdr.dwUser), Len(udtHdr)
    Else
  End If
 
  Case MM_WIM_CLOSE
 End Select
End Sub

I'd like to also point out that if I do not comment out the failing statement above but I disallow the callback proc from being entered the app will not crash. If I do comment out the failing statement and allow subclassing also app will not crash. So, the problem only occurs if all I do is shell this app otherwise it runs perfectly

Viewing all articles
Browse latest Browse all 21131

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>