Как воспроизвести .mp3 файл на Visual Basic 6.0?

Private Sub Form_Load()
Плеер. DeviceType = "WaveAudio"
Плеер. FileName = "D:\Music\nice.wav"
Плеер. Command = "Open"
Плеер. Command = "Play"
End Sub

Option Explicit
Option Base 0
 
Public Enum PTR
    [_]
End Enum
 
Private Const MPEGLAYER3_FLAG_PADDING_OFF   As Long = 2
Private Const MPEGLAYER3_FLAG_PADDING_ON    As Long = 1
Private Const WAVE_FORMAT_MPEGLAYER3        As Long = &H55
Private Const MPEGLAYER3_WFX_EXTRA_BYTES    As Long = 12
Private Const MPEGLAYER3_ID_MPEG            As Long = 1
Private Const SND_ASYNC                     As Long = &H1
Private Const SND_MEMORY                    As Long = &H4
 
Private Type MPEGLAYER3WAVEFORMAT
    wFormatTag          As Integer
    nChannels           As Integer
    nSamplesPerSec      As Long
    nAvgBytesPerSec     As Long
    nBlockAlign         As Integer
    wBitsPerSample      As Integer
    cbSize              As Integer
    wID                 As Integer
    fdwFlags            As Long
    nBlockSize          As Integer
    nFramesPerBlock     As Integer
    nCodecDelay         As Integer
End Type
 
Private Type SAFEARRAYBOUND
    cElements           As Long
    lLBound             As Long
End Type
 
Private Type SAFEARRAY1D
    cDims               As Integer
    fFeatures           As Integer
    cbElements          As Long
    cLocks              As Long
    pvData              As Long
    tBounds             As SAFEARRAYBOUND
End Type
 
Private Type TCurrencyBuffer
    c(15)               As Currency
End Type
 
Private Type TMP3Constants
    iBitrate(1, 15)     As Integer
    lSampleRate(2, 3)   As Long
End Type
 
Private Declare Function ArrPtr Lib "msvbvm60" _
                         Alias "VarPtr" ( _
                         ByRef pArr() As Any) As Long
Private Declare Function PutMemPtr Lib "msvbvm60" _
                         Alias "PutMem4" ( _
                         ByRef pDst As Any, _
                         ByRef pValue As Any) As Long
Private Declare Function PutMem4 Lib "msvbvm60" ( _
                         ByRef pDst As Any, _
                         ByVal lValue As Long) As Long
Private Declare Function memcpy Lib "kernel32" _
                         Alias "RtlMoveMemory" ( _
                         ByRef pDestination As Any, _
                         ByRef pSource As Any, _
                         ByVal lLength As Long) As Long
Private Declare Function PlaySound Lib "winmm.dll" _
                         Alias "PlaySoundW" ( _
                         ByRef pszSound As Any, _
                         ByVal hModule As Long, _
                         ByVal dwFlags As Long) As Long
                         
Private m_tMP3Constants As TMP3Constants
Private m_bFile()       As Byte
 
Public Sub Play( _
           ByVal pData As PTR, _
           ByVal lSize As Long)
    Dim tFmt        As MPEGLAYER3WAVEFORMAT
    Dim tBuf        As TCurrencyBuffer
    Dim lFullSize   As Long
    
    If Not GetFormat(pData, lSize, tFmt) Then
        Err.Raise 5, , "Unable to get MP3 format"
    End If
    
    StopPlaying
    
    lFullSize = lSize + 58
    
    ReDim m_bFile(lFullSize - 1)
    
    tBuf.c(0) = 117901.141@
    tBuf.c(1) = 233861439252950.2551@
    tBuf.c(2) = 0.003@
    tBuf.c(6) = 10715247804.416@
    
    memcpy m_bFile(0), tBuf, 58
    memcpy m_bFile(20), tFmt, &H1E
    PutMem4 m_bFile(54), lSize
    PutMem4 m_bFile(4), lFullSize - 8
    memcpy m_bFile(58), ByVal pData, lSize
    
    If PlaySound(m_bFile(0), 0, SND_ASYNC Or SND_MEMORY) = 0 Then
        Err.Raise 7, , "PlaySound failed"
    End If
    
End Sub
 
Public Sub StopPlaying()
    PlaySound ByVal 0&, 0, 0
End Sub
 
Private Function GetFormat( _
                 ByVal pData As PTR, _
                 ByVal lSize As PTR, _
                 ByRef tOut As MPEGLAYER3WAVEFORMAT) As Boolean
    Dim bData()     As Byte
    Dim tSADesc     As SAFEARRAY1D
    Dim lIndex      As Long
    Dim lTagSize    As Long
    Dim lLayer      As Long
    Dim lVersion    As Long
    Dim lBitRate    As Long
    Dim lSampleRate As Long
    Dim lPadding    As Long
    Dim lChannels   As Long
    Dim lFrameSize  As Long
    
    If pData = 0 Then
        Exit Function
    End If
    
    With tSADesc
        .cbElements = 1
        .cDims = 1
        .fFeatures = 1
        .pvData = pData
        .tBounds.cElements = lSize
        PutMemPtr ByVal ArrPtr(bData), ByVal VarPtr(tSADesc)
    End With
                     
    If lSize >= 128 Then
    
        ' // Skip ID3V1 tag
        lIndex = lSize - 128
        
        If bData(lIndex) = &H54 And bData(lIndex + 1) = &H41 And bData(lIndex + 2) = &H47 Then
            lSize = lSize - 128
        End If
        
    End If
    
    
    If lSize >= 10 Then
    
        ' // Skip ID3V2 tags from beginning
        
        If bData(0) = &H49 And bData(1) = &H44 And bData(2) = &H33 Then
            
            ' // Footer present
            If bData(5) And &H10 Then
                lSize = lSize - 10
            End If
        
            lTagSize = bData(6) * &H200000
            lTagSize = lTagSize Or (bData(7) * &H4000&)
            lTagSize = lTagSize Or (bData(8) * &H80&)
            lTagSize = lTagSize Or bData(9)
            lTagSize = lTagSize + 10
            
            lIndex = lTagSize
            lSize = lSize - lTagSize
                
        Else
        
            ' // Skip ID3V2 tags from end
            lIndex = lSize - 10
 
            If bData(lIndex + 2) = &H49 And bData(lIndex + 1) = &H44 And bData(lIndex) = &H33 Then
                
                lSize = lSize - 10
                
                lTagSize = bData(lIndex + 6) * &H200000
                lTagSize = lTagSize Or (bData(lIndex + 7) * &H4000&)
                lTagSize = lTagSize Or (bData(lIndex + 8) * &H80&)
                lTagSize = lTagSize Or bData(lIndex + 9)
                lTagSize = lTagSize + 10
            
                lSize = lSize - lTagSize
                
            End If
            
            lIndex = 0
            
        End If
    
    Else
        lIndex = 0
    End If
    
    If lSize < 4 Then
        Exit Function
    End If
    
    ' // Find a frame sync
    Do
 
        If bData(lIndex) = &HFF And (bData(lIndex + 1) And &HE0) = &HE0 Then
 
            lVersion = (bData(lIndex + 1) And &H18) \ 8
            
            If lVersion = 1 Then
                Exit Function
            End If
            
            lLayer = (bData(lIndex + 1) And &H6) \ 2
            
            If lLayer <> 1 Then
                Exit Function
            End If
            
            If lVersion = 3 Then
                lBitRate = m_tMP3Constants.iBitrate(0, (bData(lIndex + 2) And &HF0) \ &H10)
            Else
                lBitRate = m_tMP3Constants.iBitrate(1, (bData(lIndex + 2) And &HF0) \ &H10)
            End If
 
            If lVersion = 3 Then
                lSampleRate = m_tMP3Constants.lSampleRate(0, (bData(lIndex + 2) And &HC) \ &H4)
            ElseIf lVersion = 2 Then
                lSampleRate = m_tMP3Constants.lSampleRate(1, (bData(lIndex + 2) And &HC) \ &H4)
            Else
                lSampleRate = m_tMP3Constants.lSampleRate(2, (bData(lIndex + 2) And &HC) \ &H4)
            End If
            
            lPadding = (bData(lIndex + 2) And &H2) \ 2
            lChannels = -(((bData(lIndex + 3) And &HC0) \ 64) <> 3) + 1
            
            If lVersion = 3 Then
                lFrameSize = Int(144000 * lBitRate / lSampleRate) + lPadding
            Else
                lFrameSize = Int(72000 * lBitRate / lSampleRate) + lPadding
            End If
 
            With tOut
            
                .wFormatTag = WAVE_FORMAT_MPEGLAYER3
                .cbSize = MPEGLAYER3_WFX_EXTRA_BYTES
                .nChannels = lChannels
                .nAvgBytesPerSec = lBitRate * 125   ' // * 1000 / 8
                .wBitsPerSample = 0
                .nBlockAlign = 1
                .nSamplesPerSec = lSampleRate
                .nFramesPerBlock = 1
                .nCodecDelay = 0
    
                If lPadding Then
                    .fdwFlags = MPEGLAYER3_FLAG_PADDING_ON
                Else
                    .fdwFlags = MPEGLAYER3_FLAG_PADDING_OFF
                End If
 
                .wID = MPEGLAYER3_ID_MPEG
                .nBlockSize = lFrameSize
                
            End With
            
            GetFormat = True
            
            Exit Function
            
        End If
        
        lIndex = lIndex + 1
        lSize = lSize - 1
        
    Loop While lSize >= 4
 
End Function
 
Private Sub Class_Initialize()
    Dim tBuf    As TCurrencyBuffer
    
    tBuf.c(0) = 450377142658.6656@:    tBuf.c(1) = 900743977448.248@:     tBuf.c(2) = 1351114248211.6672@
    tBuf.c(3) = 1801487954948.9248@:   tBuf.c(4) = 2702228496423.3344@:   tBuf.c(5) = 3602975909897.8496@
    tBuf.c(6) = 4503737067267.712@:    tBuf.c(7) = 18941235272.0895@:     tBuf.c(8) = 4735201446.045@
    tBuf.c(9) = 10307921515.2@:        tBuf.c(10) = 13743895348.4@:       tBuf.c(11) = 3435973838.4@
        
    memcpy m_tMP3Constants.iBitrate(0, 1), tBuf.c(0), 96
    
End Sub
 
Private Sub Class_Terminate()
    StopPlaying
End Sub