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

Posted 2023-02-25

【中文标题】如何录制特定应用程序的音频？ vb.net

【英文标题】：How to record a specific applications audio? vb.net

【发布时间】：2010-07-06 13:35:06

【问题描述】：

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

【问题讨论】：

这可能不是那么容易。您可能可以编写一个音频驱动程序，尽管我不知道如何在 vb.net 中执行此操作。您也可以使用线缆连接耳机和麦克风输入/输出，然后使用标准录音机进行录音。

在 Vista 中（我不记得 XP 并且我没用过 7）你可以在 windows 混合器中单独设置每个应用程序的音量，这让我认为必须有一种方法可以在将音频混入“立体声混音”通道之前获取音频...

我认为这在 VB.NET 中会非常棘手。您能否告诉我们您正在努力实现的目标，因为可能会有更好的解决方案？

【参考方案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