Plantage GlobalAlloc() dans VB6

Plantage GlobalAlloc() dans VB6 - VB/VBA/VBS - Programmation

Marsh Posté le 18-04-2006 à 15:41:12    

Bonjour,
 
J'ai un plantage dans mon application au niveau de la fonction GlobalAlloc(), je n'ai aucun message d'erreur mais l'application se ferme brusquement.
 
Je lance une première fois la fonction StartInput() ça marche correctement en cours d'enregistrement je lance régulièrement la fonction GetVolume() sur un timer d'intervalle 1, lorsque j'ai fini mon enregistrement je déclanche la fonction StopInput(). Jusque là tout va bien mais si je veux relancer la fonction StartInput() directement derrière pour relancer un enregistrement le GlobalAlloc() sur hmem(0) marche mais celui sur hmem(1) fait planter l'application.  
 
Dans le code ci-dessous la valeur de BUFFER_SIZE est 700 et NUM_BUFFERS est 2. buffaddress est une variable globale
 
Code de StartInput() :

Code :
  1. Public Function StartInput() As Boolean
  2. On Error GoTo err
  4.     format.wFormatTag = 1
  5.     format.nChannels = 1
  6.     format.wBitsPerSample = 8
  7.     format.nSamplesPerSec = 12000
  8.     format.nBlockAlign = format.nChannels * format.wBitsPerSample / 8
  9.     format.nAvgBytesPerSec = format.nSamplesPerSec *   format.nBlockAlign
  10.     format.cbSize = 0
  12.     For i = 0 To NUM_BUFFERS - 1
  14.         hmem(i) = GlobalAlloc(&H40, BUFFER_SIZE)
  15.         inHdr(i).lpData = GlobalLock(hmem(i))
  16.         inHdr(i).dwBufferLength = BUFFER_SIZE
  17.         inHdr(i).dwFlags = 0
  18.         inHdr(i).dwLoops = 0
  20.     Next
  21.     rc = waveInOpen(hWaveIn, DEVICEID, format, 0, 0, 0)
  22.     If rc <> 0 Then
  23.         waveInGetErrorText rc, msg, Len(msg)
  24.         MsgBox msg
  25.         StartInput = False
  26.         Exit Function
  27.     End If
  29.     For i = 0 To NUM_BUFFERS - 1
  30.         rc = waveInPrepareHeader(hWaveIn, inHdr(i), Len(inHdr(i)))
  31.         If (rc <> 0) Then
  32.             waveInGetErrorText rc, msg, Len(msg)
  33.             MsgBox msg
  34.         End If
  36.     Next
  37.     For i = 0 To NUM_BUFFERS - 1
  38.         rc = waveInAddBuffer(hWaveIn, inHdr(i), Len(inHdr(i)))
  39.         If (rc <> 0) Then
  40.             waveInGetErrorText rc, msg, Len(msg)
  41.             MsgBox msg
  42.         End If
  44.     Next
  46.     fRecording = True
  47.     rc = waveInStart(hWaveIn)
  48.     StartInput = True
  50.     Exit Function
  51. err:
  52.     StartInput = False
  53. End Function


 
Code de StopInput() :

Code :
  1. Public Function StopInput() As Integer
  2.     On Error GoTo err
  4.     fRecording = False
  5.     waveInReset hWaveIn
  6.     waveInStop hWaveIn
  8.     For i = 0 To NUM_BUFFERS - 1
  9.         waveInUnprepareHeader hWaveIn, inHdr(i), Len(inHdr(i))
  10.         GlobalFree hmem(i)
  12.     Next
  13.     waveInClose hWaveIn
  14.     GlobalFree volHmem
  15.     StopInput = 0
  17.     Exit Function
  18. err:
  19.     StopInput = 1
  20. End Function


 
Code de getVolume() :

Code :
  1. Public Function getVolume(pbuff As Long) As Integer
  2. Dim n As Integer
  3.    On Error Resume Next
  5.          Do While Not inHdr(0).dwFlags And WHDR_DONE
  6.      
  7.          Loop
  8.             iValue.Caption = CStr(0)
  9.             iValue.Refresh
  10.             CopyStructFromPtr audbytearray, inHdr(0).lpData, inHdr(0).dwBufferLength
  11.             rc = waveInAddBuffer(hWaveIn, inHdr(0), Len(inHdr(0)))
  13.     tempval = 0
  14.     posval = 0
  15.     For n = 0 To BUFFER_SIZE - 1
  16.         posval = audbytearray.bytes(n) - 128
  17.         If posval < 0 Then posval = 0 - posval
  18.         If posval > tempval Then tempval = posval
  20.     Next n
  21.         getVolume = tempval
  22.         pbuff = inHdr(0).lpData
  24. End Function


 
Appel de la fonction StartInput() :

Code :
  1. SoundMeter.StartInput
  2.         Timer1.Enabled = True


 
Appel de la fonction StopInput() :

Code :
  1. Dim i As Long
  2.     Timer1.Enabled = False
  3.     For i = 1 To 500000
  4.     Next
  5.     SoundMeter.StopInput
  6.     buffaddress = 0


 
Appel de la fonction getVolume() :

Code :
  1. Private Sub Timer1_Timer()
  2.     Dim vValeur As Long
  4.     vValeur = SoundMeter.getVolume(buffaddress)
  5.     Select Case vValeur
  6.      ...
  7.     End Select


Message édité par antidotes le 18-04-2006 à 15:45:33
Reply

Marsh Posté le 18-04-2006 à 15:41:12   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed