vbAccelerator - Contents of code file: cLameEncoder.cls

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

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_sFileIn As String
Private m_sFileOut As String
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 WavFile() As String
   WavFile = m_sFileIn
End Property
Public Property Let WavFile(ByVal Value As String)
   If (FileExists(Value)) Then
      m_sFileIn = Value
   End If
End Property

Public Property Get Mp3File() As String
   Mp3File = m_sFileOut
End Property
Public Property Let Mp3File(ByVal Value As String)
   If Not (FileExists(Value)) Then
      m_sFileOut = Value
   End If
End Property

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 Sub Encode()
   
   LameInitialise
   
   If (m_hBeStream = 0) Then
      errHandler "lameConvert", 1, False
      Exit Sub
   End If
   
On Error GoTo errorHandler
   
   Dim cReader As cWavReader
   Set cReader = createWavReader()
   
   Dim cWriter As cMp3Writer
   Set cWriter = createMp3Writer()
         
   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
   Err.Raise "createWavReader", Err.Number, Err.Description
   Set createWavReader = Nothing
   Exit Function

End Function

Private Function createWavReader() As cWavReader

   Dim cReader As New cWavReader
   ' m_dwSamples is number of 16 bit samples; wave reader works
   ' in chunks of stereo samples
   cReader.ReadBufferSize = m_dwSamples \ 2
   On Error GoTo errorHandler
   cReader.Filename = m_sFileIn
   Set createWavReader = cReader
   Exit Function
   
errorHandler:
   ' rethrow
   Err.Raise "createWavReader", Err.Number, Err.Description
   Set createWavReader = Nothing
   Exit Function
   
End Function

Private 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"
      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