如何创建一个可以使用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