wavestrm.cls

一个VB做的语音系统控件

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "WaveStream"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'--------------------------------------------------------------
' Public Variable Declarations
'--------------------------------------------------------------
Public Recording As Boolean             ' Public Recording Status Indicator...
Public RecDeviceFree As Boolean         ' Public Recording Device Status Indicator...
Public Playing As Boolean               ' Public Recording Status Indicator...
Public PlayDeviceFree As Boolean        ' Public Recording Device Status Indicator...

Public waveChunkSize As Long            ' size of wave data buffer
Public waveCodec As Long                ' acm codec compression format
Public TIMESLICE As Single              ' recording interval...

'--------------------------------------------------------------
Private Const MINSTREAM = 1
Private Const MAXSTREAM = 32
Private CurRecPos(MINSTREAM To MAXSTREAM) As Long  ' Current Recording Buffer Position
Private CurPlayPos(MINSTREAM To MAXSTREAM) As Long ' Current Playing Buffer Position

Private Type WaveData                   ' [Wave Stream Segment]
    Data() As Byte                      ' Wave data byte array
End Type

Private Type WaveArray                  ' [Wave Stream]
    Waves(MAXBUFFERS) As WaveData       ' Array of WaveBuffers
End Type

Private Type uArrayWaves                ' [Array of Wave Streams]
    Stream(MINSTREAM To MAXSTREAM) As WaveArray ' Wave Buffer Array...
    QueuePos(MAXSTREAM - MINSTREAM + 1) As Long ' Wave Buffer Queue Position
End Type

Private PlayWaveBuffer As uArrayWaves    ' Array Of WaveBuffer Data Type
'--------------------------------------------------------------

'--------------------------------------------------------------
Public Sub InitACMCodec(fmtType As Long, Time_Slice As Single)
'--------------------------------------------------------------
    Dim waveFmt As WAVEFORMATEX                             ' Wave format type
'--------------------------------------------------------------
    waveCodec = fmtType                                     ' Save compression format to public variable
    TIMESLICE = Time_Slice                                  ' Save recording interval to public variable
    Call InitWaveFormat(waveFmt, waveCodec, TIMESLICE)      ' Get wave format info
    waveChunkSize = waveFmt.nAvgBytesPerSec * TIMESLICE     ' Save wave buffer size to public variable
'--------------------------------------------------------------
End Sub
'--------------------------------------------------------------

'--------------------------------------------------------------
Public Function StreamInQueue() As Long
' Return current stream index in queue for playback
'--------------------------------------------------------------
    StreamInQueue = PlayWaveBuffer.QueuePos(MINSTREAM)
'--------------------------------------------------------------
End Function
'--------------------------------------------------------------

'--------------------------------------------------------------
Public Sub RemoveStreamFromQueue(StreamIdx As Integer)
' Removes A Stream From The Wave PlayBack Queue When PlayBack Is Done
'--------------------------------------------------------------
    Dim Idx As Integer                                      ' Queue Array Element Variable
'--------------------------------------------------------------
    For Idx = MINSTREAM To MAXSTREAM                        ' For Each Stream In The Queue
        If (PlayWaveBuffer.QueuePos(Idx) = StreamIdx) Then  ' If Stream Found In Queue...
            PlayWaveBuffer.QueuePos(Idx) = 0                ' Remove Stream From Queue
        ElseIf (Idx > MINSTREAM) Then                       ' If Not The First Item In The Queue...
            If (PlayWaveBuffer.QueuePos(Idx - 1) = 0) Then  ' If Previous Item Was Removed...
                If (PlayWaveBuffer.QueuePos(Idx) = 0) Then Exit For
                PlayWaveBuffer.QueuePos(Idx - 1) = PlayWaveBuffer.QueuePos(Idx) ' Move Stream Up To New Position
                PlayWaveBuffer.QueuePos(Idx) = 0            ' Remove Stream From Old Position
            End If
        End If
    Next                                                    ' Next Stream In Queue
'--------------------------------------------------------------
End Sub
'--------------------------------------------------------------

'--------------------------------------------------------------
Public Sub WaitForCallBack(CallBackBit As Long, cbFlag As Long)
' Waits For Asynchronous Function Callback Bit To Be Set.
'--------------------------------------------------------------
    Do Until (((CallBackBit And cbFlag) = cbFlag) Or _
               (CallBackBit = WHDR_PREPARED) Or _
               (CallBackBit = 0))       ' Check For (CallBack Bit Or Null)...
        DoEvents                        ' Post Events...
    Loop
'--------------------------------------------------------------
End Sub
'--------------------------------------------------------------

'--------------------------------------------------------------
Public Sub WaitForACMCallBack(CallBackBit As Long, cbFlag As Long)
' Waits For Asynchronous Function Callback Bit To Be Set.
'--------------------------------------------------------------
    Do Until (((CallBackBit And cbFlag) = cbFlag) Or _
               (CallBackBit = 0))       ' Check For (CallBack Bit Or Null)...
        DoEvents                        ' Post Events...
    Loop
'--------------------------------------------------------------
End Sub
'--------------------------------------------------------------

'--------------------------------------------------------------
Private Sub InitWaveHDR(WaveHeader As WAVEHDR, waveFmt As WAVEFORMATEX, BuffSize As Long)
' Initialize's An Input Wave Header's DataBuffer And Size Members...
'--------------------------------------------------------------
    Dim rc As Long                                      ' Function Return Code...
'--------------------------------------------------------------
    WaveHeader.hData = GlobalAlloc(GMEM_MOVEABLE Or GMEM_SHARE Or GMEM_ZEROINIT, BuffSize) ' Allocate Global Memory
    WaveHeader.lpData = GlobalLock(WaveHeader.hData)    ' Lock Memory handle

    WaveHeader.dwBufferLength = BuffSize                ' Get Wave Buffer Size
    WaveHeader.dwFlags = 0                              ' Must Be Set To 0 For (waveOutPrepareHeader & waveInPrepareHeader)
'--------------------------------------------------------------
End Sub
'--------------------------------------------------------------

'--------------------------------------------------------------
Private Function FreeWaveHDR(WaveHeader As WAVEHDR) As Boolean
'--------------------------------------------------------------
    Dim rc As Long                                      ' Function return code
'--------------------------------------------------------------
    rc = GlobalUnlock(WaveHeader.lpData)                ' Unlock Global Memory
    rc = GlobalFree(WaveHeader.hData)                   ' Free Global Memory
    
    FreeWaveHDR = True                                  ' Set Default Return Code
'--------------------------------------------------------------
End Function
'--------------------------------------------------------------

'--------------------------------------------------------------
Private Sub InitAcmHDR(hAS As Long, acmHdr As ACMSTREAMHEADER, wavHdr As WAVEHDR)
' Initialize's An Input Wave Header's DataBuffer And Size Members...
'--------------------------------------------------------------
    Dim rc As Long                                      ' Function Return Code...
    Dim OutBytes As Long
'--------------------------------------------------------------
    acmHdr.cbStruct = Len(acmHdr)                       ' Size of header in bytes
    acmHdr.dwStatus = 0                                 ' Must be initialized to 0
    acmHdr.dwUser = 0                                   ' clear user def info
    acmHdr.cbSrcLengthUsed = 0                          ' Must be initialized to 0
    acmHdr.cbDstLengthUsed = 0                          ' Must be initialized to 0
    
    acmHdr.pbSrc = wavHdr.lpData                        ' Copy address of unprocessed data
    acmHdr.cbSrcLength = wavHdr.dwBufferLength          ' Copy size of unprocessed data
    
    rc = acmStreamSize(hAS, acmHdr.cbSrcLength, acmHdr.cbDstLength, ACM_STREAMSIZEF_SOURCE)
    Call AudioErrorHandler(rc, "acmStreamSize")
    
    ' Allocate memory for de/compression
    acmHdr.dwDstUser = GlobalAlloc(GMEM_MOVEABLE Or GMEM_SHARE Or GMEM_ZEROINIT, acmHdr.cbDstLength)                                     ' Allocate Global Memory
    acmHdr.cbDst = GlobalLock(acmHdr.dwDstUser)         ' Lock Memory handle
'--------------------------------------------------------------
End Sub
'--------------------------------------------------------------

'--------------------------------------------------------------
Private Sub FreeAcmHdr(acmHdr As ACMSTREAMHEADER)
' Initialize's An Input Wave Header's DataBuffer And Size Members...
'--------------------------------------------------------------
    Dim rc As Long                                      ' Function Return Code...
'--------------------------------------------------------------
    rc = GlobalUnlock(acmHdr.cbDst)                     ' Unlock Global Memory
    rc = GlobalFree(acmHdr.dwDstUser)                   ' Free Global Memory
'--------------------------------------------------------------
End Sub
'--------------------------------------------------------------

'------------------------------------------------------------------
Public Function RecordWave(hWND As Long, ByVal TCPSocket As Variant) As Boolean
' Records Audio Sounds To A String Buffer And Sends Buffer To TCP/IP Socket...
'------------------------------------------------------------------
    Dim rc As Long                                      ' Function Return Code
    Dim hAS As Long                                     ' ACM stream device
    Dim cWavefmt As WAVEFORMATEX                        ' Wave compression format
    Dim acmHdr As ACMSTREAMHEADER                       ' ACM stream header
    Dim acmHdr_x As ACMSTREAMHEADER                     ' <<Double Buffering>> ACM stream header
    Dim hWaveIn As Long                                 ' Handle To An Input Wave Device
    Dim waveFmt As WAVEFORMATEX                         ' Wave compression format
    Dim WaveInHDR As WAVEHDR                            ' Handle To An Input Wave Device Header
    Dim WaveInHDR_x As WAVEHDR                          ' <<Double Buffering>> Handle To An xtra Input Wave Device Header
'------------------------------------------------------------------
    RecDeviceFree = False                               ' Allocate Recording Device
    
    Do While Not PlayDeviceFree                         ' Wait For Play Device To Free
        DoEvents                                        ' Yield Events...
    Loop                                                ' Check Play Device Status
    
    Call InitWaveFormat(waveFmt, WAVE_FORMAT_PCM, TIMESLICE)   ' Set current wave format
    
    ' Open Input Wave Device, Let WAVE_MAPPER Pick The Best Device...
    rc = waveInOpen(hWaveIn, WAVE_MAPPER, waveFmt, 0&, 0&, CALLBACK_NULL)
    If Not AudioErrorHandler(rc, "WaveInOpen") Then Exit Function ' Validate Function Return Code