VB利用DirectSoundCapture录音

'###############################################
'# #
'# DirectX-DirectSound练习程序 #
'# #
'###############################################

'在使用 DirectX 之前必须先“引用”DirectX 库函数。
'dtx为 DirectX 的对象简码

Option Explicit

Dim m_dx As New DirectX7 '声明一个 DirectX7 对象，并同时生成一个新对象；
Dim m_ds As DirectSound '声明一个 DirectSound 对象；
Dim m_dsBuffer As DirectSoundBuffer '声明一个 DirectSoundBuffer 对象；
Dim m_dscap As DirectSoundCapture '声明一个 DirectSoundCapture 对象；
'DirectSoundCapture 独立于 DirectSound,是 DirectX 中的一个组件，它允许捕获 wave 声音
Dim m_dscapBuffer As DirectSoundCaptureBuffer
'声明一个 DirectSoundCaptureBuffer 对象；
'DirectSoundCaptureBuffer 的具体属性方法：
'信息类
'GetCaps '获得 DSCBCAPS 数据结构；
'GetCurrentPosition '获取文件播放指针位置，需要使用 DSCURSORS 数据来获取
' Type DSCURSORS
' lPlay As Long '当前播放指针位置
' lWrite As Long '当前数据读取指针的位置，一般都是先读取在播放，因此该指针位置比lPlay靠后
' End Type
'GetFormat '获得 WAVEFORMATEX 数据结构；
'GetStatus '获得 CONST_DSCBSTATUSFLAGS 数据结构；
'Enum CONST_DSCBSTATUSFLAGS
' DSCBSTATUS_CAPTURING = 1 '获得当前捕获的缓存数据
' DSCBSTATUS_LOOPING = 2 '获得当前捕获的和循环捕获的缓存数据
'End Enum

'缓存控制类
'ReadBuffer '读取捕获的声音缓存
'object.ReadBuffer(start As Long,size As Long,buffer As Any,flags As CONST_DSCBLOCKFLAGS)
'start '数据读入的起始位置，字节型。
'size '设定读取数据的容量，字节型。当数据的容量超过此值时将会循环读入，
'这个参数不支持 DSCBLOCK_ENTIREBUFFER 数据结构；
'buffer '此参数为返回值，它以数组的形式出现，并从起始位置获得缓存中的数据；
'当设定 lngBuffer(0) 时，即从数组 0 开始读入数据，直到将所有数据读完为止；
'flags '读取、写入的标志，其由 CONST_DSCBLOCKFLAGS 数据结构确定；
'Enum CONST_DSCBLOCKFLAGS
' DSCBLOCK_DEFAULT = 0 '默认
' DSCBLOCK_ENTIREBUFFER = 1 '读入或写入所有缓存，若选择此选项，则 size 参数将被忽视。
'End Enum
'WriteBuffer
'object.WriteBuffer(start As Long,size As Long,buffer As Any,flags As CONST_DSCBLOCKFLAGS)
'start '数据写入的起始位置，字节型。
'size '设定写入数据的容量，字节型。当数据的容量超过此值时将会循环写入，
'这个参数不支持 DSCBLOCK_ENTIREBUFFER 数据结构；
'buffer '设置写入的数据缓存，要注意此缓存数值必须与被读取的缓存数据数组的值相匹配；
'当读取数组为 lngBuffer(0) 时，即从数组 0 开始读取数据，并向缓存入数据，直
'到将所有数据读完、写完为止；
'flags '读取写入的标志，其由 CONST_DSCBLOCKFLAGS 数据结构确定；
'Enum CONST_DSCBLOCKFLAGS
' DSCBLOCK_DEFAULT = 0 '默认
' DSCBLOCK_ENTIREBUFFER = 1 '读入或写入所有缓存，若选择此选项，则 size 参数将被忽视。
'End Enum
'通知类
'SetNotificationPositions
'代码：object.SetNotificationPositions(nElements As Long, psa() As DSBPOSITIONNOTIFY)
'nElements 为 psa() 数组的重要元素；
'psa() 为 DSBPOSITIONNOTIFY 数据结构，其结构为：
'Type DSBPOSITIONNOTIFY
' hEventNotify As Long '设置事件触发参数，若设定此参数 DirectX7.CreateEvent 将根据获得的参数被执行；
' lOffset As Long '设置是否停止录音，当需要停止时可使用 DSBPN_OFFSETSTOP 常量；
'End Type
'录音控制类
'start '开始录音
'Stop '停止录音

Dim m_dsDesc As DSBUFFERDESC '声明一个 DSBUFFERDESC 数据结构变量

Dim m_dscapDesc As DSCBUFFERDESC '声明一个 DSCBUFFERDESC 数据结构变量
'DSCBUFFERDESC 数据结构，为 DirectSoundCaptureBuffer 的格式结构，其结构为：
'Type DSCBUFFERDESC
' fxFormat As WAVEFORMATEX '声音数据结构
' lBufferBytes As Long '缓冲的字节数
' lFlags As CONST_DSCBCAPSFLAGS
'CONST_DSCBCAPSFLAGS 为 DirectSoundCaptureBuffer 提供功能列表，其结构为：
'Enum CONST_DSCBCAPSFLAGS
' DSCBCAPS_DEFAULT = 0
' DSCBCAPS_WAVEMAPPED = -2147483648# '按习惯的 Win32 方式制作声音；
'End Enum

'End Type

Dim m_dscapWaveFormat As WAVEFORMATEX '声明一个 WAVEFORMATEX 数据结构变量
Dim m_dscapCursors As DSCURSORS '声明一个 DSCURSORS 数据结构变量

Dim m_lngBuffer() As Long '声明一个整型数组变量
Dim m_dscapCaps As DSCCAPS
'DSCCAPS 数据类型为 DirectSoundCapture 专用数据类型，其结构为：
'Type DSCCAPS
' lChannels As Long '设定声道，1为单声道；2为双声道；
' lFlags As CONST_DSCCAPSFLAGS
'CONST_DSCCAPSFLAGS 为 DirectSoundCapture 提供功能列表，其结构为：
'Enum CONST_DSCCAPSFLAGS
' DSCCAPS_DEFAULT = 0 '使用DSC捕获
' DSCCAPS_EMULDRIVER = 32 '不使用DSC捕获，而使用标准波形函数捕获
'End Enum
' lFormats As CONST_WAVEFORMATFLAGS
'设定声音文件的格式，其格式为：
'WAVE_FORMAT_1M08 '11.025 kHz, mono, 8-bit
'WAVE_FORMAT_1M16 '11.025 kHz, mono, 16-bit
'WAVE_FORMAT_1S08 '11.025 kHz, stereo, 8-bit
'WAVE_FORMAT_1S16 '11.025 kHz, stereo, 16-bit
'WAVE_FORMAT_2M08 '22.05 kHz, mono, 8-bit
'WAVE_FORMAT_2M16 '22.05 kHz, mono, 16-bit
'WAVE_FORMAT_2S08 '22.05 kHz, stereo, 8-bit
'WAVE_FORMAT_2S16 '22.05 kHz, stereo, 16-bit
'WAVE_FORMAT_4M08 '44.1 kHz, mono, 8-bit
'WAVE_FORMAT_4M16 '44.1 kHz, mono, 16-bit
'WAVE_FORMAT_4S08 '44.1 kHz, stereo, 8-bit
'WAVE_FORMAT_4S16 '44.1 kHz, stereo, 16-bit
'End Type

Dim blnPlay As Boolean '播放开关

Private Sub cmdPlay_Click()

'<<获取捕获信息
'获得缓存中的两个指针位置，并返回给 m_dscapCursors
m_dscapBuffer.GetCurrentPosition m_dscapCursors
'获取捕获的字节数，缓存大大小由捕获缓存的最后写入位置即保存位置乘以
m_dsDesc.lBufferBytes = m_dscapCursors.lWrite * m_dscapDesc.fxFormat.nBlockAlign
m_dsDesc.lFlags = DSBCAPS_CTRLVOLUME Or DSBCAPS_STATIC

'当捕获的数据为 0 时，退出本过程
If m_dscapCursors.lWrite = 0 Then
Exit Sub
End If

'创建一个 DirectSoundBuffer 对象
Set m_dsBuffer = m_ds.CreateSoundBuffer(m_dsDesc, m_dscapDesc.fxFormat)

'<<开始将录音捕获缓存写入到播放缓存
'首先需要有中间数组作数据交换
'重新定义整型数组
ReDim m_lngBuffer(m_dscapCursors.lWrite * m_dscapDesc.fxFormat.nBlockAlign + 1)
'ReadBuffer '读取捕获的声音缓存
'object.ReadBuffer(start As Long,size As Long,buffer As Any,flags As CONST_DSCBLOCKFLAGS)
'start '数据读入的起始位置，字节型。
'size '设定读取数据的容量，字节型。当数据的容量超过此值时将会循环读入，
'这个参数不支持 DSCBLOCK_ENTIREBUFFER 数据结构；
'buffer '此参数为返回值，它以数组的形式出现，并从起始位置获得缓存中的数据；
'当设定 lngBuffer(0) 时，即从数组 0 开始读入数据，直到将所有数据读完为止；
'flags '读取、写入的标志，其由 CONST_DSCBLOCKFLAGS 数据结构确定；
'Enum CONST_DSCBLOCKFLAGS
' DSCBLOCK_DEFAULT = 0 '默认
' DSCBLOCK_ENTIREBUFFER = 1 '读入或写入所有缓存，若选择此选项，则 size 参数将被忽视。
'End Enum
m_dscapBuffer.ReadBuffer 0, m_dscapCursors.lWrite * m_dscapDesc.fxFormat.nBlockAlign, m_lngBuffer(0), DSCBLOCK_DEFAULT

'WriteBuffer
'object.WriteBuffer(start As Long,size As Long,buffer As Any,flags As CONST_DSCBLOCKFLAGS)
'start '数据写入的起始位置，字节型。
'size '设定写入数据的容量，字节型。当数据的容量超过此值时将会循环写入，
'这个参数不支持 DSCBLOCK_ENTIREBUFFER 数据结构；
'buffer '设置写入的数据缓存，要注意此缓存数值必须与被读取的缓存数据数组的值相匹配；
'当读取数组为 lngBuffer(0) 时，即从数组 0 开始读取数据，并向缓存入数据，直
'到将所有数据读完、写完为止；
'flags '读取写入的标志，其由 CONST_DSCBLOCKFLAGS 数据结构确定；
'Enum CONST_DSCBLOCKFLAGS
' DSCBLOCK_DEFAULT = 0 '默认
' DSCBLOCK_ENTIREBUFFER = 1 '读入或写入所有缓存，若选择此选项，则 size 参数将被忽视。
'End Enum
m_dsBuffer.WriteBuffer 0, m_dscapCursors.lWrite * m_dscapDesc.fxFormat.nBlockAlign, m_lngBuffer(0), DSBLOCK_DEFAULT
'完成将录音捕获缓存写入到播放缓存>>

'当缓存内没有数据时，退出本过程；
If m_dsBuffer Is Nothing Then
Exit Sub
End If

'播放录制的声音
m_dsBuffer.Play DSBPLAY_DEFAULT

'保存按钮可用
cmdSave.Enabled = True

End Sub

Private Sub cmdSave_Click()

'当缓存内没有数据时推出本过程
'If m_dsBuffer Is Null Then
'Exit Sub
'End If

'保存文件
m_dsBuffer.SaveToFile App.Path + "\Record.wav"

End Sub

Private Sub cmdStarRecord_Click()

'开始录音
m_dscapBuffer.start DSCBSTART_DEFAULT

'修改声音播放标志
blnPlay = True
'播放按钮不可用
cmdPlay.Enabled = False

End Sub

Private Sub cmdStopRecord_Click()

'停止录音
m_dscapBuffer.Stop

'修改声音播放标志
blnPlay = False
'播放按钮不可用
cmdPlay.Enabled = True

End Sub

Private Sub Form_Load()

'当程序遇到错误时，执行错误跳出；
On Local Error GoTo ErrOut

'<<创建一个 DirectSoundCapture 对象
'代码：object.DirectSoundCaptureCreate(guid As String) As DirectSoundCapture
'其中的参数 Guid 为相应设备的全局独有标志符（Guid）。您可以通过上一段代码列举声音设备得到Guid，
'或使用空字符串来为缺省设备创建对象。
Set m_dscap = m_dx.DirectSoundCaptureCreate(vbNullString)
'若创建失败则会触发 Err 事件，Err事件的参数为
'DSERR_INVALIDPARAM 使用参数错误。
'DSERR_NOAGGREGATION 这个对象不是 COM 构架下的系统。
'DSERR_OUTOFMEMORY 没有足够的内存创建 DirectSoundCapture 对象。
'>>

'当程序遇到错误时，继续执行；
On Error Resume Next

'<< 开始创建 DirectSound 对象
'使用 DirectSoundCreate 函数来创建 DirectSound 对象：
'代码 object.DirectSoundCreate(guid As String) As DirectSound
'其中的参数 Guid 为相应设备的全局独有标志符（Guid）。您可以通过上一段代码列举声音设备得到Guid，
'或使用空字符串来为缺省设备创建对象。
Set m_ds = m_dx.DirectSoundCreate(vbNullString) '创建一个 DirectSound 对象，并使用当前默认的驱动；
'完成创建 DirectSound 对象>>

'若创建失败则会触发 Err 事件，Err事件的参数为
'DSERR_ALLOCATED 设备已经被其他独享程序使用中，请求失败。
'DSERR_INVALIDPARAM 使用参数错误。
'DSERR_NOAGGREGATION 这个对象不是 COM 构架下的系统。
'DSERR_NODRIVER 对象已经被创建，没有可用的驱动。
'DSERR_OUTOFMEMORY 没有足够的内存创建 DirectSound 对象。
If Err.Number <> 0 Then
MsgBox "不能启动 DirectSound，请检查您的声卡是否安装！"
End
End If

'<<开始初期化DirectSound
'<<i使用 SetCooperativeLevel 方法来设置 DirectSound 的优先级。
'代码 object.SetCooperativeLevel(hwnd As Long, level As CONST_DSSCLFLAGS)
'参数 hwnd 是窗口的句柄，即指定需要设置优先级的窗口；
'关于 CONST_DSSCLFLAGS 参数的说明(这里用枚举类型代码来作说明)：
'Enum CONST_DSSCLFLAGS
' DSSCL_EXCLUSIVE = 3 允许独占声音设备，会使所有后台应用程序都不发声；
' DSSCL_NORMAL = 1 与其它应用程序调节到最佳协作方式的工作方式；
' DSSCL_PRIORITY = 2 允许改变主缓冲区声音格式，音质效果较佳；
' DSSCL_WRITEPRIMARY = 4 允许直接存取。
'End Enum
m_ds.SetCooperativeLevel Me.hWnd, DSSCL_PRIORITY
'i>>
'>>

'当程序遇到错误时，执行错误跳出；
On Local Error GoTo ErrOut

'<<设置 DirectSoundCapture
'在设置 DirectSoundCapture 之前必须先设置 DSCCAPS 数据结构；
'代码：object.GetCaps(caps As DSCCAPS)
'DSCCAPS 数据类型为 DirectSoundCapture 专用数据类型，其结构为：
'Type DSCCAPS
' lChannels As Long '设定声道，1为单声道；2为双声道；
' lFlags As CONST_DSCCAPSFLAGS
'CONST_DSCCAPSFLAGS 为 DirectSoundCapture 提供详细的功能列表，其结构为：
'Enum CONST_DSCCAPSFLAGS
' DSCCAPS_DEFAULT = 0 '使用DSC捕获
' DSCCAPS_EMULDRIVER = 32 '不使用DSC捕获，而使用标准波形函数捕获
'End Enum
' lFormats As CONST_WAVEFORMATFLAGS
'设定声音文件的格式，其格式为：
'WAVE_FORMAT_1M08 '11.025 kHz, mono, 8-bit
'WAVE_FORMAT_1M16 '11.025 kHz, mono, 16-bit
'WAVE_FORMAT_1S08 '11.025 kHz, stereo, 8-bit
'WAVE_FORMAT_1S16 '11.025 kHz, stereo, 16-bit
'WAVE_FORMAT_2M08 '22.05 kHz, mono, 8-bit
'WAVE_FORMAT_2M16 '22.05 kHz, mono, 16-bit
'WAVE_FORMAT_2S08 '22.05 kHz, stereo, 8-bit
'WAVE_FORMAT_2S16 '22.05 kHz, stereo, 16-bit
'WAVE_FORMAT_4M08 '44.1 kHz, mono, 8-bit
'WAVE_FORMAT_4M16 '44.1 kHz, mono, 16-bit
'WAVE_FORMAT_4S08 '44.1 kHz, stereo, 8-bit
'WAVE_FORMAT_4S16 '44.1 kHz, stereo, 16-bit
'End Type

'设定 DSCCAPS 数据结构，DSCCAPS 是用来控制 DirectSoundCapture 结构的，因此必须先设定；
m_dscapCaps.lChannels = 2 '设定声道为双声道；
m_dscapCaps.lFlags = DSCCAPS_DEFAULT '使用DSC捕获
m_dscapCaps.lFormats = WAVE_FORMAT_2S08 '22.05 kHz, stereo, 8-bit
'获得控制结构
m_dscap.GetCaps m_dscapCaps
'>>

'<<创建 DirectSoundCaptureBuffer 对象
'在创建 DirectSoundCaptureBuffer 对象之前，必须先完成 DSCBUFFERDESC 的设置，而设置 DSCBUFFERDESC 必须先
'设定 WAVEFORMATEX 数据结构。

'设置 WAVEFORMATEX 数据结构，用来定义声音结构；
m_dscapWaveFormat.nFormatTag = WAVE_FORMAT_PCM '设定声音的格式；
m_dscapWaveFormat.nChannels = m_dscapCaps.lChannels '设定声道，应与 m_dscapCaps 相同；
m_dscapWaveFormat.lSamplesPerSec = 22050 '设定声音的频率，应与 m_dscapCaps 相同；
m_dscapWaveFormat.nBitsPerSample = 8 '设定声音为8-bit，应与 m_dscapCaps 相同；
m_dscapWaveFormat.nBlockAlign = m_dscapCaps.lChannels * 8 / 8 '设定资料区所占的byte数；
m_dscapWaveFormat.lAvgBytesPerSec = m_dscapWaveFormat.lSamplesPerSec * m_dscapWaveFormat.nBlockAlign '设定每秒的数据流量；
m_dscapWaveFormat.nSize = 0

'<<i设置 DSCBUFFERDESC 数据结构
'DSCBUFFERDESC 数据结构，为 DirectSoundCaptureBuffer 的格式结构，其结构为：
'Type DSCBUFFERDESC
' fxFormat As WAVEFORMATEX '声音数据结构
' lBufferBytes As Long '缓冲的字节数
' lFlags As CONST_DSCBCAPSFLAGS
'CONST_DSCBCAPSFLAGS 为 DirectSoundCaptureBuffer 提供功能列表，其结构为：
'Enum CONST_DSCBCAPSFLAGS
' DSCBCAPS_DEFAULT = 0
' DSCBCAPS_WAVEMAPPED = -2147483648# '按习惯的 Win32 方式制作声音；
'End Enum
'End Type
m_dscapDesc.fxFormat = m_dscapWaveFormat '获得 WAVEFORMATEX 声音数据结构
m_dscapDesc.lBufferBytes = m_dscapWaveFormat.lAvgBytesPerSec * 20 '设定缓存的字节数
m_dscapDesc.lFlags = DSCBCAPS_WAVEMAPPED '按习惯的 Win32 方式制作声音；
'i>>

'创建 DirectSoundCaptureBuffer 对象
'代码：object.CreateCaptureBuffer( bufferDesc As DSCBUFFERDESC) As DirectSoundCaptureBuffer
Set m_dscapBuffer = m_dscap.CreateCaptureBuffer(m_dscapDesc)

'>>

Exit Sub

ErrOut:

'错误处理
If Err.Number <> 0 Then
MsgBox "不能启动 DirectSound，请检查您的声卡是否安装！"
End
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)

Set m_dx = Nothing
Set m_ds = Nothing
Set m_dsBuffer = Nothing
Set m_dscap = Nothing
Set m_dscapBuffer = Nothing
End Sub