How to record a specific applications audio? vb.net

Question

How can I make an application that can record the audio output of another application using VB.net?

Answer 1

I've extracted some parts of my old TextToSpeek program.

The MCI-recording works very well. The Windows Mixer is included in all versions. So you can record the output of all programs. I hope I have not forgotten anything. Just ask then.

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