vbAccelerator - Contents of code file: cMp3Writer.cls

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

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 Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal
 lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As
 Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal
 dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer
 As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long,
 lpOverlapped As Any) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long,
 lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten
 As Long, lpOverlapped As Any) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long,
 ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal
 dwMoveMethod As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As
 Long
Private Const INVALID_HANDLE_VALUE = -1
Private Const CREATE_ALWAYS = 2
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_BEGIN = 0

Private m_hMem As Long
Private m_ptrMem As Long
Private m_sFile As String
Private m_lBufferSize As Long
Private m_hFile As Long

Private Const cErrBase = 29870

Public Sub CloseFile()
   If Not (m_hFile = 0) Then
      CloseHandle m_hFile
      m_hFile = 0
   End If
End Sub
Private Function OpenFile(ByVal sFile As String) As Long
Dim hFile As Long
Dim lErr As Long

   hFile = CreateFile(sFile, _
                 GENERIC_READ Or GENERIC_WRITE, _
                  ByVal 0&, _
                  ByVal 0&, _
                  CREATE_ALWAYS, _
                  FILE_ATTRIBUTE_NORMAL, _
                  0)
   lErr = Err.LastDllError
   If (hFile = INVALID_HANDLE_VALUE) Then
      ' error
      errHandler "OpenFile", 2
   Else
      OpenFile = hFile
   End If
End Function

Public Property Let Filename(ByVal sFile As String)
   CloseFile
   m_sFile = sFile
   If (m_hMem = 0) Then
      If Not (AllocateBuffer(m_lBufferSize)) Then
         Exit Property
      End If
   End If
   m_hFile = OpenFile(sFile)
End Property
Public Property Get Filename() As String
   Filename = m_sFile
End Property
Public Property Get BufferSize() As Long
   BufferSize = m_lBufferSize
End Property
Public Property Let BufferSize(ByVal lSize As Long)
   freeBuffer
   If (AllocateBuffer(lSize)) Then
      m_lBufferSize = lSize
   Else
      m_lBufferSize = 0
   End If
End Property
Public Property Get BufferPointer() As Long
   BufferPointer = m_ptrMem
End Property
Public Function WriteBufferToFile(ByVal lSize As Long) As Long
Dim lR As Long
Dim lBytesWritten As Long
   
   ' Validation
   If (lSize > m_lBufferSize) Then
      errHandler "WriteBufferToFile", 3
      Exit Function
   End If
   If (m_hFile = 0) Or (m_ptrMem = 0) Then
      errHandler "WriteBufferToFile", 4
      Exit Function
   End If
   
   ' Write
   lR = WriteFile( _
      m_hFile, ByVal m_ptrMem, _
      lSize, lBytesWritten, ByVal 0&)
   
   ' Check what we wrote
   If (lR = 0) Or Not (lSize = lBytesWritten) Then
      errHandler "WriteBufferToFile", 5
   End If
   
   WriteBufferToFile = lBytesWritten
   
End Function

Private Function AllocateBuffer(ByVal lSize As Long) As Long
   m_hMem = LocalAlloc(GPTR, lSize)
   If (m_hMem = 0) Then
      errHandler "AllocateBuffer", 1
      Exit Function
   End If
   m_ptrMem = LocalLock(m_hMem)
   If (m_ptrMem = 0) Then
      freeBuffer
      errHandler "AllocateBuffer", 1
      Exit Function
   End If
   AllocateBuffer = True
End Function

Private Sub freeBuffer()
   If Not (m_ptrMem = 0) Then
      LocalUnlock m_hMem
      m_ptrMem = 0
   End If
   If Not (m_hMem = 0) Then
      LocalFree m_hMem
   End If
End Sub

Private Sub errHandler(ByVal sProc As String, ByVal lErr As Long)
Dim sMsg As String
   Select Case lErr
   Case 1
      sMsg = "Unable to allocate output buffer for writing"
   Case 2
      sMsg = "Unable to open file for writing"
   Case 3
      sMsg = "Cannot write more data than is available in the buffer"
   Case 4
      sMsg = "File not open for writing"
   Case 5
      sMsg = "Failed to write buffer to file"
   End Select
   Err.Raise cErrBase + lErr, App.EXEName & "." & sProc, sMsg
End Sub


Private Sub Class_Initialize()
   m_lBufferSize = 8192
End Sub

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