如何录制特定的应用音频? vb.net

如何创建一个可以使用VB.net记录另一个应用程序的音频输出的应用程序?

解决方法

我已经提取了旧TextToSpeek程序的一些部分.

MCI录音效果很好. Windows Mixer包含在所有版本中.所以你可以记录所有程序的输出.我希望我没有忘记任何事情.那就问吧.

Private ActMediaFolder As String
Private RecAlias As String
Private MciRS As String = Space(1024)
Private MciRL As Integer = 1024
Private MciLength As Integer
Private mciStopped As Boolean
Private IsRecorded As Boolean = False
Private Mp3Quality As Integer
Private axMpIsInPlayState As Boolean = False

Public Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" ( _
ByVal lpstrCommand As String,_
ByVal lpstrReturnString As String,_
ByVal uReturnLength As Long,_
ByVal hwndCallback As Long) As Long



#Region "MCI RECORDING"

Public Function MciOpen(ByVal sFile As String,ByVal sAlias As String) As Boolean

    Try

        mciSendString("close " & sAlias,0)

        ' OPEN MCI:
        If mciSendString("open " & Chr(34) & sFile & Chr(34) & _
            " type waveaudio alias " & sAlias,0) = 0 Then

        End If
    Catch ex As Exception
        MsgBox(ex.Message)
    End Try
End Function


Private Sub MciRecord()
    'Dim bits As String = "16"
    'Dim samples As String = "44100"
    'Dim bytes As String = "176400"
    'Dim c As String = "2"
    Try
        Dim CB As Long = 0


        mciSendString("close " & RecAlias,0)


        mciSendString("open new type waveaudio alias " & RecAlias,MciRS,128,0)

        mciSendString("SET MyRec TIME FORMAT MS",MciRL,CB)
        mciSendString("SET MyRec BITSPERSAMPLE 16",CB)
        mciSendString("SET MyRec CHANNELS 2",CB)

        mciSendString("SET MyRec SAMPLESPERSEC 44100",CB)
        mciSendString("SET MyRec BYTESPERSEC 176400",CB)


        mciSendString("record " & RecAlias,CB)
        IsRecorded = True
    Catch ex As Exception
        MsgBox(ex.Message)
    End Try

End Sub

Private Sub MciStopRecord()
    TimerRecTime.Stop()
    Try
        mciSendString("stop " & RecAlias,0)

    Catch ex As Exception
        MsgBox(ex.Message)
    End Try

End Sub
Private Sub MciPlayRecord()
    Try
        mciSendString("play " & RecAlias & " from 0",0)
    Catch ex As Exception
        MsgBox(ex.Message)
    End Try

End Sub
Private Sub MciSaveRecord(ByVal sfile As String)
    Try
        mciSendString("save " & RecAlias & " " & Chr(34) & sfile & Chr(34),0)
        mciSendString("close " & RecAlias,0)
    Catch ex As Exception
        MsgBox(ex.Message)
    End Try

End Sub

Public Function MciPlay(ByVal sfile As String,ByVal sAlias As String) As Boolean
    Try
        Dim sBuffer As String = Space(256)

        MP3_Stop("MyAlias")
        mciSendString("close MyAlias",0)

        mciSendString("open " & Chr(34) & sfile & Chr(34) & " ALIAS MyAlias",0)


        mciSendString("play MyAlias from 0",0)

        mciSendString("status MyAlias mode",sBuffer,Len(sBuffer),0)
        MsgBox(sBuffer)

    Catch ex As Exception
        MsgBox(ex.Message)
    End Try

End Function

Public Sub MP3_Stop(ByVal sAlias As String)
    Try
        mciSendString("stop " & sAlias,0)
    Catch ex As Exception
        MsgBox(ex.Message)
    End Try

End Sub

Public Function mciGetLength() As Integer
    Try
        Dim sBuffer As String = Space(256)

        mciSendString("status MyAlias length",0)

        mciGetLength = Val(sBuffer)

    Catch ex As Exception
        MsgBox(ex.Message)
    End Try

End Function

Public Function mciCurPos() As Integer
    Try
        Dim sBuffer As String = Space(256)


        mciSendString("status MyAlias position",0)

        mciCurPos = Val(sBuffer)

    Catch ex As Exception
        MsgBox(ex.Message)
    End Try

End Function

Public Function mciGetStatus() As String
    Try
        Dim sBuffer As String = Space(256)

        mciSendString("status MyAlias mode",0)

        mciGetStatus = sBuffer

    Catch ex As Exception
        MsgBox(ex.Message)
    End Try

    Return "Error"
End Function


Private Sub TimerMCI_Tick(ByVal sender As System.Object,ByVal e As System.EventArgs) Handles TimerMCI.Tick

    Try
        If InStr(mciGetStatus(),"stop") Then
            mciStopped = True
            MsgBox("STOP")
            TimerMCI.Stop()
        ElseIf InStr(mciGetStatus(),"Error") Then
            mciStopped = True
            MsgBox("ERROR")
            TimerMCI.Stop()

        Else
            mciStopped = False

        End If
    Catch ex As Exception
        MsgBox(ex.Message)
    End Try


End Sub



#End Region

相关文章

Format[$] ( expr [ , fmt ] ) format 返回变体型 format$ 强...
VB6或者ASP 格式化时间为 MM/dd/yyyy 格式,竟然没有好的办...
在项目中添加如下代码:新建窗口来显示异常信息。 Namespace...
转了这一篇文章,原来一直想用C#做k3的插件开发,vb没有C#用...
Sub 分列() ‘以空格为分隔符,连续空格只算1个。对所选...
  窗体代码 1 Private Sub Text1_OLEDragDrop(Data As Dat...