vbAccelerator - Contents of code file: vbalMp3DataWriter_cMp3FileDataWriter.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
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cMp3FileDataWriter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

' ------------------------------------------------------------
' Name:   cMP3FileDataWriter
' Author: Steve McMahon (steve@vbaccelerator.com)
' Date:   2004-05-06
' Description:
' Chunked data writer wrapper around cLameEncoder class.
' Deals with the case when the chunks have a different size
' (smaller/larger) than the chunk size that the LAME encoder
' expects.
'
' See http://vbaccelerator.com/
' ------------------------------------------------------------

Private Const GMEM_FIXED = &H0
Private Const GMEM_ZEROINIT = &H40
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)
Private Declare Function LocalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal
 wBytes As Long) As Long
Private Declare Function LocalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function LocalUnlock Lib "kernel32" (ByVal hMem As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Implements IWaveDataWriter
Implements IPluginInformation

Private m_cLame As cLameEncoder
Private m_ptrOverflow As Long
Private m_hMemOverflow As Long
Private m_lOverflowSize As Long
Private m_lOverflowUsed As Long

Private m_sTitle As String
Private m_sArtist As String
Private m_sAlbum As String
Private m_sYear As String
Private m_sGenre As String
Private m_sComment As String
Private m_sTrack As String

Private Sub Class_Terminate()
   IWaveDataWriter_CloseFile
End Sub

Private Property Get IPluginInformation_Configuration() As
 vbalCDRipInterfaces6.IPluginConfig
   Set IPluginInformation_Configuration = New cLameConfig
End Property

Private Property Get IPluginInformation_PluginAcknowledgements(ByVal locale As
 String) As String
Dim sAck As String
Dim c As New cLameEncoder
   sAck = "This plugin uses the LAME MP3 encoder from " & c.Version.HomePage
   IPluginInformation_PluginAcknowledgements = sAck
End Property

Private Property Get IPluginInformation_PluginAuthor(ByVal locale As String) As
 String
   IPluginInformation_PluginAuthor = "Steve McMahon (steve@vbaccelerator.com)"
End Property

Private Property Get IPluginInformation_PluginDescription(ByVal locale As
 String) As String
Dim sDesc As String
Dim c As New cLameEncoder
   sDesc = "Writes VBR-encoded MP3 files using the LAME MP3 encoder."
   With c.Version
      sDesc = sDesc & vbCrLf & vbCrLf & "   Using LAME encoder version: "
      sDesc = sDesc & .MajorVersion & "." & .MinorVersion
      sDesc = sDesc & vbCrLf & "   Release Date: " & format(.ReleaseDate,
       "short date")
      sDesc = sDesc & vbCrLf & "   Home page: " & .HomePage
   End With
   IPluginInformation_PluginDescription = sDesc
End Property

Private Property Get IPluginInformation_PluginName(ByVal locale As String) As
 String
   IPluginInformation_PluginName = "MP3 Encoder"
End Property

Private Property Get IPluginInformation_PluginWebsite(ByVal locale As String)
 As String
   IPluginInformation_PluginWebsite = "http://vbaccelerator.com/"
End Property

Private Property Let IWaveDataWriter_Album(ByVal RHS As String)
   '
   m_sAlbum = RHS
   '
End Property

Private Property Let IWaveDataWriter_Artist(ByVal RHS As String)
   '
   m_sArtist = RHS
   '
End Property

Private Sub IWaveDataWriter_CloseFile()
   '
   If Not (m_cLame Is Nothing) And Not (m_ptrOverflow = 0) Then
   
      ' Flush anything left
      If (m_lOverflowUsed > 0) Then
         m_cLame.WriteData m_ptrOverflow, m_lOverflowUsed
         m_lOverflowUsed = 0
      End If
      
      ' Flush the MP3
      m_cLame.CloseFile
      
      WriteTags m_cLame.FileName
   
   End If
   
   If Not (m_ptrOverflow = 0) Then
      LocalUnlock m_ptrOverflow
      m_ptrOverflow = 0
   End If
   If Not (m_hMemOverflow = 0) Then
      LocalFree m_hMemOverflow
      m_hMemOverflow = 0
   End If
   m_lOverflowUsed = 0
   m_lOverflowSize = 0
   '
End Sub

Private Property Let IWaveDataWriter_Comment(ByVal RHS As String)
   '
   m_sComment = RHS
   '
End Property

Private Property Get IWaveDataWriter_FileExtension() As String
   '
   IWaveDataWriter_FileExtension = "mp3"
   '
End Property

Private Property Let IWaveDataWriter_Genre(ByVal RHS As String)
   '
   m_sGenre = RHS
   '
End Property

Private Function IWaveDataWriter_OpenFile(ByVal sSoundFile As String) As Boolean
   '
   IWaveDataWriter_CloseFile
   
   Set m_cLame = New cLameEncoder
   m_cLame.EncodingPreset = LQP_STANDARD
   
   On Error Resume Next
   m_cLame.OpenFile sSoundFile
   Dim lErr As Long, sErr As String
   lErr = Err.Number
   sErr = Err.Description
   If (Err.Number = 0) Then
      On Error GoTo 0
      m_lOverflowSize = m_cLame.BufferSize
      m_hMemOverflow = LocalAlloc(GPTR, m_lOverflowSize)
      If Not (m_hMemOverflow = 0) Then
         m_ptrOverflow = LocalLock(m_hMemOverflow)
         If Not (m_ptrOverflow = 0) Then
            IWaveDataWriter_OpenFile = True
            Exit Function
         Else
            LocalFree m_hMemOverflow
            m_hMemOverflow = 0
         End If
      End If
      m_lOverflowSize = 0
      On Error GoTo 0
      m_cLame.errHandler "IWaveDataWriter_OpenFile", 7, False
   Else
      m_lOverflowSize = 0
      On Error GoTo 0
      Err.Raise lErr, "IWaveDataWriter_OpenFile", sErr
   End If
   '
End Function

Private Property Let IWaveDataWriter_Title(ByVal RHS As String)
   '
   m_sTitle = RHS
   '
End Property

Private Property Let IWaveDataWriter_TrackNumber(ByVal RHS As String)
   '
   m_sTrack = RHS
   '
End Property

Private Function IWaveDataWriter_WriteWavData(ByVal lPtrBuff As Long, ByVal
 lWriteSize As Long) As Long
   '
   If Not (m_cLame Is Nothing) And Not (m_ptrOverflow = 0) Then
      
      ' Append to overflow if we can:
      If (m_lOverflowUsed > 0) Then
         If (lWriteSize + m_lOverflowUsed > m_lOverflowSize) Then
         Dim ptrOffset As Long
            ptrOffset = UnsignedAdd(m_ptrOverflow, m_lOverflowUsed)
         Dim lAppendSize As Long
            lAppendSize = m_lOverflowSize - m_lOverflowUsed
            CopyMemory ByVal ptrOffset, ByVal lPtrBuff, lAppendSize
         
            ' Write overflow:
            m_cLame.WriteData m_ptrOverflow, m_lOverflowSize
            m_lOverflowUsed = 0
         
            ' Advance the pointer
            lPtrBuff = UnsignedAdd(lPtrBuff, lAppendSize)
            lWriteSize = lWriteSize - lAppendSize
         End If
      End If
            
      ' Write out any full chunks
      Do While (lWriteSize > m_lOverflowSize)
         ' Write the data:
         m_cLame.WriteData lPtrBuff, m_lOverflowSize
         ' Advance the pointer:
         lPtrBuff = UnsignedAdd(lPtrBuff, m_lOverflowSize)
                  
         lWriteSize = lWriteSize - m_lOverflowSize
         
      Loop
      
      ' Append anything that's left over to the overflow buffer
      If (lWriteSize > 0) Then
         CopyMemory ByVal m_ptrOverflow, ByVal lPtrBuff, lWriteSize
         m_lOverflowUsed = lWriteSize
      End If
   
   End If
   '
End Function

Private Function UnsignedAdd(Start As Long, Incr As Long) As Long
' This function is useful when doing pointer arithmetic,
' but note it only works for positive values of Incr

   If Start And &H80000000 Then 'Start < 0
      UnsignedAdd = Start + Incr
   ElseIf (Start Or &H80000000) < -Incr Then
      UnsignedAdd = Start + Incr
   Else
      UnsignedAdd = (Start + &H80000000) + (Incr + &H80000000)
   End If
   
End Function

Private Property Let IWaveDataWriter_Year(ByVal RHS As String)
   '
   m_sYear = RHS
   '
End Property


Private Sub WriteTags(ByVal sFile As String)
   
   Dim cID3v1 As New cMP3ID3v1
   cID3v1.MP3File = sFile
   cID3v1.Album = m_sAlbum
   cID3v1.Artist = m_sArtist
   cID3v1.Comment = m_sComment
   ' cID3v1.Genre TODO
   cID3v1.Title = m_sTitle
   cID3v1.Track = m_sTrack
   cID3v1.Year = m_sYear
   cID3v1.Update
   
   Dim cID3v2 As New cMP3ID3v2
   cID3v2.MP3File = sFile
   cID3v2.Album = m_sAlbum
   cID3v2.Artist = m_sArtist
   cID3v2.Comment = m_sComment
   cID3v2.EncodedBy = "vbAccelerator CD Ripper"
   cID3v2.Title = m_sTitle
   cID3v2.Track = m_sTrack
   cID3v2.Year = m_sYear
   
   cID3v2.Update
   
End Sub