Problème de thread :$

Question

J'ai un programme utilisant un thread, &#231;a fonctionne sur l'IDE (malgr&#233;
le fait qu'il faut relancer VB &#224; chaque arr&#234;t) et une fois en .EXE
c'est tout plant&#233;, et j'ai pas le choix d'utiliser un thread. J'ai d&#233;j&#224;
fait des tests sur les threads mais le prog se rendait jamais au stade
de la compilation :$ . Le thread se lance au d&#233;marrage du prog et c'est
l&#224; que &#231;a plante.


@+ 





MSN : x_men_40@hotmail.com

cs_max12 · Answer

Tient alors :

Le code en bleu est celui qui est threaded. C'est pour capturer du son, sinon c'est plein de coupure et tout



Public Declare Function CreateThread Lib "kernel32" (lpThreadAttributes
As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long,
lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long)
As Long


Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long


Public Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long


Public Declare Function CoInitialize Lib "ole32.dll" (pvReserved As Long) As Long





Public BuffRecp As String   'buffer de reception


Public TBuffRecp As Long    'Taille en octet du beffer de reception







Public Sub Capture(Var As Byte)


On Error Resume Next





    Call CoInitialize(ByVal 0&)


    


    Dim BuffTemp As AUDIO_ARRAY 'ici on declare un buffer WinMM


    Dim i As Long


    Dim j As Long


    Dim fFile As Long


    Dim Ech As Byte


    


    'Mesure du son


    Dim tempval As Long


    Dim posval As Long





    Do


    


        If FrmMain.Timer1.Enabled = True Then


     


        fFile = FreeFile


        Open App.Path & "	est.wav" For Append As #fFile


        For i = 0 To NUM_BUFFERS - 1

           
'on matte leur flag (probleme de valeur pareille pour NT(3) et
WIN9x(4099), mettez les 2 plus d'embrouille ;))


            

           
If MWinMM.inHdr(i).dwFlags 3 Or MWinMM.inHdr(i).dwFlags 4099 Then


            

               
CopyStructFromPtr BuffTemp, MWinMM.inHdr(i).lpData,
MWinMM.inHdr(i).dwBufferLength


                


                'Buffer vid&#233;, on continu

               
Result = waveInAddBuffer(MWinMM.hWaveIn, MWinMM.inHdr(i),
Len(MWinMM.inHdr(i)))


                


                If (Result  0) Then

                   
'oui on racroche

                   
MWinMM.waveInGetErrorText Result, MWinMM.inErrorMsg,
Len(MWinMM.inErrorMsg)

                   
MsgBox MWinMM.inErrorMsg


                    Exit Sub


                End If

   
'               
'oui, alors on scan chaque Echantillon (octet ici :) 8000Ko) du buffer
courant


                


                StrBuff = vbNullString


    


                tempval = 0


                posval = 0


                

               
For j = 0 To MWinMM.IN_BUFFER_SIZE - 1

                   
'recupe de l'enchantillon courant

                   
Ech = BuffTemp.bytes(j)

                   
StrBuff = StrBuff & Chr(Ech)


                    

                   
posval = BuffTemp.bytes(j) - 128

                   
If posval < 0 Then posval = 0 - posval

                   
If posval > tempval Then tempval = posval


                Next j


                


                FrmMain.Pro1.Value = tempval


                


                Print #fFile, StrBuff;


                


            End If


        Next i


        Close #fFile


        End If


    Loop


End Sub





'COMBOX V1.0

'------------

'par LABBE ROMAIN (GROSIFLEX-CORE) le 09/11/2002

'Streammer de flux audio par Winsock sans compression

'Echantillonn&#233; a 8Ko/Sec emit a 8Ko/Sec avec modeste detection de blanc

'http://www.combox.fr.st     ->   Evolution de la ComBox

'http://www.zorglub3d.fr.st  ->   Moteur 3D

'Ce code est a propri&#233;t&#233; du Grosiflex-Core Copyright &#169; 1998-2002 Grosiflex

'il peut etre utilis&#233; par tous dans un but non commercial



'Module MWinMM, acces aux ressources de la DLL WinMM grace a un certain nombre d'outils et de class

'j'ai cod&#233; ce module sur la base de l'oscillope acoustique de Timoth&#233;e sur VBFrance.Com

'j'ai donc modifi&#233; les methodes IN, ajout&#233; des methode OUT et methodes communes



Public Const NUM_BUFFERS = 10    'Nb Buffer declar&#233; pour notre appli dans WinMM

Public Const WHDR_DONE &H1    'Valeur Flag Etat Termin&#233;



'declaration de type

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

Type WAVECAPS

   wMid As Integer

   wPid As Integer

   vDriverVersion As Long

   szPname As String * 32

   dwFormats As Long

   wChannels As Integer

End Type

Type WAVEFORMAT

   wFormatTag As Integer

   nChannels As Integer

   nSamplesPerSec As Long

   nAvgBytesPerSec As Long

   nBlockAlign As Integer

   wBitsPerSample As Integer

   cbSize As Integer

End Type

Type AUDIO_ARRAY

    bytes(5000) As Byte

End Type



'Declaration des functions dans winmm.dll

Public Declare Function waveInGetDevCaps Lib "winmm.dll" Alias
"waveInGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WAVECAPS, ByVal
uSize As Long) As Long

Public Declare Function waveInGetNumDevs Lib "winmm.dll" () As Long

Public Declare Function waveInOpen Lib "winmm.dll" (lphWaveIn As Long,
ByVal uDeviceID As Long, lpFormat As WAVEFORMAT, ByVal dwCallback As
Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long

Public Declare Function waveInPrepareHeader Lib "winmm.dll" (ByVal
hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long

Public Declare Function waveInReset Lib "winmm.dll" (ByVal hWaveIn As Long) As Long

Public Declare Function waveInStart Lib "winmm.dll" (ByVal hWaveIn As Long) As Long

Public Declare Function waveInStop Lib "winmm.dll" (ByVal hWaveIn As Long) As Long

Public Declare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal
hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long

Public Declare Function waveInClose Lib "winmm.dll" (ByVal hWaveIn As Long) As Long

Public Declare Function waveInGetErrorText Lib "winmm.dll" Alias
"waveInGetErrorTextA" (ByVal Err As Long, ByVal lpText As String, ByVal
uSize As Long) As Long

Public Declare Function waveInAddBuffer Lib "winmm.dll" (ByVal hWaveIn
As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long



Public Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long

Public Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias
"waveOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WAVECAPS,
ByVal uSize As Long) As Long

Public Declare Function waveOutGetErrorText Lib "winmm.dll" Alias
"waveOutGetErrorTextA" (ByVal Err As Long, ByVal lpText As String,
ByVal uSize As Long) As Long

Public Declare Function waveOutOpen Lib "winmm.dll" (lphWaveOut As
Long, ByVal uDeviceID As Long, lpFormat As WAVEFORMAT, ByVal dwCallback
As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long

Public Declare Function waveOutClose Lib "winmm.dll" (ByVal hWaveOut As Long) As Long

Public Declare Function waveOutPrepareHeader Lib "winmm.dll" (ByVal
hWaveOut As Long, lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long

Public Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal
hWaveOut As Long, lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long

Public Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As
Long, lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long

Public Declare Function waveOutPause Lib "winmm.dll" (ByVal hWaveOut As Long) As Long

Public Declare Function waveOutRestart Lib "winmm.dll" (ByVal hWaveOut As Long) As Long

Public Declare Function waveOutReset Lib "winmm.dll" (ByVal hWaveOut As Long) As Long



'Declaration des functions dans le noyau de windows, manip de pointeur

Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)

Public Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" (ByVal ptr As Long, struct As Any, ByVal cb As Long)

Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long

Public Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long

Public Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long



'Declaration de variables mmembres

'IN

Public hWaveIn As Long

Public inHmem(NUM_BUFFERS) As Long

Public inHdr(NUM_BUFFERS) As WAVEHDR

Public IN_BUFFER_SIZE As Long

Public IN_DEVICE_ID  As Long

Public inErrorMsg As String * 200

Public inRes As Long

Public inFormat As WAVEFORMAT

Public inRecording As Boolean



'OUT

Public hWaveOut As Long

Public outHmem(NUM_BUFFERS) As Long

Public outHdr(NUM_BUFFERS) As WAVEHDR

Public OUT_BUFFER_SIZE As Long

Public OUT_DEVICE_ID  As Long

Public outErrorMsg As String * 200

Public outRes As Long

Public outFormat As WAVEFORMAT

Public outPlaying As Boolean







Public Function OpenIn() As Boolean

    On Error GoTo Err



    'Prepare Format

    inFormat.wFormatTag = 1

    inFormat.nChannels = 2

    inFormat.wBitsPerSample = 8

    inFormat.nSamplesPerSec = 8000

    inFormat.nBlockAlign = inFormat.nChannels * inFormat.wBitsPerSample / 8

    inFormat.nAvgBytesPerSec = inFormat.nSamplesPerSec * inFormat.nBlockAlign

    inFormat.cbSize = 0

    

    'Prepare Buffer

    For i = 0 To NUM_BUFFERS - 1

        inHmem(i) = GlobalAlloc(&H40, IN_BUFFER_SIZE)

        inHdr(i).lpData = GlobalLock(inHmem(i))

        inHdr(i).dwBufferLength = IN_BUFFER_SIZE

        inHdr(i).dwFlags = 0

        inHdr(i).dwLoops = 0

    Next



    'ouverture du device

    inRes = waveInOpen(hWaveIn, IN_DEVICE_ID, inFormat, 0, 0, 0)

    If (inRes  0) Then

        waveInGetErrorText inRes, inErrorMsg, Len(inErrorMsg)

        MsgBox inErrorMsg

        GoTo Err

    End If



    'preparation des buffer

    For i = 0 To NUM_BUFFERS - 1

        inRes = waveInPrepareHeader(hWaveIn, inHdr(i), Len(inHdr(i)))

        If (inRes  0) Then

            waveInGetErrorText inRes, inErrorMsg, Len(inErrorMsg)

            MsgBox inErrorMsg

            GoTo Err

        End If

    Next i



    'indic les buffer a winmm

    For i = 0 To NUM_BUFFERS - 1

        inRes = waveInAddBuffer(hWaveIn, inHdr(i), Len(inHdr(i)))

        If (inRes  0) Then

            waveInGetErrorText inRes, inErrorMsg, Len(inErrorMsg)

            MsgBox inErrorMsg

            GoTo Err

        End If

    Next i

    

    'lance le peripherique en mode acquisition

    inRes = waveInStart(hWaveIn)

    If (inRes  0) Then

        waveInGetErrorText inRes, inErrorMsg, Len(inErrorMsg)

        MsgBox inErrorMsg

        GoTo Err

    End If

    inRecording = True

    OpenIn = True

    Exit Function

Err:

    inRecording = False

    OpenIn = False

End Function



Public Function CloseIn() As Boolean

    On Error GoTo Err

    inRecording = False

    waveInReset hWaveIn

    waveInStop hWaveIn

    For i = 0 To NUM_BUFFERS - 1

        inRes = waveInUnprepareHeader(hWaveIn, inHdr(i), Len(inHdr(i)))

        If (inRes  0) Then

            waveInGetErrorText inRes, inErrorMsg, Len(inErrorMsg)

            MsgBox inErrorMsg

            GoTo Err

        End If

        GlobalFree inHmem(i)

    Next

    waveInClose hWaveIn

    

    CloseIn = True

    Exit Function

Err:

    CloseIn = False

End Function



Public Function OpenOut() As Boolean

    On Error GoTo Err

    

     'Prepare Format

    outFormat.wFormatTag = 1

    outFormat.nChannels = 1

    outFormat.wBitsPerSample = 8

    outFormat.nSamplesPerSec = 8000

    outFormat.nBlockAlign = outFormat.nChannels * outFormat.wBitsPerSample / 8

    outFormat.nAvgBytesPerSec = outFormat.nSamplesPerSec * outFormat.nBlockAlign

    outFormat.cbSize = 0

    

    'Prepare Buffer

    For i = 0 To NUM_BUFFERS - 1

        outHmem(i) = GlobalAlloc(&H40, OUT_BUFFER_SIZE)

        outHdr(i).lpData = GlobalLock(outHmem(i))

        outHdr(i).dwBufferLength = OUT_BUFFER_SIZE

        outHdr(i).dwFlags = 0

        outHdr(i).dwLoops = 0

    Next

    

    outRes = waveOutOpen(hWaveOut, OUT_DEVICE_ID, outFormat, 0, 0, 0)

    If outRes  0 Then

        waveOutGetErrorText outRes, outErrorMsg, Len(outErrorMsg)

        MsgBox outErrorMsg

        GoTo Err

        Exit Function

    End If

    

    For i = 0 To NUM_BUFFERS - 1

        outRes = waveOutPrepareHeader(hWaveOut, outHdr(i), Len(outHdr(i)))

        outHdr(i).dwFlags = outHdr(i).dwFlags Or WHDR_DONE

        If outRes  0 Then

            waveOutGetErrorText outRes, outErrorMsg, Len(outErrorMsg)

            MsgBox outErrorMsg

            GoTo Err

            Exit Function

        End If

    Next i

    outPlaying = True

    OpenOut = True

    Exit Function

Err:

    outPlaying = False

    OpenOut = False

End Function



Public Function CloseOut() As Boolean

    outPlaying = False

    

    outRes = waveOutReset(hWaveOut)

    If outRes  0 Then

        waveOutGetErrorText outRes, outErrorMsg, Len(outErrorMsg)

        MsgBox outErrorMsg

        GoTo Err

        Exit Function

    End If

    

    For i = 0 To NUM_BUFFERS - 1

        outRes = waveOutUnprepareHeader(hWaveOut, outHdr(i), Len(outHdr(i)))

        If outRes  0 Then

            waveOutGetErrorText outRes, outErrorMsg, Len(outErrorMsg)

            MsgBox outErrorMsg

            GoTo Err

            Exit Function

        End If

        GlobalFree outHmem(i)

    Next i

    

    outRes = waveOutClose(hWaveOut)

    If outRes  0 Then

        waveOutGetErrorText outRes, outErrorMsg, Len(outErrorMsg)

        MsgBox outErrorMsg

        GoTo Err

        Exit Function

    End If

    CloseOut = True

    Exit Function

Err:

    CloseOut = False

End Function





Public Function OpenDevices() As Boolean

    If OpenIn() False Or OpenOut() False Then OpenDevices = False Else OpenDevices = True

End Function



Public Function CloseDevices() As Boolean

    If CloseIn False Or CloseOut False Then CloseDevices = False Else CloseDevices = True

End Function





@+ 







MSN : x_men_40@hotmail.com

Problème de thread :$

1 réponse

Discussions similaires