Comment enregistrer une application audio spécifique? vb.net

Question

Comment puis-je créer une application capable d'enregistrer la sortie audio d'une autre application à l'aide de VB.net?

Answer 1

J'ai extrait certaines parties de mon ancien programme TextToSpeek.

L'enregistrement MCI fonctionne très bien. Le mélangeur Windows est inclus dans toutes les versions. Ainsi, vous pouvez enregistrer la sortie de tous les programmes. J'espère que je n'ai rien oublié. Demande juste alors.

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