VB录音API类 X64位

Imports System.Runtime.InteropServices
Imports System.IO
Imports System.Threading




'使用步骤：


'1.声明
' Dim waverecord As New WaveRecordApi




'2.定义录音数据到达回调函数
'    Public Function DataArrive(lpdata As Byte(), datalen As Integer)
'    If WaveDataLength >= 6400 * 10 Then
'        Exit Function
'    End If
'    lpdata.CopyTo（WaveDataBuffer, WaveDataLength)
'    WaveDataLength = WaveDataLength + datalen
'End Function


'3.开始录音
' waverecord.Start(AddressOf DataArrive)


'4.结束录音
' waverecord.Close()




#Const _Debug = 0  '调试信息
#Const _WriteFile = 0 '写入文件否






Public Class WaveRecordApi




#Region "wave定义结构与声明"






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


    Private Const WAVE_MAPPER As Integer = -1
    Private Const WAVE_FORMAT_PCM As Integer = 1
    Private Const MMSYSERR_NOERROR As Integer = 0


    '所有的引用地址 函数查询 PINVOKE网址
    '录音
    Delegate Sub CallBackFUN(<MarshalAs(UnmanagedType.I4)> ByVal hwi As Integer, ByVal uMsg As WIMMessages, ByVal dwInstance As IntPtr, ByVal dwParam1 As IntPtr, ByVal dwParam2 As IntPtr)
    Private Declare Function waveInOpen Lib "winmm.dll" (ByRef phwi As IntPtr, ByVal uDeviceID As IntPtr, ByRef pwfx As WAVEFORMATEX,
          ByVal dwCallback As CallBackFUN, ByVal dwCallbackInstance As IntPtr, ByVal fdwOpen As WaveInOpenFlags) As MMRESULT
    Private Declare Function waveInOpen Lib "winmm.dll" (ByRef phwi As IntPtr, ByVal uDeviceID As IntPtr, ByRef pwfx As WAVEFORMATEX,
        ByVal dwCallback As IntPtr, ByVal dwCallbackInstance As IntPtr, ByVal fdwOpen As WaveInOpenFlags) As MMRESULT
    Declare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal hwi As IntPtr, ByRef pwh As WAVEHDR, ByVal cbwh As UInteger) As MMRESULT
    Declare Function waveInReset Lib "winmm.dll" (ByVal hwi As IntPtr) As MMRESULT
    Private Declare Function waveInUnprepareHeader Lib "winmm.dll" _
        (ByVal hWaveIn As Integer, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As Integer) As MMRESULT
    Private Declare Function waveInPrepareHeader Lib "winmm.dll" _
        (ByVal hWaveIn As IntPtr, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As Integer) As Integer


    Private Declare Function waveInPrepareHeader Lib "winmm.dll" _
        (ByVal hWaveIn As IntPtr, lpWaveInHdr As IntPtr, ByVal uSize As Integer) As Integer


    Private Declare Function waveInStart Lib "winmm.dll" (ByVal hWaveIn As IntPtr) As MMRESULT
    Private Declare Function waveInStop Lib "winmm.dll" (ByVal hWaveIn As IntPtr) As Integer
    Private Declare Function waveInClose Lib "winmm.dll" (ByVal hWaveIn As IntPtr) As Integer
    Private Declare Function waveInAddBuffer Lib "winmm.dll" _
(ByVal hwi As IntPtr, pwh As IntPtr, ByVal cbwh As UInteger) As MMRESULT
    Private Declare Function waveInAddBuffer Lib "winmm.dll" _
(ByVal hwi As IntPtr, ByRef pwh As WAVEHDR, ByVal cbwh As UInteger) As MMRESULT


    '播放
    Private Declare Function waveOutBreakLoop Lib "winmm.dll" (ByVal hWaveOut As Integer) As Integer
    Private Declare Function waveOutClose Lib "winmm.dll" (ByVal hWaveOut As Integer) As Integer
    Private Declare Function waveOutPrepareHeader Lib "winmm.dll" (ByVal hWaveOut As Integer, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Integer) As Integer
    Private Declare Function waveOutOpen Lib "winmm.dll" (ByRef phwi As IntPtr, ByVal uDeviceID As IntPtr, ByRef pwfx As WAVEFORMATEX,
          dwCallback As IntPtr, ByVal dwCallbackInstance As IntPtr, ByVal fdwOpen As WaveInOpenFlags) As MMRESULT
    Private Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveOut As Integer, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Integer) As Integer
    Private Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Integer, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Integer) As Integer
    Private Declare Function waveOutReset Lib "winmm.dll" (ByVal hWaveOut As Integer) As Integer








#End Region


#Region "线程与消息的定义"
    <StructLayout(LayoutKind.Sequential)>
    Public Structure NativeMessage
        Public handle As IntPtr
        Public msg As UInteger
        Public wParam As IntPtr
        Public lParam As IntPtr
        Public time As UInteger
        Public p As System.Drawing.Point
    End Structure


    Public Declare Function GetMessage Lib "user32" Alias "GetMessageA" (ByRef lpMsg As NativeMessage, ByVal hwnd As Integer, ByVal wMsgFilterMin As Integer, ByVal wMsgFilterMax As Integer) As Integer
    Public Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (ByRef message As NativeMessage, ByVal handle As IntPtr,
 ByVal filterMin As UInteger, ByVal filterMax As UInteger, ByVal flags As UInteger) _
 As <MarshalAs(UnmanagedType.Bool)> Boolean


#Const _win64 = 1
#If _win32 Then


    Delegate Function delgwaveThread(lparam As IntPtr) As Integer
    Public Declare Function CreateThread Lib "kernel32.dll" (ByRef lpThreadAttributes As Integer, _
        dwStackSize As Integer, lpStartAddress As delgwaveThread, ByRef lpParameter As Integer, _
   dwCreationFlags As Integer, ByRef lpThreadId As Integer) As Integer


#ElseIf _win64 Then
    Delegate Sub delgwaveThread()
    Public Declare Function CreateThread Lib "kernel32.dll" (ByRef lpThreadAttributes As Int64,
        dwStackSize As Int64, lpStartAddress As delgwaveThread, ByRef lpParameter As Int64,
   dwCreationFlags As Int64, ByRef lpThreadId As Int64) As Int64
#End If


#End Region


    Public Shared BUFFSIZE As Integer = 6400  '缓存区大小
    Shared BUFFCount As Integer = 3




    '添加回调函数
    Delegate Sub Delg_DataArriva(lpdata As Byte(), len As Integer)


#Region "线程式回调函数"


    Private ThreadId As Integer = 0


    Dim tmpBuf(BUFFSIZE) As Byte
    Dim msg As NativeMessage
    Dim S1 As WAVEHDR


    'THREAD线程回调函数
    <STAThread>
    Private Sub waveThread()




        '   Monitor.Enter(Me)


        Dim bRet As Boolean
        ThreadId = AppDomain.GetCurrentThreadId()


        While True
            bRet = GetMessage(msg, vbNull, 0, 0)
            Select Case msg.msg
                Case MM_WIM_CLOSE
                    Debug.Print("CLOSE")
                Case MM_WIM_DATA


                    If (luyin = False) Then
                        Exit Select
                    End If


                    S1 = Marshal.PtrToStructure(msg.lParam, GetType(WAVEHDR))


                    If (S1.dwUser > 0 And S1.dwUser < BUFFCount + 2) Then
                        If (Not dataArriva Is Nothing) Then


                            dataArriva(WaveBuff(S1.dwUser - 1).Buf, S1.dwBytesRecorded)
                        End If


                        Debug.Print(S1.dwUser.ToString)


                        res = waveInAddBuffer(hWaveIn, waveHdrList(S1.dwUser - 1), Marshal.SizeOf(S1))  'WHDR1
                    End If
                    If (res <> 0) Then
                        Debug.Print("waveInAddBuffer " & CType(res, MMRESULT).ToString("g"))
                    End If






                    Exit Select
                Case MM_WIM_OPEN
                    Debug.Print("wim open" & Now.Millisecond)


                    Exit Select
            End Select
        End While
        '    Monitor.Exit(Me)
    End Sub




#End Region




    Dim luyin As Boolean = False
    Dim res As Integer
    Dim hWaveIn As IntPtr
    Dim udtWFX As WAVEFORMATEX


    Dim T1 As Thread






    Structure WBuf
        ' <MarshalAs(UnmanagedType.ByValArray, SizeConst:=6400)>
        Dim Buf() As Byte
    End Structure


    Dim waveHdrList(BUFFCount) As WAVEHDR
    Dim WaveBuff(BUFFCount) As WBuf






    '录音结构初始化
    Public Sub New()




        ' GCHandle.Alloc(hWaveIn, GCHandleType.Pinned)
        With udtWFX
            .wFormatTag = WAVE_FORMAT_PCM
            .nChannels = 1
            .nSamplesPerSec = 16000
            .nAvgBytesPerSec = 32000
            .nBlockAlign = 2
            .wBitsPerSample = 16
            .cbSize = 0
        End With




        '定义缓冲区


        For i As Integer = 0 To BUFFCount
            ReDim WaveBuff(i).Buf(BUFFSIZE)
            With waveHdrList(i)
                .lpData = GCHandle.Alloc(WaveBuff(i).Buf, GCHandleType.Pinned).AddrOfPinnedObject
                .dwBufferLength = BUFFSIZE
                .dwUser = i + 1
                .dwFlags = 0
                '   .dwLoops = 1
            End With
        Next


        hWaveIn = IntPtr.Zero


        T1 = New Thread(New ThreadStart(AddressOf waveThread))
        T1.Name = "WaveThread"
        T1.Start()
        Thread.Sleep(100)




        res = waveInOpen(hWaveIn, WAVE_MAPPER, udtWFX, ThreadId, 0, WaveInOpenFlags.CALLBACK_THREAD)  '线程式调用回调函数THREAD
        If res <> MMSYSERR_NOERROR Then
            Debug.Print("WAVE IN OPEN " & CType(res, MMRESULT).ToString("G"))
            Exit Sub
        End If




        For i = 0 To BUFFCount
            Debug.Print(i.ToString)
            res = waveInPrepareHeader(hWaveIn, waveHdrList(i), Marshal.SizeOf(GetType(WAVEHDR)))
            If res <> MMSYSERR_NOERROR Then
                Debug.Print("WAVE IN OPEN " & CType(res, MMRESULT).ToString("G"))
                Exit Sub
            End If
        Next




        GCHandle.Alloc(Me)


    End Sub




    '回调函数
    Dim dataArriva As Delg_DataArriva
    '开始录音 
    Public Sub Start(dataArri As Delg_DataArriva)
        dataArriva = dataArri


        Debug.Print(Now.ToShortTimeString)


        luyin = True


        '打开录音设备
        ' 准备数据结构()
        For i = 0 To BUFFCount


            res = waveInAddBuffer(hWaveIn, waveHdrList(i), Marshal.SizeOf(GetType(WAVEHDR)))
            If res <> MMSYSERR_NOERROR Then
                Debug.Print("waveinAddbuff error" & res.ToString)
            End If
        Next




        res = waveInStart(hWaveIn)
        If res <> MMSYSERR_NOERROR Then


            Debug.Print("WAVE INSTART" & res.ToString)
            waveInClose(hWaveIn)
            hWaveIn = 0


            Exit Sub
        End If


    End Sub






    '结束录音 
    Public Sub Close()  '未关闭线程 ，为下次录音做准备
        luyin = False
        res = waveInReset(hWaveIn)  '会触发WM_DATA 事件 然后产生死锁  使用luyin标志在回调函数中 判断是否关闭
    End Sub








#Region "WAVE文件保存"


    Public Enum WIMMessages As UInteger
        WIM_DATA = &H3C0
        WIM_OPEN = &H3BE
        WIM_CLOSE = &H3BF
    End Enum


    Public Structure WAVEHDR
        Dim lpData As IntPtr
        Dim dwBufferLength As Integer
        Dim dwBytesRecorded As Integer
        Dim dwUser As Integer
        Dim dwFlags As WaveHdrFlags
        Dim dwLoops As Integer
        Dim lpNext As IntPtr
        Dim reserved As IntPtr
    End Structure




    <Flags()>
    Public Enum WaveHdrFlags As UInteger
        WHDR_DONE = 1
        WHDR_PREPARED = 2
        WHDR_BEGINLOOP = 4
        WHDR_ENDLOOP = 8
        WHDR_INQUEUE = 16
    End Enum


    Public Structure WAVEFORMATEX
        Dim wFormatTag As Short  'SHORT 非INTEGER
        Dim nChannels As Short
        Dim nSamplesPerSec As Integer
        Dim nAvgBytesPerSec As Integer
        Dim nBlockAlign As Short
        Dim wBitsPerSample As Short
        Dim cbSize As Short
    End Structure




    Public Enum WaveInOpenFlags As UInteger
        CALLBACK_NULL = 0
        CALLBACK_FUNCTION = &H30000
        CALLBACK_EVENT = &H50000
        CALLBACK_WINDOW = &H10000
        CALLBACK_THREAD = &H20000
        WAVE_FORMAT_QUERY = 1
        WAVE_MAPPED = 4
        WAVE_FORMAT_DIRECT = 8
    End Enum




    Public Structure WAVEFORMAT
        Dim wFormatTag As Integer
        Dim nChannels As Integer
        Dim nSamplesPerSec As Integer
        Dim nAvgBytesPerSec As Integer
        Dim nBlockAlign As Integer
    End Structure




    Public Enum MMRESULT
        MMSYSERR_NOERROR = 0
        MMSYSERR_ERROR = 1
        MMSYSERR_BADDEVICEID = 2
        MMSYSERR_NOTENABLED = 3
        MMSYSERR_ALLOCATED = 4
        MMSYSERR_INVALHANDLE = 5
        MMSYSERR_NODRIVER = 6
        MMSYSERR_NOMEM = 7
        MMSYSERR_NOTSUPPORTED = 8
        MMSYSERR_BADERRNUM = 9
        MMSYSERR_INVALFLAG = 10
        MMSYSERR_INVALPARAM = 11
        MMSYSERR_HANDLEBUSY = 12
        MMSYSERR_INVALIDALIAS = 13
        MMSYSERR_BADDB = 14
        MMSYSERR_KEYNOTFOUND = 15
        MMSYSERR_READERROR = 16
        MMSYSERR_WRITEERROR = 17
        MMSYSERR_DELETEERROR = 18
        MMSYSERR_VALNOTFOUND = 19
        MMSYSERR_NODRIVERCB = 20
        WAVERR_BADFORMAT = 32
        WAVERR_STILLPLAYING = 33
        WAVERR_UNPREPARED = 34
    End Enum






#End Region






End Class










'StartRecord = True
'waveInOpen()
'waveInPrepareHeader()
'waveInAddBuffer()
'waveInStart()
'waveInClose()
'函数定义未正确 PINVOKE网站上正确
' Public Declare Function waveInGetDevCaps Lib "winmm.dll" Alias "waveInGetDevCapsA" (ByVal uDeviceID As Integer, lpCaps As WAVEINCAPS, ByVal uSize As Integer) As Integer
'Public Declare Function waveInGetErrorText Lib "winmm.dll" Alias "waveInGetErrorTextA" (ByVal err As Integer, ByVal lpText As String, ByVal uSize As Integer) As Integer
' Public Declare Function waveInGetID Lib "winmm.dll" (ByVal hWaveIn As Integer, lpuDeviceID As Integer) As Integer
'  Public Declare Function waveInGetNumDevs Lib "winmm.dll" () As Integer
'  Public Declare Function waveInGetPosition Lib "winmm.dll" (ByVal hWaveIn As Integer, lpInfo As MMTIME, ByVal uSize As Integer) As Integer
' Public Declare Function waveInMessage Lib "winmm.dll" (ByVal hWaveIn As Integer, ByVal msg As Integer, ByVal dw1 As Integer, ByVal dw2 As Integer) As Integer


' Public Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveOutGetDevCapsA" (ByVal uDeviceID As Integer, lpCaps As WAVEOUTCAPS, ByVal uSize As Integer) As Integer
' Public Declare Function waveOutGetErrorText Lib "winmm.dll" Alias "waveOutGetErrorTextA" (ByVal err As Integer, ByVal lpText As String, ByVal uSize As Integer) As Integer
' Public Declare Function waveOutGetID Lib "winmm.dll" (ByVal hWaveOut As Integer, lpuDeviceID As Integer) As Integer
' Public Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Integer
' Public Declare Function waveOutGetPitch Lib "winmm.dll" (ByVal hWaveOut As Integer, lpdwPitch As Integer) As Integer
' Public Declare Function waveOutGetPlaybackRate Lib "winmm.dll" (ByVal hWaveOut As Integer, lpdwRate As Integer) As Integer
' Public Declare Function waveOutGetPosition Lib "winmm.dll" (ByVal hWaveOut As Integer, lpInfo As MMTIME, ByVal uSize As Integer) As Integer
' Public Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Integer, lpdwVolume As Integer) As Integer
' Public Declare Function waveOutMessage Lib "winmm.dll" (ByVal hWaveOut As Integer, ByVal msg As Integer, ByVal dw1 As Integer, ByVal dw2 As Integer) As Integer
' Public Declare Function waveOutPause Lib "winmm.dll" (ByVal hWaveOut As Integer) As Integer
' Public Declare Function waveOutRestart Lib "winmm.dll" (ByVal hWaveOut As Integer) As Integer
' Public Declare Function waveOutSetPitch Lib "winmm.dll" (ByVal hWaveOut As Integer, ByVal dwPitch As Integer) As Integer
' Public Declare Function waveOutSetPlaybackRate Lib "winmm.dll" (ByVal hWaveOut As Integer, ByVal dwRate As Integer) As Integer
' Public Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Integer, ByVal dwVolume As Integer) As Integer