Question

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

Answer 1

我已经提取了旧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, 0, 0)

        ' OPEN MCI:
        If mciSendString("open " & Chr(34) & sFile & Chr(34) & _
            " type waveaudio alias " & sAlias, 0, 0, 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, 0, 0)


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

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

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


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

End Sub

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

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

End Sub
Private Sub MciPlayRecord()
    Try
        mciSendString("play " & RecAlias & " from 0", MciRS, MciRL, 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), MciRS, MciRL, 0)
        mciSendString("close " & RecAlias, MciRS, MciRL, 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, 0, 0)

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


        mciSendString("play MyAlias from 0", 0, 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, 0, 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", sBuffer, Len(sBuffer), 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", sBuffer, Len(sBuffer), 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", sBuffer, Len(sBuffer), 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

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

1 个答案: