vbAccelerator - Contents of code file: cMACAudio.cls

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

'private const ID3_TAG_BYTES   128
Private Type ID3_TAG
   TagHeader As String * 3    '// should equal 'TAG'
   Title As String * 30       '// title
   Artist As String * 30      '// artist
   Album As String * 30       '// album
   Year As String * 4         '// year
   Comment As String * 29     '// comment
   Track As Byte              '// track
   Genre As Byte              '// genre
End Type

Private Type WAVEFORMATEX
   wFormatTag As Integer
   nChannels As Integer
   nSamplesPerSec As Long
   nAvgBytesPerSec As Long
   nBlockAlign As Integer
   wBitsPerSample As Integer
   cbSize As Integer
End Type

Private Type WAVE_HEADER
   '// RIFF header
   cRIFFHeader As String * 4
   nRIFFBytes As Long

   '// data type
   cDataTypeID As String * 4

   '// wave format
   cFormatHeader As String * 4
   nFormatBytes As Long

   nFormatTag As Integer
   nChannels As Integer
   nSamplesPerSec As Long
   nAvgBytesPerSec As Long
   nBlockAlign As Integer
   nBitsPerSample As Integer
   
   '// data chunk header
   cDataHeader As String * 4
   nDataBytes As Long
End Type

Public Enum EMacCompressionLevel
   COMPRESSION_LEVEL_FAST = 1000
   COMPRESSION_LEVEL_NORMAL = 2000
   COMPRESSION_LEVEL_HIGH = 3000
   COMPRESSION_LEVEL_EXTRA_HIGH = 4000
End Enum

Private Const MAC_FORMAT_FLAG_8_BIT As Long = 1           '// is 8-bit
Private Const MAC_FORMAT_FLAG_CRC As Long = 2                 '// uses the new
 CRC32 error detection
Private Const MAC_FORMAT_FLAG_HAS_PEAK_LEVEL As Long = 4      '// unsigned
 __int32 Peak_Level after the header
Private Const MAC_FORMAT_FLAG_24_BIT  As Long = 8             '// is 24-bit
Private Const MAC_FORMAT_FLAG_HAS_SEEK_ELEMENTS As Long = 16  '// has the
 number of seek elements after the peak level
Private Const MAC_FORMAT_FLAG_CREATE_WAV_HEADER As Long = 32   '// create the
 wave header on decompression (not stored)

Private Const CREATE_WAV_HEADER_ON_DECOMPRESSION  As Long = -1
Private Const MAX_AUDIO_BYTES_UNKNOWN  As Long = -1

Private Enum APE_DECOMPRESS_FIELDS
   APE_INFO_FILE_VERSION = 1000 '// version of the APE file * 1000 (3.93 =
    3930) [ignored, ignored]
   APE_INFO_COMPRESSION_LEVEL = 1001 '// compression level of the APE file
    [ignored, ignored]
   APE_INFO_FORMAT_FLAGS = 1002 ' format flags of the APE file [ignored,
    ignored]
   APE_INFO_SAMPLE_RATE = 1003 'sample rate (Hz) [ignored, ignored]
   APE_INFO_BITS_PER_SAMPLE = 1004 ' bits per sample [ignored, ignored]
   APE_INFO_BYTES_PER_SAMPLE = 1005 ' number of bytes per sample [ignored,
    ignored]
   APE_INFO_CHANNELS = 1006 ' channels [ignored, ignored]
   APE_INFO_BLOCK_ALIGN = 1007 ' block alignment [ignored, ignored]
   APE_INFO_BLOCKS_PER_FRAME = 1008 ' number of blocks in a frame (frames are
    used internally)  [ignored, ignored]
   APE_INFO_FINAL_FRAME_BLOCKS = 1009 ' blocks in the final frame (frames are
    used internally) [ignored, ignored]
   APE_INFO_TOTAL_FRAMES = 1010 ' total number frames (frames are used
    internally) [ignored, ignored]
   APE_INFO_WAV_HEADER_BYTES = 1011 ' header bytes of the decompressed WAV
    [ignored, ignored]
   APE_INFO_WAV_TERMINATING_BYTES = 1012 ' terminating bytes of the
    decompressed WAV [ignored, ignored]
   APE_INFO_WAV_DATA_BYTES = 1013 ' data bytes of the decompressed WAV
    [ignored, ignored]
   APE_INFO_WAV_TOTAL_BYTES = 1014 ' total bytes of the decompressed WAV
    [ignored, ignored]
   APE_INFO_APE_TOTAL_BYTES = 1015 ' total bytes of the APE file [ignored,
    ignored]
   APE_INFO_TOTAL_BLOCKS = 1016 ' total blocks of audio data [ignored, ignored]
   APE_INFO_LENGTH_MS = 1017 ' length in ms (1 sec = 1000 ms) [ignored, ignored]
   APE_INFO_AVERAGE_BITRATE = 1018 ' average bitrate of the APE [ignored,
    ignored]
   APE_INFO_FRAME_BITRATE = 1019 ' bitrate of specified APE frame [frame index,
    ignored]
   APE_INFO_DECOMPRESSED_BITRATE = 1020 ' bitrate of the decompressed WAV
    [ignored, ignored]
   APE_INFO_PEAK_LEVEL = 1021 ' peak audio level (-1 is unknown) [ignored,
    ignored]
   APE_INFO_SEEK_BIT = 1022 ' bit offset [frame index, ignored]
   APE_INFO_SEEK_BYTE = 1023 ' byte offset [frame index, ignored]
   APE_INFO_WAV_HEADER_DATA = 1024 ' error code [buffer *, max bytes]
   APE_INFO_WAV_TERMINATING_DATA = 1025 ' error code [buffer *, max bytes]
   APE_INFO_WAVEFORMATEX = 1026 ' error code [waveformatex *, ignored]
   APE_INFO_IO_SOURCE = 1027 ' I/O source (CIO *) [ignored, ignored]
   APE_INFO_FRAME_BYTES = 1028 ' bytes (compressed) of the frame [frame index,
    ignored]
   APE_INFO_FRAME_BLOCKS = 1029 ' blocks in a given frame [frame index, ignored]
   APE_INFO_TAG = 1030 ' point to tag (CAPETag *) [ignored, ignored]

   APE_DECOMPRESS_CURRENT_BLOCK = 2000 ' current block location [ignored,
    ignored]
   APE_DECOMPRESS_CURRENT_MS = 2001 ' current millisecond location [ignored,
    ignored]
   APE_DECOMPRESS_TOTAL_BLOCKS = 2002 ' total blocks in the decompressors range
    [ignored, ignored]
   APE_DECOMPRESS_LENGTH_MS = 2003 ' total blocks in the decompressors range
    [ignored, ignored]
   APE_DECOMPRESS_CURRENT_BITRATE = 2004 ' current bitrate [ignored, ignored]
   APE_DECOMPRESS_AVERAGE_BITRATE = 2005 ' average bitrate (works with ranges)
    [ignored, ignored]
End Enum

'// file and i/o errors (1000's)
Private Const ERROR_IO_READ As Long = 1000
Private Const ERROR_IO_WRITE As Long = 1001
Private Const ERROR_INVALID_INPUT_FILE As Long = 1002
Private Const ERROR_INVALID_OUTPUT_FILE As Long = 1003
Private Const ERROR_INPUT_FILE_TOO_LARGE As Long = 1004
Private Const ERROR_INPUT_FILE_UNSUPPORTED_BIT_DEPTH As Long = 1005
Private Const ERROR_INPUT_FILE_UNSUPPORTED_SAMPLE_RATE As Long = 1006
Private Const ERROR_INPUT_FILE_UNSUPPORTED_CHANNEL_COUNT As Long = 1007
Private Const ERROR_INPUT_FILE_TOO_SMALL As Long = 1008
Private Const ERROR_INVALID_CHECKSUM As Long = 1009
Private Const ERROR_DECOMPRESSING_FRAME As Long = 1010
Private Const ERROR_INITIALIZING_UNMAC   As Long = 1011
Private Const ERROR_INVALID_FUNCTION_PARAMETER As Long = 1012
Private Const ERROR_UNSUPPORTED_FILE_TYPE As Long = 1013
Private Const ERROR_UNSUPPORTED_FILE_VERSION As Long = 1014

'// memory errors (2000's)
Private Const ERROR_INSUFFICIENT_MEMORY As Long = 2000

'// dll errors (3000's)
Private Const ERROR_LOADINGAPE_DLL As Long = 3000
Private Const ERROR_LOADINGAPE_INFO_DLL As Long = 3001
Private Const ERROR_LOADING_UNMAC_DLL As Long = 3002

'// general and misc errors
Private Const ERROR_USER_STOPPED_PROCESSING As Long = 4000
Private Const ERROR_SKIPPED As Long = 4001

'// programmer errors
Private Const ERROR_BAD_PARAMETER As Long = 5000

'// IAPECompress errors
Private Const ERROR_APE_COMPRESS_TOO_MUCH_DATA As Long = 6000

'// unknown error
Private Const ERROR_UNDEFINED As Long = -1


'; basic functions
Private Declare Function CompressFile Lib "macdll" ( _
      ByVal pInputFile As Long, _
      ByVal pOutputFile As Long, _
      ByVal nCompressionLevel As Long, _
      ByRef pPercentageDone As Long, _
      ByVal pfnProgressCallback As Long, _
      ByRef pKillFlag As Long) As Long
Private Declare Function DecompressFile Lib "macdll" ( _
      ByVal pInputFilename As Long, _
      ByVal pOutputFilename As Long, _
      ByRef pPercentageDone As Long, _
      ByVal pfnProgressCallback As Long, _
      ByRef pKillFlag As Long) As Long
Private Declare Function ConvertFile Lib "macdll" ( _
      ByVal pInputFilename As Long, _
      ByVal pOutputFilename As Long, _
      ByVal nCompressionLevel As Long, _
      ByRef pPercentageDone As Long, _
      ByVal pfnProgressCallback As Long, _
      ByRef pKillFlag As Long) As Long
Private Declare Function VerifyFile Lib "macdll" ( _
      ByVal pInputFilename As Long, _
      ByRef pPercentageDone As Long, _
      ByVal pfnProgressCallback As Long, _
      ByRef pKillFlag As Long) As Long

'; interface wrappers
Private Declare Function c_APEDecompress_Create Lib "macdll" (ByRef pErrorCode
 As Long) As Long
Private Declare Sub c_APEDecompress_Destroy Lib "macdll" (ByVal hAPEDecompress
 As Long)
Private Declare Function c_APEDecompress_GetData Lib "macdll" (ByVal
 hAPEDecompress As Long, ByVal pData As Long, ByVal nBlocks As Long, ByRef
 pBlocksRetrieved As Long) As Long
Private Declare Function c_APEDecompress_Seek Lib "macdll" (ByVal
 hAPEDecompress As Long, ByVal nBlockOffset As Long) As Long
Private Declare Function c_APEDecompress_GetInfo Lib "macdll" (ByVal
 hAPEDecompress, field As APE_DECOMPRESS_FIELDS, ByVal nParam1 As Long, ByVal
 nParam2 As Long) As Long
'
Private Declare Function c_APECompress_Create Lib "macdll" (ByRef pErrorCode As
 Long) As Long
Private Declare Sub c_APECompress_Destroy Lib "macdll" (ByVal hApeCompress As
 Long)
Private Declare Function c_APECompress_Start Lib "macdll" (ByVal hApeCompress
 As Long, ByVal pOutputFilename As Long, _
      pwfeInput As WAVEFORMATEX, ByVal nMaxAudioBytes As Long, ByVal
       nCompressionLevel As Long, _
      ByVal pHeaderData As Long, ByVal nHeaderBytes As Long) As Long
Private Declare Function c_APECompress_AddData Lib "macdll" (ByVal hApeCompress
 As Long, ByVal pData As Long, ByVal nBytes As Long) As Long
Private Declare Function c_APECompress_GetBufferBytesAvailable Lib "macdll"
 (ByVal hApeCompress As Long) As Long
Private Declare Function c_APECompress_LockBuffer Lib "macdll" (ByVal
 hApeCompress As Long, ByRef pBytesAvailable As Long) As Long
Private Declare Function c_APECompress_UnlockBuffer Lib "macdll" (ByVal
 hApeCompress As Long, ByVal nBytesAdded As Long, ByVal bProcess As Long) As
 Long
Private Declare Function c_APECompress_Finish Lib "macdll" (ByVal hApeCompress
 As Long, ByVal pTerminatingData As Long, ByVal nTerminatingBytes As Long,
 ByVal nWAVTerminatingBytes As Long) As Long
Private Declare Function c_APECompress_Kill Lib "macdll" (ByVal hApeCompress As
 Long) As Long

'; helpers / miscellaneous
Private Declare Function GetVersionNumber Lib "macdll" () As Long
Private Declare Function GetInterfaceCompatibility Lib "macdll" (ByVal nVersion
 As Long, ByVal bDisplayWarningsOnFailure As Long, ByVal hWndParent As Long) As
 Long
Private Declare Function ShowFileInfoDialog Lib "macdll" (ByVal pFileName As
 Long, ByVal hWndWindow As Long) As Long
Private Declare Function RemoveTag Lib "macdll" (ByVal pFileName As Long) As
 Long
Private Declare Function TagFileSimple Lib "macdll" (ByVal pFileName As Long,
 ByVal pArtist As Long, ByVal pAlbum As Long, ByVal pTitle As Long, ByVal
 pComment As Long, ByVal pGenre As Long, ByVal pYear As Long, ByVal pTrack As
 Long, ByVal bClearFirst As Long, ByVal bUseOldID3 As Long) As Long
Private Declare Function GetID3Tag Lib "macdll" (ByVal pFileName As Long,
 pID3Tag As ID3_TAG) As Long
Private Declare Function FillWaveHeader Lib "macdll" (pWAVHeader As
 WAVE_HEADER, ByVal nAudioBytes As Long, pWaveFormatEx As WAVEFORMATEX, ByVal
 nTerminatingBytes As Long) As Long
Private Declare Function FillWaveFormatEx Lib "macdll" (pWaveFormatEx As
 WAVEFORMATEX, ByVal nSampleRate As Long, ByVal nBitsPerSample As Long, ByVal
 nChannels As Long) As Long

Private m_sFileNameApe As String
Private m_sFileNameWav As String

Private m_lPtrProgress As Long
Private m_pKillFlag As Long
Private m_pPercentDone As Long

Private m_eCompressionLevel As EMacCompressionLevel

Private m_bOperationInProgress As Boolean

Private m_tID3 As ID3_TAG
Private m_tID3Blank As ID3_TAG

Public Event Progress(ByVal nPercentDone As Single, ByRef bCancel As Boolean)
Public Event Complete()

Public Property Get Album() As String
   Album = nullTrim(m_tID3.Album)
End Property
Public Property Let Album(ByVal sAlbum As String)
Dim s As String
   s = String(30, 0)
   LSet s = sAlbum
   LSet m_tID3.Album = s
End Property

Public Property Get Title() As String
   Title = nullTrim(m_tID3.Title)
End Property
Public Property Let Title(ByVal sTitle As String)
Dim s As String
   s = String(30, 0)
   LSet s = sTitle
   LSet m_tID3.Title = s
End Property
Public Property Get Artist() As String
   Artist = nullTrim(m_tID3.Artist)
End Property
Public Property Let Artist(ByVal sArtist As String)
Dim s As String
   s = String(30, 0)
   LSet s = sArtist
   LSet m_tID3.Artist = s
End Property
Public Property Get Year() As String
   Year = nullTrim(m_tID3.Year)
End Property
Public Property Let Year(ByVal sYear As String)
Dim s As String
   s = String(4, 0)
   LSet s = sYear
   LSet m_tID3.Year = s
End Property
Public Property Get Comment() As String
   Comment = nullTrim(m_tID3.Comment)
End Property
Public Property Let Comment(ByVal sComment As String)
Dim s As String
   s = String(29, 0)
   LSet s = sComment
   LSet m_tID3.Comment = s
End Property
Public Property Get Track() As Byte
   Track = m_tID3.Track
End Property
Public Property Let Track(ByVal bTrack As Byte)
   m_tID3.Track = bTrack
End Property
Public Property Get Genre() As Byte
   Genre = m_tID3.Genre
End Property
Public Property Let Genre(ByVal bGenre As Byte)
   m_tID3.Genre = bGenre
End Property
Public Sub ApplyID3Tag()
   If (FileExists(m_sFileNameApe)) Then
      
      Dim b() As Byte
      b = StrConv(m_sFileNameApe, vbFromUnicode)
      ReDim Preserve b(0 To UBound(b) + 1) As Byte
      
      Dim bAlbum() As Byte
      bAlbum = StrConv(m_tID3.Album, vbFromUnicode)
      ReDim Preserve bAlbum(0 To UBound(bAlbum) + 1) As Byte
      If (UBound(bAlbum) >= 29) Then
         bAlbum(29) = 0
      End If
      
      Dim bArtist() As Byte
      bArtist = StrConv(m_tID3.Artist, vbFromUnicode)
      ReDim Preserve bArtist(0 To UBound(bArtist) + 1) As Byte
      If (UBound(bArtist) >= 29) Then
         bAlbum(29) = 0
      End If
      
      Dim bTitle() As Byte
      bTitle = StrConv(m_tID3.Title, vbFromUnicode)
      ReDim Preserve bTitle(0 To UBound(bTitle) + 1) As Byte
      If (UBound(bTitle) >= 29) Then
         bTitle(29) = 0
      End If
      
      Dim bComment() As Byte
      bComment = StrConv(m_tID3.Comment, vbFromUnicode)
      ReDim Preserve bComment(0 To UBound(bComment) + 1) As Byte
      If (UBound(bComment) >= 28) Then
         bComment(28) = 0
      End If
      
      Dim bYear() As Byte
      bYear = StrConv(m_tID3.Year, vbFromUnicode)
      ReDim Preserve bYear(0 To UBound(bYear) + 1) As Byte
      If (UBound(bYear) >= 4) Then
         bYear(4) = 0
      End If
            
      TagFileSimple _
         VarPtr(b(0)), _
         VarPtr(bArtist(0)), VarPtr(bAlbum(0)), VarPtr(bTitle(0)),
          VarPtr(bComment(0)), _
         VarPtr(m_tID3.Genre), VarPtr(bYear(0)), VarPtr(m_tID3.Track), 1, 0
         
   Else
      pErr 1, False
   End If
End Sub

Public Sub RemoveID3Tag()
   If FileExists(m_sFileNameApe) Then
      Dim b() As Byte
      b = StrConv(m_sFileNameApe, vbFromUnicode)
      ReDim Preserve b(0 To UBound(b) + 1) As Byte
      RemoveTag VarPtr(b(0))
   Else
      pErr 1, False
   End If
End Sub

Private Function nullTrim(ByVal sString As String) As String
Dim iPos As Long
Dim sT As String
   iPos = InStr(sString, vbNullChar)
   If (iPos > 0) Then
      If (iPos = 1) Then
         sT = ""
      Else
         sT = Left(sString, iPos - 1)
      End If
   Else
      sT = sString
   End If
   nullTrim = Trim(sT)
End Function

Public Property Get PercentDone() As Single
   PercentDone = m_pPercentDone / 100000#
End Property

Public Sub Cancel()
   If (m_bOperationInProgress) Then
      m_pKillFlag = 1
   End If
End Sub

Public Property Get Processing() As Boolean
   Processing = m_bOperationInProgress
End Property

Public Property Get ApeFileName() As String
   ApeFileName = m_sFileNameApe
End Property
Public Property Let ApeFileName(ByVal sFileName As String)
   LSet m_tID3 = m_tID3Blank
   m_sFileNameApe = sFileName
   If (FileExists(m_sFileNameApe)) Then
      pGetID3Tag
   End If
End Property

Private Function pGetID3Tag() As Boolean
Dim b() As Byte
Dim lR As Long
   b = StrConv(m_sFileNameApe, vbFromUnicode)
   ReDim Preserve b(0 To UBound(b) + 1) As Byte
   lR = GetID3Tag(VarPtr(b(0)), m_tID3)
   If Not (lR = 0) Then
      LSet m_tID3 = m_tID3Blank
   End If
End Function

Public Property Get WavFileName() As String
   WavFileName = m_sFileNameWav
End Property
Public Property Let WavFileName(ByVal sFileName As String)
   m_sFileNameWav = sFileName
End Property

Friend Sub SetProgressCallbackPtr(ByVal lPtr As Long)
   m_lPtrProgress = lPtr
End Sub

Friend Sub ProgressCallback(ByVal nPercentageDone As Long)
   '
   Debug.Print "Progress...", nPercentageDone
   Dim bCancel As Boolean
   bCancel = False
   RaiseEvent Progress(nPercentageDone / 100000#, bCancel)
   If (bCancel) Then
      m_pKillFlag = 1
   End If
   '
End Sub

Public Property Get MACDLLVersionNumber() As Long
   MACDLLVersionNumber = GetVersionNumber()
End Property



Public Sub ShowInfoDialog(ByVal hwnd As Long)
   If Not (FileExists(m_sFileNameApe)) Then
      pErr 1, False
   Else
      Dim b() As Byte
      b = StrConv(m_sFileNameApe, vbFromUnicode)
      ReDim Preserve b(0 To UBound(b) + 1) As Byte
      ShowFileInfoDialog VarPtr(b(0)), hwnd
   End If
End Sub

Public Function Verify() As Boolean
   
   If (m_bOperationInProgress) Then
      pErr 3, False
      Exit Function
   End If
   
   If Not (FileExists(m_sFileNameApe)) Then
      pErr 1, False
   Else
      m_bOperationInProgress = True
      
      mMACAudio.MACAudio = Me
      
      m_pPercentDone = 0
      m_pKillFlag = 0
      Dim b() As Byte
      Dim lR As Long
      b = StrConv(m_sFileNameApe, vbFromUnicode)
      ReDim Preserve b(0 To UBound(b) + 1) As Byte
      
      lR = VerifyFile(VarPtr(b(0)), m_pPercentDone, m_lPtrProgress, m_pKillFlag)
      If Not (lR = 0) Then
         If Not (lR = ERROR_USER_STOPPED_PROCESSING) Then
            pErr lR, True
         End If
      Else
         Verify = True
      End If
            
      m_bOperationInProgress = False
      RaiseEvent Complete
   End If
   
End Function

Public Function Decompress() As Boolean

   If (m_bOperationInProgress) Then
      pErr 3, False
      Exit Function
   End If

   If Not (FileExists(m_sFileNameApe)) Then
      pErr 1, False
   Else
      If (FileExists(m_sFileNameWav)) Then
         pErr 2, False
      Else
      
         m_bOperationInProgress = True
         mMACAudio.MACAudio = Me
         
         m_pPercentDone = 0
         m_pKillFlag = 0
         
         Dim bFileIn() As Byte
         bFileIn = StrConv(m_sFileNameApe, vbFromUnicode)
         ReDim Preserve bFileIn(0 To UBound(bFileIn) + 1) As Byte
         Dim bFileOut() As Byte
         bFileOut = StrConv(m_sFileNameWav, vbFromUnicode)
         ReDim Preserve bFileOut(0 To UBound(bFileOut) + 1) As Byte
         
         Dim lR As Long
         lR = DecompressFile(VarPtr(bFileIn(0)), VarPtr(bFileOut(0)), _
            m_pPercentDone, m_lPtrProgress, m_pKillFlag)
         If Not (lR = 0) Then
            If Not (lR = ERROR_USER_STOPPED_PROCESSING) Then
               pErr lR, True
            End If
         Else
            Decompress = True
         End If
         
         m_bOperationInProgress = False
         RaiseEvent Complete
      End If
   End If

End Function

Public Function Compress() As Boolean

   If (m_bOperationInProgress) Then
      pErr 3, False
      Exit Function
   End If

   If (FileExists(m_sFileNameApe)) Then
      pErr 2, False
   Else
      If Not (FileExists(m_sFileNameWav)) Then
         pErr 1, False
      Else
      
         m_bOperationInProgress = True
         mMACAudio.MACAudio = Me
         
         m_pPercentDone = 0
         m_pKillFlag = 0
         
         Dim bFileIn() As Byte
         bFileIn = StrConv(m_sFileNameWav, vbFromUnicode)
         ReDim Preserve bFileIn(0 To UBound(bFileIn) + 1) As Byte
         Dim bFileOut() As Byte
         bFileOut = StrConv(m_sFileNameApe, vbFromUnicode)
         ReDim Preserve bFileOut(0 To UBound(bFileOut) + 1) As Byte
                  
         Dim lR As Long
         lR = CompressFile(VarPtr(bFileIn(0)), VarPtr(bFileOut(0)), _
            m_eCompressionLevel, _
            m_pPercentDone, m_lPtrProgress, m_pKillFlag)
         If Not (lR = 0) Then
            If Not (lR = ERROR_USER_STOPPED_PROCESSING) Then
               pErr lR, True
            End If
         Else
            Compress = True
         End If
         
         m_bOperationInProgress = False
         RaiseEvent Complete
      End If
   End If

End Function

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

Private Sub pErr(ByVal lErr As Long, ByVal bIsMacError As Boolean)
Dim errCode As Long
Dim errDesc As String
   If (bIsMacError) Then
      errCode = &H1000& Or lErr
      errDesc = MACErrorMessage(lErr)
   Else
      Select Case lErr
      Case 1
         errCode = 53
         errDesc = "Input file not found."
      Case 2
         errCode = 58
         errDesc = "Output file already exists"
      Case 3
         errCode = 1030
         errDesc = "Existing operation in progress"
      Case 4
         errCode = 1031
         errDesc = "Incorrect compression level"
      End Select
   End If
   Err.Raise errCode, App.EXEName & ".cMACAudio", errDesc
End Sub

Private Function MACErrorMessage(ByVal lMacErrorCode As Long) As String
   Select Case lMacErrorCode
   '// file and i/o errors (1000's)
   Case ERROR_IO_READ
      MACErrorMessage = "I/O read error"
   Case ERROR_IO_WRITE
      MACErrorMessage = "I/O write error"
   Case ERROR_INVALID_INPUT_FILE
      MACErrorMessage = "Invalid input file"
   Case ERROR_INVALID_OUTPUT_FILE
      MACErrorMessage = "Invalid output file"
   Case ERROR_INPUT_FILE_TOO_LARGE
      MACErrorMessage = "Input file too large"
   Case ERROR_INPUT_FILE_UNSUPPORTED_BIT_DEPTH
      MACErrorMessage = "Input file has unsupported bit depth"
   Case ERROR_INPUT_FILE_UNSUPPORTED_SAMPLE_RATE
      MACErrorMessage = "Input file has unsupported sample rate"
   Case ERROR_INPUT_FILE_UNSUPPORTED_CHANNEL_COUNT
      MACErrorMessage = "Input file has unsupported channel count"
   Case ERROR_INPUT_FILE_TOO_SMALL
      MACErrorMessage = "Input file too small"
   Case ERROR_INVALID_CHECKSUM
      MACErrorMessage = "Invalid checksum"
   Case ERROR_DECOMPRESSING_FRAME
      MACErrorMessage = "Error decompressing frame"
   Case ERROR_INITIALIZING_UNMAC
      MACErrorMessage = "Cannot initialize UnMac.DLL"
   Case ERROR_INVALID_FUNCTION_PARAMETER
      MACErrorMessage = "Invalid function parameter"
   Case ERROR_UNSUPPORTED_FILE_TYPE
      MACErrorMessage = "Unsupported file type"
   Case ERROR_UNSUPPORTED_FILE_VERSION
      MACErrorMessage = "Unsupported file version"
   
   '// memory errors (2000's)
   Case ERROR_INSUFFICIENT_MEMORY
      MACErrorMessage = "Insufficient memory"
   '// dll errors (3000's)
   Case ERROR_LOADINGAPE_DLL
      MACErrorMessage = "Error loading MAC.DLL"
   Case ERROR_LOADINGAPE_INFO_DLL
      MACErrorMessage = "Error loading MACInfo.DLL"
   Case ERROR_LOADING_UNMAC_DLL
      MACErrorMessage = "Error loading UnMac.DLL"

   
   '// general and misc errors
   Case ERROR_USER_STOPPED_PROCESSING
      MACErrorMessage = "User stopped processing"

   Case ERROR_SKIPPED
      MACErrorMessage = "Skipped"
   
   '// programmer errors
   Case ERROR_BAD_PARAMETER
      MACErrorMessage = "Bad Parameter"

   '// IAPECompress errors
   Case ERROR_APE_COMPRESS_TOO_MUCH_DATA
      MACErrorMessage = "Too much data for APE Compress"
   
   '// unknown error
   Case ERROR_UNDEFINED
      MACErrorMessage = "Undefined error"
      
   Case Else
      MACErrorMessage = "Unrecognised/Unknown error"

   End Select
End Function

Public Property Get CompressionLevel() As EMacCompressionLevel
   CompressionLevel = m_eCompressionLevel
End Property
Public Property Let CompressionLevel(ByVal eLevel As EMacCompressionLevel)
   If (eLevel = COMPRESSION_LEVEL_EXTRA_HIGH) Or (eLevel =
    COMPRESSION_LEVEL_FAST) Or _
      (eLevel = COMPRESSION_LEVEL_HIGH) Or (eLevel = COMPRESSION_LEVEL_NORMAL)
       Then
      m_eCompressionLevel = eLevel
   Else
      pErr 4, False
   End If
End Property

Private Sub Class_Initialize()
   m_eCompressionLevel = COMPRESSION_LEVEL_NORMAL
End Sub