调用xaudio.dll解码mp3，dsound播放（源码）

研究了xaudio的sdk包，发现vb6能很方便的调用它，所以写了这个例程，只使用了xaudio.dll的一部分函数，同理可以使用其它的。调用dsound控制发声。

以下代码，原c代码部分保留用以对照。

btw，这个东西应该是03年写的了，所以也差不多快忘了，有想研究的朋友可以去xaudio的主站下载xaudio的c的开发包对照来看。

frmMain.frm

VERSION 5.00
Begin VB.Form frmMain
   Caption         =   "Form1"
   ClientHeight    =   3675
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3675
   ScaleWidth      =   4680
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdGetInfo
      Caption         =   "GetInfo"
      Height          =   495
      Left            =   360
      TabIndex        =   5
      Top             =   3060
      Width           =   1215
   End
   Begin VB.CommandButton cmdGetTag
      Caption         =   "GetTag"
      Height          =   495
      Left            =   1740
      TabIndex        =   4
      Top             =   3060
      Width           =   1215
   End
   Begin VB.CommandButton cmdEnum
      Caption         =   "Enum"
      Height          =   495
      Left            =   3120
      TabIndex        =   3
      Top             =   2400
      Width           =   1215
   End
   Begin VB.CommandButton cmdPlay
      Caption         =   "Play"
      Height          =   495
      Left            =   1740
      TabIndex        =   2
      Top             =   2400
      Width           =   1215
   End
   Begin VB.TextBox txtLog
      Height          =   1995
      Left            =   240
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Top             =   180
      Width           =   4215
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   495
      Left            =   360
      TabIndex        =   0
      Top             =   2400
      Width           =   1215
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim dx As New DirectX7
Dim ds As DirectSound
Dim dsb As DirectSoundBuffer
Dim dsbd As DSBUFFERDESC
Dim wf As WAVEFORMATEX

Dim bPlaying As Boolean
Dim bContinue As Boolean

Dim endEvent As Long
Implements DirectXEvent

'ENUM系统所有声卡
Private Sub cmdEnum_Click()
    Dim de As DirectSoundEnum
    Dim i As Integer

    Set de = dx.GetDSEnum
    For i = 1 To de.GetCount
        txtLog.Text = txtLog.Text & de.GetGuid(i) & " " & de.GetName(i) & " " & de.GetDescription(i) & vbCrLf
    Next
    Set de = Nothing
End Sub

Private Sub cmdGetInfo_Click()
    Dim s As String
    Dim l As Long
    Dim status As Integer
    Dim t As XA_InputModule
    Dim d As XA_DecoderInfo
    Dim dp As Long
    Dim opbi As XA_OutputBufferInfo
    Dim i As Long
   

'取得XA_DecoderInfo类型变量d的指针
    dp = VarPtr(d)
'decoder_new函数要求传递上面指针的指针,该函数将XA_DecoderInfo传回dp所指
    status = decoder_new(VarPtr(dp))
    If status <> XA_SUCCESS Then
        MsgBox "can not create decoder!"
        Exit Sub
    End If
'copy到d
    CopyMemory VarPtr(d), dp, 60
   
    status = file_input_module_register(t)
    status = decoder_input_module_register(d, t)
   
    If status <> XA_SUCCESS Then MsgBox xaudio_error_string(status)
    status = decoder_input_new(d, App.Path & "/3.mp3", XA_DECODER_INPUT_AUTOSELECT)
    If status <> XA_SUCCESS Then
        MsgBox "can not create input!" & status & vbCrLf & xaudio_error_string(status)
        Exit Sub
    End If
    status = decoder_input_open(d)
    If status <> XA_SUCCESS Then
        MsgBox "can not open input!" & vbCrLf & xaudio_error_string(status)
        Exit Sub
    End If
   
    Dim mp3info As MP3InfoType
    Dim l1 As Long, l2 As Long
    Dim l3 As Single
   
    Do
        DoEvents
        status = decoder_decode(d, 0)
'需要将opbi的指针指向d结构的addr06
        CopyMemory VarPtr(opbi), d.Addr06, Len(opbi)
       
        With mp3info.WaveFormat
            .BitsPerSample = opbi.bytes_per_sample * 8
            .Channels = 2 ^ opbi.stereo
            .SamplesPerSec = opbi.sample_rate
        End With
        l1 = l1 + 1
        l2 = l2 + opbi.size
        l3 = l3 + opbi.size / (opbi.sample_rate * ((2 ^ opbi.stereo) * opbi.bytes_per_sample))
       
    Loop While status = XA_SUCCESS Or status = XA_ERROR_TIMEOUT Or status = XA_ERROR_INVALID_FRAME
   
    With mp3info
        .Frames = l1
        .ByteLength = l2
        .SecondLength = l3
    End With
   
    MsgBox "Frames: " & mp3info.Frames & vbCrLf & "Bytes: " & mp3info.ByteLength & vbCrLf & "Seconds: " & mp3info.SecondLength
   
    l = xaudio_get_api_version(XA_API_ID_SYNC)
    MsgBox "XAudio DLL Version: " & ((l / (2 ^ 16)) And &H255) & "." & ((l / (2 ^ 8)) And &H255) & "." & (l And &H255)
End Sub

Private Sub cmdGetTag_Click()
    Dim fp As Integer
    Dim mp3tag As ID3V1
    Dim SongType() As String
   
    SongType = Split(LoadResString(1001), ";")
   
    fp = FreeFile
    Open App.Path & "/4.mp3" For Binary As #fp
    Seek #fp, FileLen(App.Path & "/4.mp3") - 127
    Get #fp, , mp3tag
    Close #fp
    MsgBox RTrim(mp3tag.Title) & vbCrLf & RTrim(mp3tag.Artist) & vbCrLf & RTrim(mp3tag.Album) & _
        vbCrLf & RTrim(mp3tag.Year) & vbCrLf & RTrim(mp3tag.Comment)
End Sub

'将整个mp3读到缓冲区，然后播放
Private Sub cmdOK_Click()
    Dim s As String
    Dim l As Long
    Dim status As Integer
    Dim t As XA_InputModule
    Dim d As XA_DecoderInfo
    Dim dp As Long
    Dim opbi As XA_OutputBufferInfo
    Dim i As Long
   
    dp = VarPtr(d)
    status = decoder_new(VarPtr(dp))
    If status <> XA_SUCCESS Then
        MsgBox "can not create decoder!"
        Exit Sub
    End If
    CopyMemory VarPtr(d), dp, 60
   
    status = file_input_module_register(t)
    status = decoder_input_module_register(d, t)
   
    If status <> XA_SUCCESS Then MsgBox xaudio_error_string(status)
    status = decoder_input_new(d, App.Path & "/3.mp3", XA_DECODER_INPUT_AUTOSELECT)
    If status <> XA_SUCCESS Then
        MsgBox "can not create input!" & status & vbCrLf & xaudio_error_string(status)
        Exit Sub
    End If
    status = decoder_input_open(d)
    If status <> XA_SUCCESS Then
        MsgBox "can not open input!" & vbCrLf & xaudio_error_string(status)
        Exit Sub
    End If
   
   
'建立dsound
    Set ds = dx.DirectSoundCreate(vbNullString)
    ds.SetCooperativeLevel Me.hWnd, DSSCL_PRIORITY
   

'缓冲区
    Dim sb(100000000) As Byte
    Dim psa(0) As DSBPOSITIONNOTIFY
    
    Do
        DoEvents
        status = decoder_decode(d, 0)
        CopyMemory VarPtr(opbi), d.Addr06, Len(opbi)
        
'opbi的pcm_samples代表了解码器当前所解的mp3音频片断所在内存的指针，我们需要让缓冲区指向它
        CopyMemory VarPtr(sb(i)), opbi.pcm_samples, opbi.size
'此片断的长度
        i = i + opbi.size
       
    Loop While status = XA_SUCCESS Or status = XA_ERROR_TIMEOUT Or status = XA_ERROR_INVALID_FRAME
   
        dsbd.lFlags = DSBCAPS_CTRLVOLUME Or DSBCAPS_STATIC Or DSBCAPS_CTRLPOSITIONNOTIFY
        dsbd.lBufferBytes = i
       
        wf = MakeWaveEX(opbi.sample_rate, 2 ^ opbi.stereo, opbi.bytes_per_sample * 8)
       
        Set dsb = ds.CreateSoundBuffer(dsbd, wf)
'将缓冲区数据写到dsound的缓冲区
        dsb.WriteBuffer 0, i, sb(0), DSBLOCK_DEFAULT
        dsb.SetVolume 0
       
   
        dx.SetEvent endEvent
        psa(0).hEventNotify = endEvent
        psa(0).lOffset = i - 1
        dsb.SetNotificationPositions 1, psa()
       
       
'播放
        dsb.Play DSBPLAY_DEFAULT
        bContinue = True
   
    'l = xaudio_get_api_version(XA_API_ID_SYNC)
    'MsgBox "XAudio DLL Version: " & ((l / (2 ^ 16)) And &H255) & "." & ((l / (2 ^ 8)) And &H255) & "." & (l And &H255)
End Sub

'分段读mp3，连续播放
Private Sub cmdPlay_Click()
    Dim s As String
    Dim l As Long
    Dim status As Integer
    Dim t As XA_InputModule
    Dim d As XA_DecoderInfo
    Dim dp As Long