|
vbAccelerator - Contents of code file: vbalMp3DataWriter_cLameEncoder.clsThis 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
|
|||
|
||||
|