A callback was made on a garbage collected delegate

[lytamhoana6cntt]

Tôi có đoạn code sau.


Option Strict On
Option Explicit On

Imports System.Runtime.InteropServices

Public Class clsWaveIn

#Region "Constants"

Public Const BUFFERS As Integer = 19 'for a 0 to 19 array

'Constant Values for Possible Errors in the MultiMedia System
Private Const MMSYSERR_BASE As Integer = 0
Private Const MMSYSERR_NOERROR As Integer = (MMSYSERR_BASE) ' No Error
Private Const MMSYSERR_ERROR As Integer = (MMSYSERR_BASE + 1) ' unspecified error
Private Const MMSYSERR_BADDEVICEID As Integer = (MMSYSERR_BASE + 2) ' device ID out of range
Private Const MMSYSERR_NOTENABLED As Integer = (MMSYSERR_BASE + 3) ' driver failed enable
Private Const MMSYSERR_ALLOCATED As Integer = (MMSYSERR_BASE + 4) ' device already allocated
Private Const MMSYSERR_INVALHANDLE As Integer = (MMSYSERR_BASE + 5) ' device handle is invalid
Private Const MMSYSERR_NODRIVER As Integer = (MMSYSERR_BASE + 6) ' no device driver present
Private Const MMSYSERR_NOMEM As Integer = (MMSYSERR_BASE + 7) ' memory allocation error
Private Const MMSYSERR_NOTSUPPORTED As Integer = (MMSYSERR_BASE + 8) ' function isn't supported
Private Const MMSYSERR_BADERRNUM As Integer = (MMSYSERR_BASE + 9) ' error value out of range
Private Const MMSYSERR_INVALFLAG As Integer = (MMSYSERR_BASE + 10) ' invalid flag passed
Private Const MMSYSERR_INVALPARAM As Integer = (MMSYSERR_BASE + 11) ' invalid parameter passed
Private Const MMSYSERR_HANDLEBUSY As Integer = (MMSYSERR_BASE + 12) ' handle being used
' simultaneously on another
' thread (eg callback)
Private Const MMSYSERR_INVALIDALIAS As Integer = (MMSYSERR_BASE + 13) ' specified alias not found
Private Const MMSYSERR_BADDB As Integer = (MMSYSERR_BASE + 14) ' bad registry database
Private Const MMSYSERR_KEYNOTFOUND As Integer = (MMSYSERR_BASE + 15) ' registry key not found
Private Const MMSYSERR_READERROR As Integer = (MMSYSERR_BASE + 16) ' registry read error
Private Const MMSYSERR_WRITEERROR As Integer = (MMSYSERR_BASE + 17) ' registry write error
Private Const MMSYSERR_DELETEERROR As Integer = (MMSYSERR_BASE + 18) ' registry delete error
Private Const MMSYSERR_VALNOTFOUND As Integer = (MMSYSERR_BASE + 19) ' registry value not found
Private Const MMSYSERR_NODRIVERCB As Integer = (MMSYSERR_BASE + 20) ' driver does not call DriverCallback
Private Const MMSYSERR_LASTERROR As Integer = (MMSYSERR_BASE + 20) ' last error in range

Private Const MAXPNAMELEN As Integer = 32

Private Const WAVERR_BASE As Integer = 32
Private Const WAVERR_BADFORMAT As Integer = (WAVERR_BASE + 0) ' unsupported wave format
Private Const WAVERR_STILLPLAYING As Integer = (WAVERR_BASE + 1) ' still something playing
Private Const WAVERR_UNPREPARED As Integer = (WAVERR_BASE + 2) ' header not prepared
Private Const WAVERR_SYNC As Integer = (WAVERR_BASE + 3) ' device is synchronous
Private Const WAVERR_LASTERROR As Integer = (WAVERR_BASE + 3) ' last error in range

Private Const CALLBACK_TYPEMASK As Integer = &H70000 ' callback type mask */
Private Const CALLBACK_NULL As Integer = &H0 ' no callback */
Private Const CALLBACK_WINDOW As Integer = &H10000 ' dwCallback is a HWND */
Private Const CALLBACK_TASK As Integer = &H20000 ' dwCallback is a HTASK */
Private Const CALLBACK_FUNCTION As Integer = &H30000 ' dwCallback is a FARPROC */
Private Const CALLBACK_THREAD As Integer = (CALLBACK_TASK) ' thread ID replaces 16 bit task */
Private Const CALLBACK_EVENT As Integer = &H50000 ' dwCallback is an EVENT Handle */

Private Const MM_WOM_OPEN As Integer = &H3BB ' waveform output
Private Const MM_WOM_CLOSE As Integer = &H3BC
Private Const MM_WOM_DONE As Integer = &H3BD

Private Const MM_WIM_OPEN As Integer = &H3BE 'waveform input
Private Const MM_WIM_CLOSE As Integer = &H3BF
Private Const MM_WIM_DATA As Integer = &H3C0

' wave callback messages
Private Const WOM_OPEN As Integer = MM_WOM_OPEN
Private Const WOM_CLOSE As Integer = MM_WOM_CLOSE
Private Const WOM_DONE As Integer = MM_WOM_DONE
Private Const WIM_OPEN As Integer = MM_WIM_OPEN
Private Const WIM_CLOSE As Integer = MM_WIM_CLOSE
Private Const WIM_DATA As Integer = MM_WIM_DATA


' types for wType field in MMTIME struct
Private Const TIME_MS As Integer = &H1 ' time in milliseconds
Private Const TIME_SAMPLES As Integer = &H2 ' number of wave samples
Private Const TIME_BYTES As Integer = &H4 ' current byte offset
Private Const TIME_SMPTE As Integer = &H8 ' SMPTE time
Private Const TIME_MIDI As Integer = &H10 ' MIDI time
Private Const TIME_TICKS As Integer = &H20

' flags for dwSupport field of WAVEOUTCAPS
Private Const WAVECAPS_PITCH As Integer = &H1 ' supports pitch control
Private Const WAVECAPS_PLAYBACKRATE As Integer = &H2 ' supports playback rate control
Private Const WAVECAPS_VOLUME As Integer = &H4 ' supports volume control
Private Const WAVECAPS_LRVOLUME As Integer = &H8 ' separate left-right volume control
Private Const WAVECAPS_SYNC As Integer = &H10
Private Const WAVECAPS_SAMPLEACCURATE As Integer = &H20
Private Const WAVECAPS_DIRECTSOUND As Integer = &H40

' device ID for wave device mapper
Private Const WAVE_MAPPER As Integer = -1

' flags for dwFlags parameter in waveOutOpen() and waveInOpen()
Private Const WAVE_FORMAT_QUERY As Integer = &H1
Private Const WAVE_ALLOWSYNC As Integer = &H2
Private Const WAVE_MAPPED As Integer = &H4
Private Const WAVE_FORMAT_DIRECT As Integer = &H8
Private Const WAVE_FORMAT_DIRECT_QUERY As Integer = (WAVE_FORMAT_QUERY Or WAVE_FORMAT_DIRECT)

' flags for dwFlags field of WAVEHDR
Private Const WHDR_DONE As Integer = &H1 ' done bit
Private Const WHDR_PREPARED As Integer = &H2 ' set if this header has been prepared
Private Const WHDR_BEGINLOOP As Integer = &H4 ' loop start block
Private Const WHDR_ENDLOOP As Integer = &H8 ' loop end block
Private Const WHDR_INQUEUE As Integer = &H10 ' reserved for driver

' defines for dwFormat field of WAVEINCAPS and WAVEOUTCAPS

Private Const WAVE_INVALIDFORMAT As Integer = &H0 ' invalid format
Private Const WAVE_FORMAT_1M08 As Integer = &H1 ' 11.025 kHz, Mono, 8-bit
Private Const WAVE_FORMAT_1S08 As Integer = &H2 ' 11.025 kHz, Stereo, 8-bit
Private Const WAVE_FORMAT_1M16 As Integer = &H4 ' 11.025 kHz, Mono, 16-bit
Private Const WAVE_FORMAT_1S16 As Integer = &H8 ' 11.025 kHz, Stereo, 16-bit
Private Const WAVE_FORMAT_2M08 As Integer = &H10 ' 22.05 kHz, Mono, 8-bit
Private Const WAVE_FORMAT_2S08 As Integer = &H20 ' 22.05 kHz, Stereo, 8-bit
Private Const WAVE_FORMAT_2M16 As Integer = &H40 ' 22.05 kHz, Mono, 16-bit
Private Const WAVE_FORMAT_2S16 As Integer = &H80 ' 22.05 kHz, Stereo, 16-bit
Private Const WAVE_FORMAT_4M08 As Integer = &H100 ' 44.1 kHz, Mono, 8-bit
Private Const WAVE_FORMAT_4S08 As Integer = &H200 ' 44.1 kHz, Stereo, 8-bit
Private Const WAVE_FORMAT_4M16 As Integer = &H400 ' 44.1 kHz, Mono, 16-bit
Private Const WAVE_FORMAT_4S16 As Integer = &H800 ' 44.1 kHz, Stereo, 16-bit

'Constant Values for the Possible MMIO Errors
Private Const MMIOERR_BASE As Integer = 256
Private Const MMIOERR_FILENOTFOUND As Integer = (MMIOERR_BASE + 1) ' file not found
Private Const MMIOERR_OUTOFMEMORY As Integer = (MMIOERR_BASE + 2) ' out of memory
Private Const MMIOERR_CANNOTOPEN As Integer = (MMIOERR_BASE + 3) ' cannot open
Private Const MMIOERR_CANNOTCLOSE As Integer = (MMIOERR_BASE + 4) ' cannot close
Private Const MMIOERR_CANNOTREAD As Integer = (MMIOERR_BASE + 5) ' cannot read
Private Const MMIOERR_CANNOTWRITE As Integer = (MMIOERR_BASE + 6) ' cannot write
Private Const MMIOERR_CANNOTSEEK As Integer = (MMIOERR_BASE + 7) ' cannot seek
Private Const MMIOERR_CANNOTEXPAND As Integer = (MMIOERR_BASE + 8) ' cannot expand file
Private Const MMIOERR_CHUNKNOTFOUND As Integer = (MMIOERR_BASE + 9) ' chunk not found
Private Const MMIOERR_UNBUFFERED As Integer = (MMIOERR_BASE + 10) '
Private Const MMIOERR_PATHNOTFOUND As Integer = (MMIOERR_BASE + 11) ' path incorrect
Private Const MMIOERR_ACCESSDENIED As Integer = (MMIOERR_BASE + 12) ' file was protected
Private Const MMIOERR_SHARINGVIOLATION As Integer = (MMIOERR_BASE + 13) ' file in use
Private Const MMIOERR_NETWORKERROR As Integer = (MMIOERR_BASE + 14) ' network not responding
Private Const MMIOERR_TOOMANYOPENFILES As Integer = (MMIOERR_BASE + 15) ' no more file handles
Private Const MMIOERR_INVALIDFILE As Integer = (MMIOERR_BASE + 16) ' default error file error


' bit field masks
Private Const MMIO_RWMODE As Integer = &H3 ' open file for reading/writing/both
Private Const MMIO_SHAREMODE As Integer = &H70 ' file sharing mode number

' constants for dwFlags field of MMIOINFO
Private Const MMIO_CREATE As Integer = &H1000 ' create new file (or truncate file)
Private Const MMIO_PARSE As Integer = &H100 ' parse new file returning path
Private Const MMIO_DELETE As Integer = &H200 ' create new file (or truncate file)
Private Const MMIO_EXIST As Integer = &H4000 ' checks for existence of file
Private Const MMIO_ALLOCBUF As Integer = &H10000 ' mmioOpen() should allocate a buffer
Private Const MMIO_GETTEMP As Integer = &H20000 ' mmioOpen() should retrieve temp name

Private Const MMIO_DIRTY As Integer = &H10000000 ' I/O buffer is dirty

' read/write mode numbers (bit field MMIO_RWMODE)
Private Const MMIO_READ As Integer = &H0 ' open file for reading only
Private Const MMIO_WRITE As Integer = &H1 ' open file for writing only
Private Const MMIO_READWRITE As Integer = &H2 ' open file for reading and writing

' share mode numbers (bit field MMIO_SHAREMODE)
Private Const MMIO_COMPAT As Integer = &H0 ' compatibility mode
Private Const MMIO_EXCLUSIVE As Integer = &H10 ' exclusive-access mode
Private Const MMIO_DENYWRITE As Integer = &H20 ' deny writing to other processes
Private Const MMIO_DENYREAD As Integer = &H30 ' deny reading to other processes
Private Const MMIO_DENYNONE As Integer = &H40 ' deny nothing to other processes

' various MMIO flags
Private Const MMIO_FHOPEN As Integer = &H10 ' mmioClose: keep file handle open
Private Const MMIO_EMPTYBUF As Integer = &H10 ' mmioFlush: empty the I/O buffer
Private Const MMIO_TOUPPER As Integer = &H10 ' mmioStringToFOURCC: to u-case
Private Const MMIO_INSTALLPROC As Integer = &H10000 ' mmioInstallIOProc: install MMIOProc
Private Const MMIO_GLOBALPROC As Integer = &H10000000 ' mmioInstallIOProc: install globally
Private Const MMIO_REMOVEPROC As Integer = &H20000 ' mmioInstallIOProc: remove MMIOProc
Private Const MMIO_UNICODEPROC As Integer = &H1000000 ' mmioInstallIOProc: Unicode MMIOProc
Private Const MMIO_FINDPROC As Integer = &H40000 ' mmioInstallIOProc: find an MMIOProc
Private Const MMIO_FINDCHUNK As Integer = &H10 ' mmioDescend: find a chunk by ID
Private Const MMIO_FINDRIFF As Integer = &H20 ' mmioDescend: find a LIST chunk
Private Const MMIO_FINDLIST As Integer = &H40 ' mmioDescend: find a RIFF chunk
Private Const MMIO_CREATERIFF As Integer = &H20 ' mmioCreateChunk: make a LIST chunk
Private Const MMIO_CREATELIST As Integer = &H40 ' mmioCreateChunk: make a RIFF chunk

' flags for mmioSeek()
Private Const SEEK_SET As Integer = 0 ' seek to an absolute position
Private Const SEEK_CUR As Integer = 1 ' seek relative to current position
Private Const SEEK_END As Integer = 2 ' seek relative to end of file

' other constants
Private Const MMIO_DEFAULTBUFFER As Integer = 8192

' flags for wFormatTag field of WAVEFORMAT
Private Const WAVE_FORMAT_PCM As Integer = 1

#End Region

#Region "Structures"

Private Structure Cue
Public ID As Integer ' ID for Label
Public Position As Integer ' sample offset
Public ChunckID As Integer ' always 'data'
Public ChunckStart As Integer
Public BlockStart As Integer
Public SampleOffset As Integer ' sample offset
End Structure

Private Structure CueLabel
Public ChunkID As Integer 'always "labl"
Public ChunckSize As Integer
Public CueID As Integer
Public Label As String
End Structure

Private Structure CueInfo
Public CueData As Cue
Public CueLabeled As CueLabel
End Structure

Private Structure CueLabelID
Private CueID As Integer
End Structure

<StructLayout(LayoutKind.Sequential)> _
Private Structure MMTIME
Public wType As Long
Public u As Long
Public x As Long
End Structure

'Note tried using IntPtr as lpNext and lpData and it freaked out, so I changed them to integers and that
' seemed to solve the problem
<StructLayoutAttribute(LayoutKind.Sequential)> _
Private Structure WAVEHDR
Public lpData As Integer ' pointer to locked data buffer
Public dwBufferLength As Integer ' length of data buffer
Public dwBytesRecorded As Integer ' used for input only
Public dwUser As Integer ' for client's use
Public dwFlags As Integer ' assorted flags (see defines)
Public dwLoops As Integer ' loop control counter
Public lpNext As Integer ' reserved for driver
Public reserved As Integer ' reserved for driver
End Structure

<StructLayoutAttribute(LayoutKind.Sequential)> _
Private Structure WAVEOUTCAPS
Public wMid As Short ' manufacturer ID
Public wPid As Short ' product ID
Public vDriverVersion As Integer ' version of the driver
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=MAXPNAMELEN)> _
Public szPname As String ' product name (NULL terminated string)
Public wformats As Integer ' formats supported
Public wChannels As Short ' number of sources supported
Public wReserved1 As Short ' packing
Public dwSupport As Integer ' functionality supported by driver
End Structure

<StructLayoutAttribute(LayoutKind.Sequential)> _
Private Structure WAVEINCAPS
Public wMid As Integer ' manufacturer ID
Public wPid As Integer ' product ID
Public vDriverVersion As Long ' version of the driver
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=MAXPNAMELEN)> _
Public szPname As String ' product name (NULL terminated string)
Public dwFormats As Long ' formats supported
Public wChannels As Integer ' number of channels supported
Public wReserved1 As Integer ' structure packing
End Structure

<StructLayoutAttribute(LayoutKind.Sequential)> _
Private Structure WAVEFORMAT
Public wFormatTag As Short ' format type
Public nChannels As Short ' number of channels (i.e. mono, stereo, etc.)
Public nSamplesPerSec As Integer ' sample rate
Public nAvgBytesPerSec As Integer ' for buffer estimation
Public nBlockAlign As Short ' block size of data
Public wBitsPerSample As Short ' number of bits per sample of mono data
End Structure

Private Structure pcmwaveformat
Private wf As WAVEFORMAT
Private wBitsPerSample As Short
End Structure
' extended waveform format structure used for all non-PCM formats. this
<StructLayoutAttribute(LayoutKind.Sequential)> _
Private Structure WAVEFORMATEX
Public wFormatTag As Short ' format type
Public nChannels As Short ' number of channels (i.e. mono, stereo...)
Public nSamplesPerSec As Integer ' sample rate
Public nAvgBytesPerSec As Integer ' for buffer estimation
Public nBlockAlign As Short ' block size of data
Public wBitsPerSample As Short ' number of bits per sample of mono data
Public cbSize As Short ' the count in bytes of the size of
End Structure

<StructLayoutAttribute(LayoutKind.Sequential)> _
Private Structure MMCKINFO
Public ckid As Integer ' chunk ID
Public cksize As Integer ' chunk size
Public fccType As Integer ' form type or list type
Public dwDataOffset As Integer ' offset of data portion of chunk
Public dwFlags As Integer ' flags used by MMIO functions
End Structure

<StructLayoutAttribute(LayoutKind.Sequential)> _
Private Structure MMIOINFO
Public dwFlags As Integer
Public fccIOProc As Integer
Public pIOProc As IntPtr
Public wErrorRet As Integer
Public hTask As IntPtr
Public pchBuffer As IntPtr
Public pchNext As IntPtr
Public pchEndRead As IntPtr
Public pchEndWrite As IntPtr
Public lBufOffset As Integer
Public lDiskOffset As Integer
Public adwInfo0 As Integer
Public adwInfo1 As Integer
Public adwInfo2 As Integer
Public adwInfo3 As Integer
Public dwReserved1 As Integer
Public dwReserved2 As Integer
Public hMMIO As IntPtr
End Structure
#End Region

#Region "CallBacks"
Private Delegate Sub waveOutProc(ByVal hwo As IntPtr, ByVal uMsg As Integer, ByVal dwInstance As Integer, ByVal dwParam1 As Integer, ByVal dwParam2 As Integer)
Private Delegate Sub waveInProc(ByVal hwi As IntPtr, ByVal uMsg As Integer, ByVal dwInstance As Integer, ByVal dwParam1 As Integer, ByVal dwParam2 As Integer)
#End Region

[lytamhoana6cntt]

#Region "MMIO Functions"
Private Declare Function mmioClose Lib "winmm.dll" (ByVal hmmio As IntPtr, ByVal uFlags As Integer) As Integer
Private Declare Function mmioOpen Lib "winmm.dll" Alias "mmioOpenA" (ByVal szFileName As String, ByRef lpmmioinfo As MMIOINFO, ByVal dwOpenFlags As Integer) As IntPtr
Private Declare Function mmioWrite Lib "winmm.dll" (ByVal hmmio As IntPtr, ByVal pch As IntPtr, ByVal cch As Integer) As Integer
Private Declare Function mmioStringToFOURCC Lib "winmm.dll" Alias "mmioStringToFOURCCA" (ByVal sz As String, ByVal uFlags As Integer) As Integer
Private Declare Function mmioAscend Lib "winmm.dll" (ByVal hmmio As IntPtr, ByRef lpck As MMCKINFO, ByVal uFlags As Integer) As Integer
Private Declare Function mmioCreateChunk Lib "winmm.dll" (ByVal hmmio As IntPtr, ByRef lpck As MMCKINFO, ByVal uFlags As Integer) As Integer
Private Declare Function mmioDescend Lib "winmm.dll" (ByVal hmmio As IntPtr, ByVal lpck As MMCKINFO, ByVal lpckParent As MMCKINFO, ByVal uFlags As Integer) As Integer
Private Declare Function mmioRead Lib "winmm.dll" (ByVal hmmio As IntPtr, ByVal pch As Integer, ByVal cch As Integer) As Integer
Private Declare Function mmioSeek Lib "winmm.dll" (ByVal hmmio As IntPtr, ByVal lOffset As Integer, ByVal iOrigin As Integer) As Integer
#End Region

#Region "Wave Out Functions"
Private Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Integer
Private Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveOutGetDevCapsA" (ByVal uDeviceID As Integer, ByRef pwoc As WAVEOUTCAPS, ByVal cbwoc As Integer) As Integer
Private Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Integer, ByVal lpdwVolume As Integer) As Integer
Private Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Integer, ByVal lpdwVolume As Integer) As Integer
Private Declare Function waveOutGetErrorText Lib "winmm.dll" Alias "waveOutGetErrorTextA" (ByVal mmrError As Long, ByRef pszText As String, ByVal cchText As Integer) As Integer
Private Declare Function waveOutOpen Lib "winmm.dll" (ByVal hWaveOut As IntPtr, ByVal uDeviceID As Integer, ByVal pwfx As WAVEFORMATEX, ByVal dwCallback As waveOutProc, ByVal dwCallbackInstance As Integer, ByVal dwFlags As Integer) As Integer
Private Declare Function waveOutClose Lib "winmm.dll" (ByVal hWaveOut As IntPtr) As Integer
Private Declare Function waveOutPrepareHeader Lib "winmm.dll" (ByVal hwo As Integer, ByVal pwh As WAVEHDR, ByVal cbwh As Integer) As Integer
Private Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hwo As IntPtr, ByVal pwh As WAVEHDR, ByVal cbwh As Integer) As Integer
Private Declare Function waveOutWrite Lib "winmm.dll" (ByVal hwo As IntPtr, ByVal pwh As WAVEHDR, ByVal cbwh As Integer) As Integer
Private Declare Function waveOutPause Lib "winmm.dll" (ByVal hwo As IntPtr) As Integer
Private Declare Function waveOutRestart Lib "winmm.dll" (ByVal hwo As IntPtr) As Integer
Private Declare Function waveOutReset Lib "winmm.dll" (ByVal hwo As IntPtr) As Integer
Private Declare Function waveOutBreakLoop Lib "winmm.dll" (ByVal hwo As IntPtr) As Integer
Private Declare Function waveOutGetPosition Lib "winmm.dll" (ByVal hwo As IntPtr, ByVal pmmt As MMTIME, ByVal cbmmt As Integer) As Integer
Private Declare Function waveOutGetPitch Lib "winmm.dll" (ByVal hwo As IntPtr, ByVal ptrPitch As Integer) As Integer
Private Declare Function waveOutSetPitch Lib "winmm.dll" (ByVal hwo As IntPtr, ByVal ptrPitch As Integer) As Integer
Private Declare Function waveOutGetPlaybackRate Lib "winmm.dll" (ByVal hwo As IntPtr, ByVal ptrRate As Integer) As Integer
Private Declare Function waveOutSetPlaybackRate Lib "winmm.dll" (ByVal hwo As IntPtr, ByVal ptrRate As Integer) As Integer
#End Region

#Region "Wave In Functions"
Private Declare Function waveInGetNumDevs Lib "winmm.dll" () As Integer
Private Declare Function waveInGetDevCaps Lib "winmm.dll" Alias "waveInGetDevCapsA" (ByVal uDeviceID As Integer, ByRef ptrwic As WAVEINCAPS, ByVal cbwic As Integer) As IntPtr
Private Declare Function waveInGetErrorText Lib "winmm.dll" (ByVal mmrError As Integer, ByRef pszText As String, ByVal cchText As Integer) As Integer
Private Declare Function waveInOpen Lib "winmm.dll" (ByRef phwi As IntPtr, ByVal uDeviceID As Integer, ByRef ptrwfx As WAVEFORMATEX, ByVal dwCallback As waveInProc, ByVal dwInstance As Integer, ByVal fdwOpen As Integer) As Integer
Private Declare Function waveInClose Lib "winmm.dll" (ByVal hwi As IntPtr) As Long
Private Declare Function waveInPrepareHeader Lib "winmm.dll" (ByVal hwi As IntPtr, ByRef pwh As WAVEHDR, ByVal cbwh As Integer) As Integer
Private Declare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal hwi As IntPtr, ByVal pwh As WAVEHDR, ByVal cbwh As Integer) As Integer
Private Declare Function waveInAddBuffer Lib "winmm.dll" (ByVal hwi As IntPtr, ByRef pwh As WAVEHDR, ByVal cbwh As Integer) As Integer
Private Declare Function waveInStart Lib "winmm.dll" (ByVal hwi As IntPtr) As Integer
Private Declare Function waveInStop Lib "winmm.dll" (ByVal hwi As IntPtr) As Integer
Private Declare Function waveInReset Lib "winmm.dll" (ByVal hwi As IntPtr) As Integer
Private Declare Function waveInGetPosition Lib "winmm.dll" (ByVal hwi As IntPtr, ByRef pmmt As MMTIME, ByVal cbmmt As Integer) As Integer
Private Declare Function waveInGetID Lib "winmm.dll" (ByVal hwi As IntPtr, ByVal puDeviceID As Integer) As Integer
#End Region

#Region "Private Members"
Private m_pMMIOHandle As IntPtr
Private m_waveFrmt As WAVEFORMATEX
Private m_nBufferRecordingSize As Integer 'Size of Buffers to accept Wave Form Data
Private m_waveHeaders(BUFFERS) As WAVEHDR 'Headers
Private m_mmInfoRecord As MMIOINFO
Private m_pWaveIn As IntPtr

Private m_mmckinfoRiffRecord As MMCKINFO 'Chunck info for Riff
Private m_mmckinfoFormatRecord As MMCKINFO 'Chunck info for Format
Private m_mmckinfoDataRecord As MMCKINFO 'Chunck info for Data
Private m_mmckinfoCueRecord As MMCKINFO 'Chunck info for Cue
Private m_mmckinfoLabelRecord As MMCKINFO 'Chunck info for Labels

Private m_nInternalError As Integer
Private m_nSampleOffsetRecord As Integer
Private m_colMarkers As Collection
Private m_fRecording As Boolean
#End Region

#Region "Enumerations"


Public Enum InternalError
errCouldNotOpenFile
errWaveChunckFailed
errCouldNotCreateFormat
errFailedToAddFormatInformation
errFailedToAscendOutOfFormatChunck
errCouldNotCreatDataChunck
errFailedToAscendOutOfDataChunck
errFailedToAscendOutOfRiffChunck
errWaveDeviceCouldNotOpen
errWaveDeviceCouldPrepareHeaders
errWaveDeviceCouldAddBufferIntoCue
errCouldNotStartRecording
End Enum

Public Enum RecordingType
Mono = 1
Stereo = 2
End Enum

Public Enum BitResolutionType
EightBit = 8
SixteenBit = 16
End Enum

Public Enum SampleRate
SampleRate8000Bps = 8000
SampleRate11025Bps = 11025
SampleRate22050Bps = 22050
SampleRate44100Bps = 44100
End Enum
#End Region

#Region "Public Methods"

Public Function PlayBackDevices() As String()
Dim nNumDevices As Integer = waveOutGetNumDevs

If nNumDevices = 0 Then
Return Nothing
End If

Dim colDeviceList As New Collection
Dim nDeviceCounter As Integer
Dim woc As WAVEOUTCAPS = Nothing

For nDeviceCounter = 0 To nNumDevices - 1
waveOutGetDevCaps(nDeviceCounter, woc, Marshal.SizeOf(woc))
Dim sDevice As String = woc.szPname
colDeviceList.Add(sDevice)
Next

Dim sReturn As String()
ReDim sReturn(colDeviceList.Count - 1)
Dim nCount As Integer

For nCount = 1 To colDeviceList.Count
sReturn(nCount - 1) = CStr(colDeviceList.Item(nCount))
Next

Return sReturn
End Function

Public Function RecordingDevices() As String()
Dim nNumDevices As Integer = waveInGetNumDevs

If nNumDevices = 0 Then
Return Nothing
End If

Dim colDeviceList As New Collection
Dim nDeviceCounter As Integer
Dim wic As WAVEINCAPS = Nothing

For nDeviceCounter = 0 To nNumDevices - 1
waveInGetDevCaps(nDeviceCounter, wic, Marshal.SizeOf(wic))
Dim sDevice As String = wic.szPname
colDeviceList.Add(sDevice)
Next

Dim sReturn As String()
ReDim sReturn(colDeviceList.Count - 1)
Dim nCount As Integer

For nCount = 1 To colDeviceList.Count
sReturn(nCount - 1) = CStr(colDeviceList.Item(nCount))
Next

Return sReturn
End Function

Public Function Record(ByVal DeviceID As Integer, ByVal sFile As String, ByVal smplRt As SampleRate, ByVal RecType As RecordingType, ByVal BitRes As BitResolutionType) As Integer
Dim rc As Integer
'Dim nCounter As Integer

If m_fRecording = True Then Return 1
m_nSampleOffsetRecord = 0
m_nInternalError = -1

m_colMarkers = New Collection

'Create a Wave Format Structure and populate it
m_waveFrmt.wBitsPerSample = CShort(BitRes)
m_waveFrmt.wFormatTag = 1
m_waveFrmt.nChannels = CShort(RecType)
m_waveFrmt.nSamplesPerSec = smplRt
m_waveFrmt.nBlockAlign = CShort(m_waveFrmt.nChannels * m_waveFrmt.wBitsPerSample / 8)
m_waveFrmt.nAvgBytesPerSec = m_waveFrmt.nSamplesPerSec * m_waveFrmt.nBlockAlign
m_nBufferRecordingSize = CInt(m_waveFrmt.nAvgBytesPerSec / (BUFFERS + 1))

OpenWaveRecordingDevice(DeviceID)
If m_nInternalError <> -1 Then
Return m_nInternalError
End If

OpenFile(sFile)
'Check to see if an Error was generated
If m_nInternalError <> -1 Then
Return m_nInternalError
End If

rc = waveInStart(m_pWaveIn)
If rc <> 0 Then
Return InternalError.errCouldNotStartRecording
End If
m_fRecording = True

End Function

Public Sub StopRecording()
Dim nCount As Integer
Dim rc As Integer

If m_fRecording = False Then Exit Sub

rc = waveInStop(m_pWaveIn)
m_fRecording = False

If rc <> 0 Then
Debug.WriteLine("Huh")
End If

'Free the Buffer Resources so we do not have any Memory Leaks
For nCount = 0 To BUFFERS
Dim pMem As New IntPtr(m_waveHeaders(nCount).lpData)
Marshal.FreeHGlobal(pMem)
Next

CloseFile()

End Sub

Public Sub AddMarker(ByVal sCue As String)

Dim cueif As CueInfo
'Add a Cue to the Collection
With cueif.CueData
.ID = m_colMarkers.Count + 1
.Position = CInt(m_nSampleOffsetRecord / m_waveFrmt.nBlockAlign)
.ChunckID = mmioStringToFOURCC("data", 0)
.ChunckStart = 0
.BlockStart = 0
.SampleOffset = .Position
End With
'Debug.WriteLine("Marker added at " & cueif.CueData.Position)

'Adds the Label to the Cue.
With cueif.CueLabeled
.ChunkID = mmioStringToFOURCC("labl", 0)
.ChunckSize = Len(sCue)
.CueID = m_colMarkers.Count + 1
.Label = sCue
End With

m_colMarkers.Add(cueif)

End Sub

#End Region

#Region "Private Methods"

Private Sub OpenWaveRecordingDevice(ByVal DeviceID As Integer)
Dim rc As Integer
Dim nCounter As Integer

'rc = waveInOpen(m_pWaveIn, WAVE_MAPPER, m_waveFrmt, New waveInProc(AddressOf WaveIn), 0, CALLBACK_FUNCTION)
rc = waveInOpen(m_pWaveIn, DeviceID, m_waveFrmt, New waveInProc(AddressOf WaveIn), 0, CALLBACK_FUNCTION)
If rc <> 0 Then
m_nInternalError = InternalError.errWaveDeviceCouldNotOpen
Exit Sub
End If
GC.KeepAlive(m_pWaveIn)
'Create the Buffers for the Recording
For nCounter = 0 To BUFFERS
GC.KeepAlive(m_waveHeaders(nCounter))
m_waveHeaders(nCounter).dwBufferLength = m_nBufferRecordingSize
m_waveHeaders(nCounter).dwFlags = 0
m_waveHeaders(nCounter).dwLoops = 0
m_waveHeaders(nCounter).lpData = Marshal.AllocHGlobal(m_nBufferRecordingSize).ToInt 32
Next nCounter

'Prepare the Headers(in other words the Buffers) for recording this call links them together
For nCounter = 0 To BUFFERS
rc = waveInPrepareHeader(m_pWaveIn, m_waveHeaders(nCounter), Len(m_waveHeaders(nCounter)))
If rc <> 0 Then
m_nInternalError = InternalError.errWaveDeviceCouldPrepareHeaders
Exit Sub
End If
Next nCounter

'This call sends the Buffers to the Sound Cardii
For nCounter = 0 To BUFFERS
rc = waveInAddBuffer(m_pWaveIn, m_waveHeaders(nCounter), Len(m_waveHeaders(nCounter)))
If rc <> 0 Then
m_nInternalError = InternalError.errWaveDeviceCouldAddBufferIntoCue
Exit Sub
End If
Next nCounter

End Sub

Private Sub WaveIn(ByVal hwi As IntPtr, ByVal uMsg As Integer, ByVal dwInstance As Integer, ByVal dwParam1 As Integer, ByVal dwParam2 As Integer)
Dim rc As Integer
Debug.WriteLine(m_nSampleOffsetRecord)
Select Case uMsg
Case MM_WIM_OPEN
Case MM_WIM_DATA
Dim nCount As Integer
For nCount = 0 To BUFFERS
If m_waveHeaders(nCount).dwFlags = 3 Then
Dim pMem As New IntPtr(m_waveHeaders(nCount).lpData)
rc = mmioWrite(m_pMMIOHandle, pMem, m_nBufferRecordingSize)
rc = waveInAddBuffer(m_pWaveIn, m_waveHeaders(nCount), Len(m_waveHeaders(nCount)))
m_nSampleOffsetRecord += m_nBufferRecordingSize
End If
Next
Case MM_WIM_CLOSE
End Select
End Sub

Private Sub OpenFile(ByVal sFile As String)
Dim rc As Integer
'Creates a wave file for writing
m_pMMIOHandle = mmioOpen(sFile, m_mmInfoRecord, MMIO_CREATE + MMIO_WRITE)
GC.KeepAlive(m_pMMIOHandle)

If IntPtr.Zero.Equals(m_pMMIOHandle) Then
m_nInternalError = InternalError.errCouldNotOpenFile
Exit Sub
End If

'Create the RIFF Chunk
m_mmckinfoRiffRecord.fccType = mmioStringToFOURCC("WAVE", 0)
rc = mmioCreateChunk(m_pMMIOHandle, m_mmckinfoRiffRecord, MMIO_CREATERIFF)
If (rc <> 0) Then
mmioClose(m_pMMIOHandle, 0)
m_nInternalError = InternalError.errWaveChunckFailed
Exit Sub
End If

'Create the Fmt Chunk
m_mmckinfoFormatRecord.ckid = mmioStringToFOURCC("fmt", 0)
m_mmckinfoFormatRecord.cksize = Len(m_waveFrmt)
rc = mmioCreateChunk(m_pMMIOHandle, m_mmckinfoFormatRecord, 0)
If (rc <> 0) Then
mmioClose(m_pMMIOHandle, 0)
m_nInternalError = InternalError.errFailedToAddFormatInformation
Exit Sub
End If
Dim pWaveFormat As IntPtr
pWaveFormat = Marshal.AllocHGlobal(Len(m_waveFrmt))
Marshal.StructureToPtr(m_waveFrmt, pWaveFormat, True)
rc = mmioWrite(m_pMMIOHandle, pWaveFormat, Len(m_waveFrmt))
Marshal.FreeHGlobal(pWaveFormat)
If (rc <> Len(m_waveFrmt)) Then
mmioClose(m_pMMIOHandle, 0)
m_nInternalError = InternalError.errCouldNotCreateFormat
Exit Sub
End If

rc = mmioAscend(m_pMMIOHandle, m_mmckinfoFormatRecord, 0)
If (rc <> 0) Then
mmioClose(m_pMMIOHandle, 0)
m_nInternalError = InternalError.errFailedToAscendOutOfFormatChunck
Exit Sub
End If

'Create Data Chunk which should not ascend until the end of recording
m_mmckinfoDataRecord.ckid = mmioStringToFOURCC("data", 0)
If (mmioCreateChunk(m_pMMIOHandle, m_mmckinfoDataRecord, 0) <> 0) Then
mmioClose(m_pMMIOHandle, 0)
m_nInternalError = InternalError.errCouldNotCreatDataChunck
Exit Sub
End If
End Sub

Private Sub CloseFile()
Dim rc As Integer
'Dim nCount As Integer
rc = mmioAscend(m_pMMIOHandle, m_mmckinfoDataRecord, 0)
If (rc <> 0) Then
mmioClose(m_pMMIOHandle, 0)
m_nInternalError = InternalError.errFailedToAscendOutOfDataChunck
Debug.WriteLine("Did Close Data Chunck")
End If

If m_colMarkers.Count <> 0 Then
m_mmckinfoCueRecord.ckid = mmioStringToFOURCC("cue", 0)

rc = mmioCreateChunk(m_pMMIOHandle, m_mmckinfoCueRecord, 0)
If (rc <> 0) Then
Debug.WriteLine("Did not make Cue Chunck")
End If

Dim pNumberOfCues As IntPtr
pNumberOfCues = Marshal.AllocHGlobal(4)
Marshal.WriteInt32(pNumberOfCues, m_colMarkers.Count)
rc = mmioWrite(m_pMMIOHandle, pNumberOfCues, 4)
Marshal.FreeHGlobal(pNumberOfCues)

Dim cueinf As CueInfo
For Each cueinf In m_colMarkers
Dim pCue As IntPtr
pCue = Marshal.AllocHGlobal(Len(cueinf.CueData))
Marshal.StructureToPtr(cueinf.CueData, pCue, True)
rc = mmioWrite(m_pMMIOHandle, pCue, Len(cueinf.CueData))
Marshal.FreeHGlobal(pCue)
Next
rc = mmioAscend(m_pMMIOHandle, m_mmckinfoCueRecord, 0)

m_mmckinfoLabelRecord.ckid = mmioStringToFOURCC("list", 0)

m_mmckinfoLabelRecord.fccType = mmioStringToFOURCC("adtl", 0)

rc = mmioCreateChunk(m_pMMIOHandle, m_mmckinfoLabelRecord, MMIO_CREATELIST)
If (rc <> 0) Then
mmioClose(m_pMMIOHandle, 0)
End If

For Each cueinf In m_colMarkers
Dim mmckLabel As MMCKINFO
Dim pLen As IntPtr
Dim nLabelSize As Integer

pLen = Marshal.AllocHGlobal(4)
nLabelSize = mmioStringToFOURCC("labl", 0)
Marshal.WriteInt32(pLen, nLabelSize)
rc = mmioWrite(m_pMMIOHandle, pLen, Len(mmckLabel.fccType))
Marshal.FreeHGlobal(pLen)


If Len(cueinf.CueLabeled.Label) Mod 2 <> 0 Then
nLabelSize = Len(cueinf.CueLabeled.Label) + 1 + 4
Else
nLabelSize = Len(cueinf.CueLabeled.Label) + 2 + 4
End If

pLen = Marshal.AllocHGlobal(4)
Marshal.WriteInt32(pLen, nLabelSize)
rc = mmioWrite(m_pMMIOHandle, pLen, Len(nLabelSize))
Marshal.FreeHGlobal(pLen)

pLen = Marshal.AllocHGlobal(4)
Marshal.WriteInt32(pLen, cueinf.CueLabeled.CueID)
rc = mmioWrite(m_pMMIOHandle, pLen, Len(cueinf.CueLabeled.CueID))
Marshal.FreeHGlobal(pLen)

Dim pLabel As IntPtr
If Len(cueinf.CueLabeled.Label) Mod 2 <> 0 Then
cueinf.CueLabeled.Label = cueinf.CueLabeled.Label & Chr(0)
pLabel = Marshal.StringToHGlobalAnsi(cueinf.CueLabeled.Labe l)
rc = mmioWrite(m_pMMIOHandle, pLabel, (Len(cueinf.CueLabeled.Label)))
Else
pLabel = Marshal.StringToHGlobalAnsi(cueinf.CueLabeled.Labe l)
rc = mmioWrite(m_pMMIOHandle, pLabel, (Len(cueinf.CueLabeled.Label)))
End If

Next

rc = mmioAscend(m_pMMIOHandle, m_mmckinfoLabelRecord, 0)

End If


rc = mmioAscend(m_pMMIOHandle, m_mmckinfoRiffRecord, 0)
If (rc <> 0) Then
mmioClose(m_pMMIOHandle, 0)
m_nInternalError = InternalError.errFailedToAscendOutOfRiffChunck
End If

mmioClose(m_pMMIOHandle, 0)
End Sub

#End Region

End Class


Và gọi thực thi lệnh Record:

lRef = WaveInRecord.Record(cmbDevices.SelectedIndex, (New clsCommons).App_Path & "temp.wav", clsWaveIn.SampleRate.SampleRate11025Bps, clsWaveIn.RecordingType.Mono, clsWaveIn.BitResolutionType.SixteenBit)


Thì báo lỗi sau


A callback was made on a garbage collected delegate of type 'ConsonantPro!ConsonantPro.clsWaveIn+waveInProc::I nvoke'. This may cause application crashes, corruption and data loss. When passing delegates to unmanaged code, they must be kept alive by the manage
Các bạn có thể chỉ giúp mình với

[lytamhoana6cntt]

ơ hơ ko ai bit về vấn đề này ah :((