-=软件复读机开发计划=-(200分)

呵呵，这个两年前用VB写过，抓声音是用微软DX7中DSound的例子，98SE2安装盘
中有DX7的SDK！

调用WINDOWS的录音机

代码贴给你，哈哈，反正是陈年的老东西啦，[]

''--------------------------------------------------------
''This sample will show how to use the "SaveToFile"
''--------------------------------------------------------


Dim dx As New DirectX7
Dim ds As DirectSound
Dim dsb As DirectSoundBuffer
Dim dsd As DSBUFFERDESC
Dim dsc As DirectSoundCapture
Dim dscb As DirectSoundCaptureBuffer
Dim dscd As DSCBUFFERDESC
Dim CaptureWave As WAVEFORMATEX
Dim capCURS As DSCURSORS
Dim ByteBuffer() As Integer
Dim CNT As Integer
Dim cCaps As DSCCAPS
Dim gfPlay As Boolean

Private Sub cmdPlayRec_Click()
''----------------------------------------
'' convert the data from a capture buffer
'' to a sound buffer
''----------------------------------------
ConvertToSBuffer

'' did the sound buffer get created?
If dsb Is Nothing then

Exit Sub
else

dsb.Play DSBPLAY_DEFAULT
tmrCount.Enabled = True
CNT = 0
lblTIME.Caption = vbNullString
If gfPlay then
cmdStopPlaying.Enabled = True
End If


End Sub

Private Sub cmdSaveToFile_Click()
On Error Resume Next

Dim FileLocal As String


ConvertToSBuffer

If dsb Is Nothing then
Exit Sub

cmdStopPlaying.Enabled = False

tmrCount.Enabled = False
lblTIME.Caption = vbNullString
CNT = 0

If dsb Is Nothing then

MsgBox "Please record a sound first"
Exit Sub
End If

'common dialog control
svFile.Filter = "*.wav"
svFile.DialogTitle = "Save Wave File"
svFile.ShowSave


If Right(svFile.filename, 4) <> ".wav" And svFile.filename <> vbNullString then

FileLocal = svFile.filename
FileLocal = FileLocal &amp;
".wav"
else

FileLocal = svFile.filename
End If

'FileLocal = InputBox("Please enter the location, and file name you want the file saved as.", "SAVE", "c:/windows/temp/test.wav")

If FileLocal = vbNullString then
Exit Sub

If Mid(FileLocal, 2, 1) <> ":" then
Exit Sub

If Right(FileLocal, 3) <> "wav" then

MsgBox "Please enter a correct name ie something.wav", vbApplicationModal
Exit Sub
End If


dsb.SaveToFile FileLocal

End Sub

Private Sub cmdStartRec_Click()
Set dscb = Nothing
Call InitCapture

dscb.start DSCBSTART_DEFAULT

tmrCount.Interval = 1000
tmrCount.Enabled = True
cmdStopRec.Enabled = True
cmdStartRec.Enabled = False
End Sub

Private Sub cmdStopPlaying_Click()

If dsb Is Nothing then
Exit Sub

Dim l_st As Long
Dim l_soundStatus As Long

''--- see if the capture buffer is running
l_st = dscb.GetStatus()
If (l_st And DSCBSTATUS_CAPTURING) then

dscb.Stop
End If

''-- see if the sound buffer is playing
l_soundStatus = dsb.GetStatus()
If (l_soundStatus And DSBSTATUS_PLAYING) then

dsb.Stop
dsb.SetCurrentPosition 0
End If

tmrCount.Enabled = False

CNT = 0
lblTIME.Caption = vbNullString
cmdStopPlaying.Enabled = False
End Sub

Private Sub cmdStopRec_Click()
Dim l_bufferS As Long

If dscb Is Nothing then
Exit Sub

cmdSaveToFile.Enabled = True
If gfPlay then
cmdPlayRec.Enabled = True
''cmdStopPlaying.Enabled = True

'' is the buffer going?
l_bufferS = dscb.GetStatus()
If (l_bufferS And DSCBSTATUS_CAPTURING) then

dscb.Stop
End If

tmrCount.Enabled = False
CNT = 0
lblTIME.Caption = vbNullString
cmdStartRec.Enabled = True
cmdStopRec.Enabled = False
End Sub


Private Sub Form_Load()

On Local Error GoTo errOut

Set dsc = dx.DirectSoundCaptureCreate(vbNullString)
On Error Resume Next
Set ds = dx.DirectSoundCreate(vbNullString)
If Err.Number = DSERR_ALLOCATED then
'The card isn't supporting full duplex
gfPlay = False
MsgBox "This carddo
es not support full duplex. You may still record sound.", vbOKOnly Or vbInformation, "No full duplex"
else

gfPlay = True
ds.SetCooperativeLevel Me.hWnd, DSSCL_NORMAL
End If
On Local Error GoTo errOut

InitCapture

cmdSaveToFile.Enabled = False
cmdPlayRec.Enabled = False
cmdStopPlaying.Enabled = False
cmdStopRec.Enabled = False

lblTIME.Caption = vbNullString
Exit Sub

errOut:
MsgBox "Unable to initialize sound card for capture. Exiting this application", vbOKOnly Or vbCritical
End
End Sub

Private Sub ConvertToSBuffer()
Dim l_captureS As Long

'' are we running?
l_captureS = dscb.GetStatus()
If (l_captureS And DSCBSTATUS_CAPTURING) then

dscb.Stop
End If

'' get the capture info
dscb.GetCurrentPosition capCURS
dsd.lBufferBytes = capCURS.lWrite * dscd.fxFormat.nBlockAlign
dsd.lFlags = DSBCAPS_CTRLVOLUME Or DSBCAPS_STATIC

If capCURS.lWrite = 0 then

Exit Sub
End If


Set dsb = ds.CreateSoundBuffer(dsd, dscd.fxFormat)
ReDim ByteBuffer(capCURS.lWrite * dscd.fxFormat.nBlockAlign + 1)
dscb.ReadBuffer 0, capCURS.lWrite * dscd.fxFormat.nBlockAlign, ByteBuffer(0), DSCBLOCK_DEFAULT
dsb.WriteBuffer 0, capCURS.lWrite * dscd.fxFormat.nBlockAlign, ByteBuffer(0), DSBLOCK_DEFAULT
''Set dscb = Nothing
End Sub

Private Function WaveEx(Hz As Long, Channels As Integer, BITS As Integer) As WAVEFORMATEX

WaveEx.nFormatTag = WAVE_FORMAT_PCM
WaveEx.nChannels = Channels
WaveEx.lSamplesPerSec = Hz
WaveEx.nBitsPerSample = BITS
WaveEx.nBlockAlign = Channels * BITS / 8
WaveEx.lAvgBytesPerSec = WaveEx.lSamplesPerSec * WaveEx.nBlockAlign
WaveEx.nSize = 0

End Function

Private Sub InitCapture()
'set the capture buffer
dsc.GetCaps cCaps

If cCaps.lFormats And WAVE_FORMAT_2M08 then

CaptureWave = WaveEx(22050, 1, 8)
else
If cCaps.lFormats And WAVE_FORMAT_1M08 then

CaptureWave = WaveEx(11025, 1, 8)
else

MsgBox "Capture is not supported with your sound card!", vbApplicationModal
End
End If


dscd.fxFormat = CaptureWave
dscd.lBufferBytes = CaptureWave.lAvgBytesPerSec * 20
dscd.lFlags = DSCBCAPS_WAVEMAPPED


Set dscb = dsc.CreateCaptureBuffer(dscd)


End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call CleanUp
End
End Sub

Private Sub CleanUp()
''Clean up all the stuff
Set dx = Nothing
Set ds = Nothing
Set dsb = Nothing
Set dsc = Nothing
Set dscb = Nothing
Erase ByteBuffer
End Sub

Private Sub mnuExit_Click()
Unload Me
End Sub

Private Sub tmrCount_Timer()
On Error Resume Next

CNT = CNT + 1

If CNT = 19 then

dscb.Stop
lblTIME.Caption = "Full"
frmMain.Refresh
tmrCount.Enabled = False

cmdSaveToFile.Enabled = True
If gfPlay then
cmdPlayRec.Enabled = True
If gfPlay then
cmdStopPlaying.Enabled = True

Exit Sub
End If

lblTIME.Caption = CNT

''check the status of the sound buffer
Dim l_sBs As Long
If Not (dsb Is Nothing) then

l_sBs = dsb.GetStatus()
If (l_sBs And DSBSTATUS_PLAYING) then

else

If cmdStartRec.Enabled = True then

tmrCount.Enabled = False
CNT = 1
lblTIME.Caption = vbNullString
cmdStopPlaying.Enabled = False
End If
End If
End If


End Sub

VB这个窗口啊，和代码在一起的，俺给你贴全啦

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0";
"COMDLG32.OCX"
begin
VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "Capture and Save to File Sample"
ClientHeight = 2925
ClientLeft = 150
ClientTop = 720
ClientWidth = 4110
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2925
ScaleWidth = 4110
StartUpPosition = 3 'Windows Default
begin
MSComDlg.CommonDialog svFile
Left = 240
Top = 840
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Flags = 4
End
begin
VB.CommandButton cmdStopPlaying
Caption = "Stop Playing"
Height = 375
Left = 2520
TabIndex = 4
Top = 1800
Width = 1455
End
begin
VB.CommandButton cmdSaveToFile
Caption = "Save to File"
Height = 375
Left = 2520
TabIndex = 3
Top = 2280
Width = 1455
End
begin
VB.CommandButton cmdPlayRec
Caption = "Play"
Height = 375
Left = 2520
TabIndex = 2
Top = 1320
Width = 1455
End
begin
VB.CommandButton cmdStopRec
Caption = "Stop Recording"
Height = 375
Left = 2520
TabIndex = 1
Top = 840
Width = 1455
End
begin
VB.Timer tmrCount
Left = 840
Top = 840
End
begin
VB.CommandButton cmdStartRec
Caption = "Start Recording"
Height = 375
Left = 2520
TabIndex = 0
Top = 360
Width = 1455
End
begin
VB.Label lblLTime
Alignment = 1 'Right Justify
Caption = "Time:"
Height = 255
Left = 240
TabIndex = 6
Top = 360
Width = 795
End
begin
VB.Label lblTIME
Caption = "Label1"
Height = 255
Left = 1140
TabIndex = 5
Top = 360
Width = 795
End
begin
VB.Menu mnuFile
Caption = "File"
begin
VB.Menu mnuExit
Caption = "E&amp;xit"
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''--------------------------------------------------------
''This sample will show how to use the "SaveToFile"
''--------------------------------------------------------


Dim dx As New DirectX7
Dim ds As DirectSound
Dim dsb As DirectSoundBuffer
Dim dsd As DSBUFFERDESC
Dim dsc As DirectSoundCapture
Dim dscb As DirectSoundCaptureBuffer
Dim dscd As DSCBUFFERDESC
Dim CaptureWave As WAVEFORMATEX
Dim capCURS As DSCURSORS
Dim ByteBuffer() As Integer
Dim CNT As Integer
Dim cCaps As DSCCAPS
Dim gfPlay As Boolean

Private Sub cmdPlayRec_Click()
''----------------------------------------
'' convert the data from a capture buffer
'' to a sound buffer
''----------------------------------------
ConvertToSBuffer

'' did the sound buffer get created?
If dsb Is Nothing then

Exit Sub
else

dsb.Play DSBPLAY_DEFAULT
tmrCount.Enabled = True
CNT = 0
lblTIME.Caption = vbNullString
If gfPlay then
cmdStopPlaying.Enabled = True
End If


End Sub

Private Sub cmdSaveToFile_Click()
On Error Resume Next

Dim FileLocal As String


ConvertToSBuffer

If dsb Is Nothing then
Exit Sub

cmdStopPlaying.Enabled = False

tmrCount.Enabled = False
lblTIME.Caption = vbNullString
CNT = 0

If dsb Is Nothing then

MsgBox "Please record a sound first"
Exit Sub
End If

'common dialog control
svFile.Filter = "*.wav"
svFile.DialogTitle = "Save Wave File"
svFile.ShowSave


If Right(svFile.filename, 4) <> ".wav" And svFile.filename <> vbNullString then

FileLocal = svFile.filename
FileLocal = FileLocal &amp;
".wav"
else

FileLocal = svFile.filename
End If

'FileLocal = InputBox("Please enter the location, and file name you want the file saved as.", "SAVE", "c:/windows/temp/test.wav")

If FileLocal = vbNullString then
Exit Sub

If Mid(FileLocal, 2, 1) <> ":" then
Exit Sub

If Right(FileLocal, 3) <> "wav" then

MsgBox "Please enter a correct name ie something.wav", vbApplicationModal
Exit Sub
End If


dsb.SaveToFile FileLocal

End Sub

Private Sub cmdStartRec_Click()
Set dscb = Nothing
Call InitCapture

dscb.start DSCBSTART_DEFAULT

tmrCount.Interval = 1000
tmrCount.Enabled = True
cmdStopRec.Enabled = True
cmdStartRec.Enabled = False
End Sub

Private Sub cmdStopPlaying_Click()

If dsb Is Nothing then
Exit Sub

Dim l_st As Long
Dim l_soundStatus As Long

''--- see if the capture buffer is running
l_st = dscb.GetStatus()
If (l_st And DSCBSTATUS_CAPTURING) then

dscb.Stop
End If

''-- see if the sound buffer is playing
l_soundStatus = dsb.GetStatus()
If (l_soundStatus And DSBSTATUS_PLAYING) then

dsb.Stop
dsb.SetCurrentPosition 0
End If

tmrCount.Enabled = False

CNT = 0
lblTIME.Caption = vbNullString
cmdStopPlaying.Enabled = False
End Sub

Private Sub cmdStopRec_Click()
Dim l_bufferS As Long

If dscb Is Nothing then
Exit Sub

cmdSaveToFile.Enabled = True
If gfPlay then
cmdPlayRec.Enabled = True
''cmdStopPlaying.Enabled = True

'' is the buffer going?
l_bufferS = dscb.GetStatus()
If (l_bufferS And DSCBSTATUS_CAPTURING) then

dscb.Stop
End If

tmrCount.Enabled = False
CNT = 0
lblTIME.Caption = vbNullString
cmdStartRec.Enabled = True
cmdStopRec.Enabled = False
End Sub


Private Sub Form_Load()

On Local Error GoTo errOut

Set dsc = dx.DirectSoundCaptureCreate(vbNullString)
On Error Resume Next
Set ds = dx.DirectSoundCreate(vbNullString)
If Err.Number = DSERR_ALLOCATED then
'The card isn't supporting full duplex
gfPlay = False
MsgBox "This carddo
es not support full duplex. You may still record sound.", vbOKOnly Or vbInformation, "No full duplex"
else

gfPlay = True
ds.SetCooperativeLevel Me.hWnd, DSSCL_NORMAL
End If
On Local Error GoTo errOut

InitCapture

cmdSaveToFile.Enabled = False
cmdPlayRec.Enabled = False
cmdStopPlaying.Enabled = False
cmdStopRec.Enabled = False

lblTIME.Caption = vbNullString
Exit Sub

errOut:
MsgBox "Unable to initialize sound card for capture. Exiting this application", vbOKOnly Or vbCritical
End
End Sub

Private Sub ConvertToSBuffer()
Dim l_captureS As Long

'' are we running?
l_captureS = dscb.GetStatus()
If (l_captureS And DSCBSTATUS_CAPTURING) then

dscb.Stop
End If

'' get the capture info
dscb.GetCurrentPosition capCURS
dsd.lBufferBytes = capCURS.lWrite * dscd.fxFormat.nBlockAlign
dsd.lFlags = DSBCAPS_CTRLVOLUME Or DSBCAPS_STATIC

If capCURS.lWrite = 0 then

Exit Sub
End If


Set dsb = ds.CreateSoundBuffer(dsd, dscd.fxFormat)
ReDim ByteBuffer(capCURS.lWrite * dscd.fxFormat.nBlockAlign + 1)
dscb.ReadBuffer 0, capCURS.lWrite * dscd.fxFormat.nBlockAlign, ByteBuffer(0), DSCBLOCK_DEFAULT
dsb.WriteBuffer 0, capCURS.lWrite * dscd.fxFormat.nBlockAlign, ByteBuffer(0), DSBLOCK_DEFAULT
''Set dscb = Nothing
End Sub

Private Function WaveEx(Hz As Long, Channels As Integer, BITS As Integer) As WAVEFORMATEX

WaveEx.nFormatTag = WAVE_FORMAT_PCM
WaveEx.nChannels = Channels
WaveEx.lSamplesPerSec = Hz
WaveEx.nBitsPerSample = BITS
WaveEx.nBlockAlign = Channels * BITS / 8
WaveEx.lAvgBytesPerSec = WaveEx.lSamplesPerSec * WaveEx.nBlockAlign
WaveEx.nSize = 0

End Function

Private Sub InitCapture()
'set the capture buffer
dsc.GetCaps cCaps

If cCaps.lFormats And WAVE_FORMAT_2M08 then

CaptureWave = WaveEx(22050, 1, 8)
else
If cCaps.lFormats And WAVE_FORMAT_1M08 then

CaptureWave = WaveEx(11025, 1, 8)
else

MsgBox "Capture is not supported with your sound card!", vbApplicationModal
End
End If


dscd.fxFormat = CaptureWave
dscd.lBufferBytes = CaptureWave.lAvgBytesPerSec * 20
dscd.lFlags = DSCBCAPS_WAVEMAPPED


Set dscb = dsc.CreateCaptureBuffer(dscd)


End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call CleanUp
End
End Sub

Private Sub CleanUp()
''Clean up all the stuff
Set dx = Nothing
Set ds = Nothing
Set dsb = Nothing
Set dsc = Nothing
Set dscb = Nothing
Erase ByteBuffer
End Sub

Private Sub mnuExit_Click()
Unload Me
End Sub

Private Sub tmrCount_Timer()
On Error Resume Next

CNT = CNT + 1

If CNT = 19 then

dscb.Stop
lblTIME.Caption = "Full"
frmMain.Refresh
tmrCount.Enabled = False

cmdSaveToFile.Enabled = True
If gfPlay then
cmdPlayRec.Enabled = True
If gfPlay then
cmdStopPlaying.Enabled = True

Exit Sub
End If

lblTIME.Caption = CNT

''check the status of the sound buffer
Dim l_sBs As Long
If Not (dsb Is Nothing) then

l_sBs = dsb.GetStatus()
If (l_sBs And DSBSTATUS_PLAYING) then

else

If cmdStartRec.Enabled = True then

tmrCount.Enabled = False
CNT = 1
lblTIME.Caption = vbNullString
cmdStopPlaying.Enabled = False
End If
End If
End If


End Sub

[]，Delphi的代码也有，不过找起来太麻烦了，先留下邮箱吧，
这几天有空我发给你我以前练手做的！

问题是要播放MP3，RM。能够断点播放，速度快慢。
SAVETOFILE干什么用啊。谢谢。

[]那个录音用的哦，呵呵，播放MP3也要代码吗？

多媒体开发方便我比较的弱。请多多指教。谢谢。

我的邮箱是 ulysses_dm@yahoo.com.cn

我现在正在考虑是用MMTOOLS还是用REALPLAYER的ACTIVEX。
anyway please give me the code.Thanks.

我已写了一个，但还没写完。

做好了，请发一份给我：fy021422@sina.com
谢谢

最近要做一个MIS项目了，这个东西只能DELAY了。
谢谢。