wavestrm.cls

一个用vb开发的比较好的聊天系统

'--------------------------------------------------------------
Public Function AddStreamToQueue(StreamIdx As Integer)
' Puts An Incoming Wave Segment Into The Wave PlayBack Queue
'--------------------------------------------------------------
    Dim Idx As Integer                                  ' Queue Array Processing Variable
'--------------------------------------------------------------
    For Idx = MINSTREAM To MAXSTREAM                    ' For Each Stream In The Queue
        If (PlayWaveBuffer.QueuePos(Idx) = StreamIdx) Then ' If Stream Already In Playback Queue
            AddStreamToQueue = True                     ' Return Success
            Exit Function                               ' Exit
        ElseIf (PlayWaveBuffer.QueuePos(Idx) = 0) Then  ' If Queue Space Available...
            PlayWaveBuffer.QueuePos(Idx) = StreamIdx    ' Put Stream Into The Playback Queue
            AddStreamToQueue = True                     ' Return Success
            Exit Function                               ' Exit
        End If
    Next                                                ' Next Stream In The Queue
'--------------------------------------------------------------
End Function
'--------------------------------------------------------------

'------------------------------------------------------------------
Public Sub SaveStreamBuffer(StreamIdx As Integer, recBuffer() As Byte)
' Saves A Record Buffer To A Record Buffer Array
'------------------------------------------------------------------
    ' If Buffer Is Free
    If (LenB(MidB(PlayWaveBuffer.Stream(StreamIdx).Waves(CurRecPos(StreamIdx)).Data, 1)) < 3) Then
        PlayWaveBuffer.Stream(StreamIdx).Waves(CurRecPos(StreamIdx)).Data = recBuffer ' Copy Buffer From Rec
        Call IncBufferPointer(CurRecPos(StreamIdx)) ' Increment Buffer Pointer To Next Free Position...
    End If                                          ' Else Ignore Buffer Data
'------------------------------------------------------------------
End Sub
'------------------------------------------------------------------

'------------------------------------------------------------------
Private Function LoadPlayBuffer(hWaveOut As Long, WaveOutHdr As WAVEHDR, waveFmt As WAVEFORMATEX, Data() As Byte, playBuffPos As Long) As Boolean
' Loads Audio Sound From A String Buffer Into A Wave Header Structure For PlayBack
'------------------------------------------------------------------
    Dim rc As Long                                  ' Return Code Variable
'------------------------------------------------------------------
    If (LenB(MidB(Data, 1)) > 2) Then
        WaveOutHdr.dwBufferLength = UBound(Data) - LBound(Data) + 1 ' Get Wave Buffer Size
        Call CopyBYTEStoPTR(WaveOutHdr.lpData, Data(0), _
                            WaveOutHdr.dwBufferLength)  ' Copy Buffer From String To Pointer
        Data = ""                                       ' Clear Buffer Space
        Call IncBufferPointer(playBuffPos)              ' Increment Play Buffer ptr To Next Position...
        
        LoadPlayBuffer = True                           ' Return Success
    End If
'------------------------------------------------------------------
End Function
'------------------------------------------------------------------

'------------------------------------------------------------------
Private Function SendSoundAll(Sockets As Variant, WaveHeader As ACMSTREAMHEADER) As Long
' Sends Sound Buffers To Each Valid Connection In A Connection Array
'------------------------------------------------------------------
    Dim Idx As Integer                              ' Socket cntl index
    Dim rc As Long                                  ' Function Return Code
    Dim Socket As Variant                           ' TCP socket control
'------------------------------------------------------------------
    For Each Socket In Sockets                      ' Check each socket
        If (Socket.State = sckConnected) Then       ' If Connection Is Active
            rc = SendSound(Socket, WaveHeader)      ' Send Sound To Socket Connection
        End If
    Next                                            ' Try Next LocalPort
'------------------------------------------------------------------
End Function
'------------------------------------------------------------------

'------------------------------------------------------------------
Private Function SendSound(Socket As Variant, acmHdr As ACMSTREAMHEADER) As Long
' Checks A Socket SendFlag Status, And Sends A WaveBuffer When Socket Is Ready
'------------------------------------------------------------------
    Dim WaveBuffer() As Byte                        ' Wave Buffer byte array
'------------------------------------------------------------------
    ReDim WaveBuffer(acmHdr.cbDstLengthUsed - 1) As Byte ' Allocate byte array
    Call CopyPTRtoBYTES(WaveBuffer(0), acmHdr.cbDst, _
                        acmHdr.cbDstLengthUsed)     ' Copy Data
    Call Socket.SendData(WaveBuffer)                ' Send wave data into the socket
'------------------------------------------------------------------
End Function
'------------------------------------------------------------------

'------------------------------------------------------------------
Public Function AudioErrorHandler(rc As Long, fcnName As String) As Boolean
'------------------------------------------------------------------
    Dim msg As String               ' Error Message Body
'------------------------------------------------------------------
    AudioErrorHandler = False       ' Return Failure
    
'   Select Case rc Or Err.LastDllError
    Select Case rc
    Case MMSYSERR_NOERROR           ' no error
        AudioErrorHandler = True    ' Return Success
        Exit Function               ' Exit Function
    Case MMSYSERR_ERROR             ' unspecified error
        msg = "Unspecified Error."
    Case MMSYSERR_BADDEVICEID       ' device ID out of range
        msg = "device ID out of range"
    Case MMSYSERR_NOTENABLED        ' driver failed enable
        msg = "driver failed enable"
    Case MMSYSERR_ALLOCATED         ' device already allocated
        msg = "device already allocated"
    Case MMSYSERR_INVALHANDLE       ' device handle is invalid
        msg = "device handle is invalid"
    Case MMSYSERR_NODRIVER          ' no device driver present
        msg = "no device driver present"
    Case MMSYSERR_NOMEM             ' memory allocation error
        msg = "memory allocation error"
    Case MMSYSERR_NOTSUPPORTED      ' function isn't supported
        msg = "function isn't supported"
    Case MMSYSERR_BADERRNUM         ' error value out of range
        msg = "error value out of range"
    Case MMSYSERR_INVALFLAG         ' invalid flag passed
        msg = "invalid flag passed"
    Case MMSYSERR_INVALPARAM        ' invalid parameter passed
        msg = "invalid parameter passed"
    Case MMSYSERR_LASTERROR         ' last error in range
        msg = "last error in range"
    Case WAVERR_BADFORMAT           ' unsupported wave format
        msg = "unsupported wave format"
    Case WAVERR_STILLPLAYING        ' still something playing
        msg = "still something playing"
    Case WAVERR_UNPREPARED          ' header not prepared
        msg = "header not prepared"
    Case WAVERR_LASTERROR           ' last error in range
        msg = "last error in range"
    Case WAVERR_SYNC                ' device is synchronous
        msg = "device is synchronous"
    Case ACMERR_NOTPOSSIBLE         ' The requested operation cannot be performed
        msg = "The requested operation cannot be performed"
    Case ACMERR_BUSY                ' The stream header specified is currently in use and cannot be unprepared
        msg = "The acm stream header busy"
    Case ACMERR_UNPREPARED
        msg = "The acm stream header is not prepared"
    Case ACMERR_CANCELED
        msg = "The acm operation has been canceled"
    Case ERROR_SHARING_VIOLATION    ' The process cannot access the file because it is being used by another process.
        msg = "The process cannot access the file because it is being used by another process."
    Case Else                       ' Unknown MM Error!
        msg = "Unknown MM Error!"
    End Select
    
    ' Format Text Body Of Message
    msg = "Error In " & fcnName & _
          " rc= " & Str$(rc) & _
          " MSG= " & msg & _
          " LastDllError= " & Hex(Err.LastDllError) & _
          " Source= " & Err.Source & vbCrLf
    
    Debug.Print msg                 ' Print Error Message
    MsgBox msg
    Exit Function                   ' Exit
'------------------------------------------------------------------
End Function
'------------------------------------------------------------------

'------------------------------------------------------------------
Private Sub Class_Initialize()
'------------------------------------------------------------------
    Recording = False                                   ' Set Recording Status Off...
    Playing = False                                     ' Set Playing Status Off...
    RecDeviceFree = True                                ' Set Rec Device Free Status Indicator TRUE
    PlayDeviceFree = True                               ' Set Play Device Free Status Indicator TRUE
    Call InitACMCodec(WAVE_FORMAT_PCM, 0.2)             ' Initialise codec default values...
'------------------------------------------------------------------
End Sub
'------------------------------------------------------------------

'------------------------------------------------------------------
Private Sub Class_Terminate()
'------------------------------------------------------------------
    Recording = False                                   ' Set Recording Status Off...
    Playing = False                                     ' Set Playing Status Off...
    RecDeviceFree = False                               ' Set Rec Device Free Status Indicator TRUE
    PlayDeviceFree = False                              ' Set Play Device Free Status Indicator TRUE
'------------------------------------------------------------------
End Sub
'------------------------------------------------------------------

'------------------------------------------------------------------
Private Sub debugACM(acmHdr As ACMSTREAMHEADER)
'------------------------------------------------------------------
    ' Used for debugging the audio compression streaming
    MsgBox "cbStruct:" & CStr(acmHdr.cbStruct) & vbCrLf & "dwStatus:" & CStr(acmHdr.dwStatus) & vbCrLf & _
           "dwUser:" & CStr(acmHdr.dwUser) & vbCrLf & _
           "pbSrc:" & CStr(acmHdr.pbSrc) & vbCrLf & _
           "cbSrcLength:" & CStr(acmHdr.cbSrcLength) & vbCrLf & _
           "cbSrcLengthUsed:" & CStr(acmHdr.cbSrcLengthUsed) & vbCrLf & _
           "dwSrcUser:" & CStr(acmHdr.dwSrcUser) & vbCrLf & _
           "cbDst:" & CStr(acmHdr.cbDst) & vbCrLf & _
           "cbDstLength:" & CStr(acmHdr.cbDstLength) & vbCrLf & _
           "cbDstLengthUsed:" & CStr(acmHdr.cbDstLengthUsed) & vbCrLf & _
           "dwDstUser:" & CStr(acmHdr.dwDstUser)
'------------------------------------------------------------------
End Sub
'------------------------------------------------------------------