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 & "\test.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é, 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é 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été du Grosiflex-Core Copyright © 1998-2002 Grosiflex
'il peut etre utilisé 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é ce module sur la base de l'oscillope acoustique de Timothée sur VBFrance.Com
'j'ai donc modifié les methodes IN, ajouté des methode OUT et methodes communes
Public Const NUM_BUFFERS = 10 'Nb Buffer declaré pour notre appli dans WinMM
Public Const WHDR_DONE = &H1 'Valeur Flag = Etat Terminé
'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
