vbAccelerator - Contents of code file: vbalMp3DataWriter_cLameEncoder.cls

This file is part of the download VB6 Pluggable CD Ripper, which is described in the article CD Ripping in VB Part 2.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cLameEncoder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' ------------------------------------------------------------
' Name:   cLameEncoder
' Author: Steve McMahon (steve@vbaccelerator.com)
' Date:   2004-05-06
' Description:
' VB wrapper around the LAME encoder DLL API.
'
' See http://vbaccelerator.com/
' ------------------------------------------------------------

Public Enum ELameSampleRate
   eLameSampleRate32000 = 32000 'MPEG-I
   eLameSampleRate44100 = 44100 'MPEG-I
   eLameSampleRate48000 = 48000 'MPEG-I
   eLameSampleRate16000 = 16000 'MPEG-I
   eLameSampleRate22050 = 22050 'MPEG-I
   eLameSampleRate24000 = 24000 'MPEG-I
   eLameSampleRate8000 = 8000 ' MPEG-II.5
   eLameSampleRate11025 = 11025 ' MPEG-II.5
   eLameSampleRate12000 = 12000 ' MPEG-II.5
End Enum

Public Enum ELameBitRate
   ' MPEG-I and MPEG-II Bit rates
   eLameBitRate32 = 32
   eLameBitRate40 = 40
   eLameBitRate48 = 48
   eLameBitRate56 = 56
   eLameBitRate64 = 64
   eLameBitRate80 = 80
   eLameBitRate96 = 96
   eLameBitRate112 = 112
   eLameBitRate128 = 128
   eLameBitRate160 = 160
   eLameBitRate192 = 192 ' MPEG-I only
   eLameBitRate224 = 224 ' MPEG-I only
   eLameBitRate256 = 256 ' MPEG-I only
   eLameBitRate320 = 320 ' MPEG-I only
                     
   ' MPEG-II only bit rates
   eLameBitRate8 = 8
   eLameBitRate16 = 16
   eLameBitRate24 = 24
   eLameBitRate144 = 144

End Enum

Public Enum ELamePresetEncodingOption
   LQP_NOPRESET = -1

   '// QUALITY PRESETS
   LQP_NORMAL_QUALITY = 0
   LQP_LOW_QUALITY = 1
   LQP_HIGH_QUALITY = 2
   LQP_VOICE_QUALITY = 3
   LQP_R3MIX = 4 ' V3
   LQP_VERYHIGH_QUALITY = 5
   LQP_STANDARD = 6 ' V2
   LQP_FAST_STANDARD = 7 ' V2
   LQP_EXTREME = 8 ' V0
   LQP_FAST_EXTREME = 9 ' V0
   LQP_INSANE = 10 ' 320
   LQP_ABR = 11
   LQP_CBR = 12
   LQP_MEDIUM = 13 ' V4
   LQP_FAST_MEDIUM = 14 ' V4

   '// Old style prests (these are translated into the new styles)
   'LQP_PHONE = 1000
   'LQP_SW = 2000
   'LQP_AM = 3000
   'LQP_FM = 4000
   'LQP_VOICE = 5000
   'LQP_RADIO = 6000
   'LQP_TAPE = 7000
   'LQP_HIFI = 8000
   'LQP_CD = 9000
   'LQP_STUDIO = 10000

End Enum

Public Enum ELameVBRMethodOption
   VBR_METHOD_NONE = -1
   VBR_METHOD_DEFAULT = 0
   VBR_METHOD_OLD = 1
   VBR_METHOD_NEW = 2
   VBR_METHOD_ABR = 4
End Enum

Public Enum ELameVBRQualityOption
   VBR_QUALITY_0_HIGHEST = 0
   VBR_QUALITY_1_HIGH = 1
   VBR_QUALITY_2_HIGH = 2
   VBR_QUALITY_3_MID = 3
   VBR_QUALITY_4_MID = 4
   VBR_QUALITY_5_MID = 5
   VBR_QUALITY_6_MID = 6
   VBR_QUALITY_7_LOW = 7
   VBR_QUALITY_8_LOW = 8
   VBR_QUALITY_9_LOWEST = 9
End Enum

Public Enum ELameOutputModeOption

   BE_MP3_MODE_STEREO = 0
   BE_MP3_MODE_JSTEREO = 1
   BE_MP3_MODE_DUALCHANNEL = 2
   BE_MP3_MODE_MONO = 3
End Enum


Public Enum ELameMP3Version
   MPEG1 = 1
   MPEG2 = 0
End Enum

Public Enum ELameErrorCode
   BE_ERR_SUCCESSFUL = &H0
   BE_ERR_INVALID_FORMAT = &H1
   BE_ERR_INVALID_FORMAT_PARAMETERS = &H2
   BE_ERR_NO_MORE_HANDLES = &H3
   BE_ERR_INVALID_HANDLE = &H4
   BE_ERR_BUFFER_TOO_SMALL = &H5
End Enum

Private Enum EBeConfigFormat
   BE_CONFIG_MP3 = 0
   BE_CONFIG_LAME = 256
End Enum


Private Type BE_CONFIG_FORMAT_LHV1
   ' 4
   dwStructVersion As Long ' 1
   ' 8
   dwStructSize As Long ' 331
   ' 12
   dwSampleRate As ELameSampleRate
   ' 16
   dwReSampleRate As Long ' Set to 0 for encoder to decide
   ' 20
   nMode As ELameOutputModeOption ' Stereomode for MP3 file. This can be either
    BE_MP3_MODE_STEREO, BE_MP3_MODE_JSTEREO, BE_MP3_MODE_DUALCHANNEL or
    BE_MP3_MODE_MONO.
   ' 24
   dwBitRate As ELameBitRate ' For CBR, this specifies the actual bitrate, for
    VBR, it specifies the minimum bitrate
                     ' Allowed bitrates are: 32, 40, 48, 56, 64, 80, 96, 112,
                      128, 160, 192, 224, 256 and 320.for MPEG-I
                     ' Allowed bitrates are: 8, 16, 24, 32, 40, 48, 56, 64, 80,
                      96, 112, 128, 144 and 160.for MPEG-II
                     ' Note: dwBitrate is used as the minimum bitrate in the
                      case of using a VBR mode.
   ' 28
   dwMaxBitrate As Long ' When VBR mode is enabled, it specifies the maximum
    allowed bitrate (see also dwBitrate to specify the minium bitrate), for CBR
    mode this setting is ignored.
   ' 32
   nPreset As ELamePresetEncodingOption ' Keep in mind that the presets can
    overwrite some of the other settings, since it is called right before the
    encoder is initialized
   
   ' 36
   dwMpegVersion As ELameMP3Version
   ' 40
   dwPsyModel As Long 'ELamePsychoAcousticModel?
   ' 44
   dwEmphasis As Long
   
   ' 48
   bPrivate As Long ' If this is set to TRUE the Private bit in the MP3 stream
    will be set.
   ' 52
   bCRC As Long ' Set this to TRUE in order to enable CRC-checksum in the
    bitstream.
   ' 56
   bCopyright As Long ' If this is set to TRUE the Copyright bit in the MP3
    stream will be set.
   ' 60
   bOriginal As Long ' If this is set to TRUE the Original bit in the MP3
    stream will be set.
      
   ' 64
   bWriteVBRHeader As Long ' Specifes if the XING VBR header should be written
    or not. When this option is enabled, you have to call the beWriteVBRHeader
    function when encoding has been completed. Keep in mind that the VBR info
    tag can also be written for CBR encoded files, the TAG info can be useful
    for additional info like encoder delay and the like.
   ' 68
   bEnableVBR As Long
   ' 72
   nVBRQuality As ELameVBRQualityOption ' VBR quality option
   ' 76
   dwVbrAbr_bps As Long ' If the Average Bit Rate is specified, the lame
    encoder ignores the nVBRQuality settings (However, bEnableVBR must be set
    to TRUE and the format.LHV1.nVbrMethod parameter should be set to
    VBR_METHOD_ABR). The allowed range for the format.LHV1.dwVbrAbr_bps
    parameter any integer value between:
                        ' MPEG-I: 32000 .. 320000 bps
                        ' MPEG-II: 8000 .. 160000 bps
   ' 80
   nVBRMethod As ELameVBRMethodOption
   
   ' 84
   bNoBitRes As Long ' Disables the bit-resorvoir and disables the insertion of
    padded frames
   ' 88
   bStrictIso As Long
   
   ' 90
   nQuality As Integer ' Note: ELameQualitySetting, Quality Setting, HIGH BYTE
    should be NOT LOW byte, otherwhise quality is set to 5. This is done to be
    backward compatible. So to set quality to 3, you have to set the nQuality
    parameter to 0xFC03.
   
   ' 90 + 237 = 327
   bPadding(0 To 236) As Byte
   
End Type

Private Type BE_CONFIG_FORMAT
   lvh1 As BE_CONFIG_FORMAT_LHV1
End Type

Private Type BE_CONFIG  '331
   dwConfig As Long ' EBeConfigFormat, 4
   format As BE_CONFIG_FORMAT ' 327
End Type

Private Declare Function beInitStream Lib "lameencshim.dll" ( _
   beConfig As BE_CONFIG, _
   pdwSamples As Long, _
   pdwBufferSize As Long, _
   phbeStream As Long) As Long
Private Declare Function beCloseStream Lib "lameencshim.dll" ( _
   ByVal hbeStream As Long) As Long
Private Declare Function beEncodeChunk Lib "lameencshim.dll" ( _
   ByVal hbeStream As Long, _
   ByVal nSamples As Long, _
   pSamples As Any, _
   pOutput As Any, _
   pdwOutput As Long _
   ) As Long
Private Declare Function beDeinitStream Lib "lameencshim.dll" ( _
   ByVal hbeStream As Long, pOutput As Any, pdwOutput As Long) As Long

Private m_tBeConfig As BE_CONFIG
Private m_hBeStream As Long
Private m_dwSamples As Long
Private m_dwBufferSize As Long
Private m_sFileOut As String
Private m_cWriter As cMp3Writer
Private m_cVer As cLameEncoderVersion

Public Event Progress(ByVal samplesDone As Long, ByVal totalSamples As Long,
 cancel As Boolean)

Private Const cErrBase = 29770

Public Property Get Version() As cLameEncoderVersion
   If (m_cVer Is Nothing) Then
      Set m_cVer = New cLameEncoderVersion
   End If
   Set Version = m_cVer
End Property

Private Function FileExists(ByVal sFile As String) As Boolean
Dim sDir As String
   On Error Resume Next
   sDir = Dir(sFile)
   FileExists = ((Err.Number = 0) And Len(sDir) > 0)
End Function

Private Sub KillFileIfExists(ByVal sFile As String)
   On Error Resume Next
   Kill sFile
End Sub

Public Property Get EncodingPreset() As ELamePresetEncodingOption
   EncodingPreset = m_tBeConfig.format.lvh1.nPreset
End Property
Public Property Let EncodingPreset(ByVal value As ELamePresetEncodingOption)
   m_tBeConfig.format.lvh1.nPreset = value
End Property

Public Property Get BitRate() As ELameBitRate
   BitRate = m_tBeConfig.format.lvh1.dwBitRate
End Property
Public Property Let BitRate(ByVal value As ELameBitRate)
   m_tBeConfig.format.lvh1.dwBitRate = value
End Property

Public Property Get SampleRate() As ELameSampleRate
   SampleRate = m_tBeConfig.format.lvh1.dwSampleRate
End Property
Public Property Let SampleRate(ByVal value As ELameSampleRate)
   m_tBeConfig.format.lvh1.dwSampleRate = value
End Property

Public Property Get OutputMode() As ELameOutputModeOption
   OutputMode = m_tBeConfig.format.lvh1.nMode
End Property
Public Property Let OutputMode(ByVal value As ELameOutputModeOption)
   m_tBeConfig.format.lvh1.nMode = value
End Property

Public Property Get FileName() As String
   FileName = m_sFileOut
End Property

Public Sub OpenFile(ByVal sFile As String)
   KillFileIfExists sFile
   m_sFileOut = sFile
   LameInitialise
   If (m_hBeStream = 0) Then
      errHandler "lameConvert", 1, False
      Exit Sub
   End If
   Set m_cWriter = createMp3Writer()
End Sub

Public Property Get BufferSize() As Long
   BufferSize = m_dwBufferSize \ 2
End Property

Public Function WriteData(ByVal lPtrBuffer As Long, ByVal lSize As Long) As Long
   
   If Not (m_cWriter Is Nothing) Then
      Dim lRemaining As Long
      Dim dwWrite As Long
      Dim eErr As ELameErrorCode
      
      eErr = beEncodeChunk(m_hBeStream, _
            lSize \ 2, _
            ByVal lPtrBuffer, _
            ByVal m_cWriter.BufferPointer, dwWrite)
      m_cWriter.WriteBufferToFile dwWrite
      
      errHandler "WriteData", eErr, True
      
      WriteData = (dwWrite = lSize)
      
   End If
   
End Function

Public Sub CloseFile()
Dim dwWrite As Long
Dim eErr As ELameErrorCode
   If Not (m_hBeStream = 0) Then
      ' Here we need to check for any left over buffer
   
      eErr = beDeinitStream(m_hBeStream, ByVal m_cWriter.BufferPointer, dwWrite)
      errHandler "lameConvert", eErr, True
      m_cWriter.WriteBufferToFile dwWrite
      m_cWriter.CloseFile
   End If
   Set m_cWriter = Nothing
End Sub


'   Dim eErr As ELameErrorCode
'   Dim dwWrite As Long
'   Dim samplesDone As Long
'   Dim cancel As Boolean
'
'   Do While (cReader.Read() And Not (cancel))
'      eErr = beEncodeChunk(m_hBeStream, _
'         cReader.ReadBufferSize * 2, _
'         ByVal cReader.ReadBufferPtr, _
'         ByVal cWriter.BufferPointer, dwWrite)
'      errHandler "lameConvert", eErr, True
'
'      cWriter.WriteBufferToFile dwWrite
'
'      samplesDone = samplesDone + cReader.ReadBufferSize * 2
'      RaiseEvent Progress(samplesDone, cReader.AudioLength * 2, cancel)
'   Loop
'
'   If Not (cancel) Then
'      eErr = beDeinitStream(m_hBeStream, ByVal cWriter.BufferPointer, dwWrite)
'      errHandler "lameConvert", eErr, True
'      cWriter.WriteBufferToFile dwWrite
'      RaiseEvent Progress(cReader.AudioLength * 2, cReader.AudioLength * 2,
 cancel)
'      cWriter.CloseFile
'   Else
'      cWriter.CloseFile
'      KillFileIfExists cWriter.Filename
'   End If
'
'   Set cWriter = Nothing
'   Set cReader = Nothing
'   LameClose
'
'   Exit Sub
'
'errorHandler:
'   ' Clean up:
'   Dim lErr As Long
'   Dim sErr As String
'   lErr = Err.Number
'   sErr = Err.Description
'   On Error Resume Next
'   Set cWriter = Nothing
'   Set cReader = Nothing
'   LameClose
'   On Error GoTo 0
'   ' rethrow
'   Err.Raise lErr, App.EXEName & ".lameConvert", sErr
'   Exit Sub
'
'End Sub

Private Sub LameInitialise()
Dim eErr As ELameErrorCode
   LameClose
   
   eErr = beInitStream(m_tBeConfig, m_dwSamples, m_dwBufferSize, m_hBeStream)
   If (eErr <> BE_ERR_SUCCESSFUL) Then
      m_dwSamples = 0
      m_dwBufferSize = 0
      m_hBeStream = 0
   End If
   errHandler "lameInit", eErr, True
   
End Sub

Private Sub LameClose()
Dim eErr As ELameErrorCode

   If (m_hBeStream) Then
      eErr = beCloseStream(m_hBeStream)
      m_hBeStream = 0
      m_dwSamples = 0
      m_dwBufferSize = 0
      errHandler "lameClose", eErr, True
   End If
   
End Sub

Private Function createMp3Writer() As cMp3Writer
   
   Dim cWriter As New cMp3Writer
   On Error GoTo errorHandler
   cWriter.BufferSize = m_dwBufferSize
   cWriter.FileName = m_sFileOut
   Set createMp3Writer = cWriter
   Exit Function
   
errorHandler:
   ' rethrow
   Dim lErr As Long
   Dim sErr As String
   lErr = Err.Number: sErr = Err.Description
   Set cWriter = Nothing
   Err.Raise lErr, "createMp3Writer", sErr
   
   Exit Function

End Function


Public Sub errHandler(ByVal sProc As String, ByVal lErr As Long, ByVal
 bLameError As Boolean)
Dim sMsg As String
   If (bLameError) Then
      Select Case lErr
      Case BE_ERR_SUCCESSFUL
         Exit Sub
      Case BE_ERR_INVALID_FORMAT
         sMsg = "Invalid Format"
      Case BE_ERR_INVALID_FORMAT_PARAMETERS
         sMsg = "Invalid Format Parameters"
      Case BE_ERR_NO_MORE_HANDLES
         sMsg = "Out of LAME handles"
      Case BE_ERR_INVALID_HANDLE
         sMsg = "LAME handle is invalid"
      Case BE_ERR_BUFFER_TOO_SMALL
         sMsg = "Buffer is too small"
      End Select
   Else
      Select Case lErr
      Case 1
         sMsg = "Lame engine not initialised"
      Case 7
         sMsg = "Unable to allocate memory"
      End Select
   End If
   Err.Raise cErrBase + lErr, App.EXEName & "." & sProc, sMsg
End Sub

Private Sub Class_Initialize()
   ' Set up default configuration
   With m_tBeConfig
      .dwConfig = BE_CONFIG_LAME
      With .format.lvh1
         .dwStructVersion = 1
         .dwStructSize = 331
         .dwSampleRate = eLameSampleRate44100
         .dwReSampleRate = 0
         .nMode = BE_MP3_MODE_JSTEREO
         .dwBitRate = eLameBitRate128
         .nPreset = LQP_R3MIX
         .dwMpegVersion = MPEG1
         .dwPsyModel = 0
         .dwEmphasis = 0
         .bOriginal = 1
         .bWriteVBRHeader = 1
         .bNoBitRes = 1
      End With
   End With
End Sub

Private Sub Class_Terminate()
   On Error Resume Next ' don't throw in terminate
   LameClose
End Sub