vbAccelerator - Contents of code file: cWinampPlugin.cls

This file is part of the download VB5 Winamp Plugin Client, which is described in the article Using WinAmp In Plugins From VB.

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

Private Enum ETrackSeekType
   SEEK_FRAME = 100
   SEEK_PERCENT = 101
   SEEK_TIME = 102
End Enum

Private Declare Function Initialise Lib "WinAmpPluginWrapper.dll" (ByVal hWnd
 As Long, ByVal strPath As String) As Long
Private Declare Sub CleanUp Lib "WinAmpPluginWrapper.dll" ()
Private Declare Function OpenStream Lib "WinAmpPluginWrapper.dll" (ByVal
 strPath As String) As Long
Private Declare Function CloseStream Lib "WinAmpPluginWrapper.dll" () As Long
Private Declare Function Read Lib "WinAmpPluginWrapper.dll" (pbData As Any,
 ByVal dwNumBytes As Long) As Long
Private Declare Function GetBufferSize Lib "WinAmpPluginWrapper.dll" () As Long

Private Declare Function GetSampleRate Lib "WinAmpPluginWrapper.dll" () As Long
Private Declare Function GetChannels Lib "WinAmpPluginWrapper.dll" () As Long
Private Declare Function GetBytesPerSample Lib "WinAmpPluginWrapper.dll" () As
 Long

Private Declare Function GetTrackTotalTime Lib "WinAmpPluginWrapper.dll" () As
 Long
Private Declare Function GetPluginCount Lib "WinAmpPluginWrapper.dll" () As Long
Private Declare Function SeekStream Lib "WinAmpPluginWrapper.dll" Alias "Seek"
 (ByVal lOff As Long, ByVal nFrom As Long) As Long


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

Private m_lCount As Long
Private m_bOpen As Boolean
Private m_lBufferSize As Long
Private m_lTotalBytes As Long
Private m_lReadBytes As Long

Private m_bBuffersAllocated As Boolean
Private m_ptrBuf() As Long
Private m_hMemBuf() As Long
Private m_iBufCount As Long

Private Const BUFFER_COUNT = 5
Private Const CHUNKS_PER_READ = 4

Public Sub Init(ByVal sPath As String, ByVal hWnd As Long)
   m_lCount = Initialise(hWnd, sPath)
End Sub

Public Function OpenFile(ByVal sFile As String) As Boolean
   
   CloseFile
   If (m_lCount > 0) Then
      If (OpenStream(sFile) <> 0) Then
         m_lBufferSize = GetBufferSize()
         If (AllocateBuffers()) Then
            m_lTotalBytes = ((GetTrackTotalTime() * 1#) * (GetSampleRate() *
             1#) * GetChannels() * 2) / 1000#
            m_lReadBytes = 0
            m_bOpen = True
            OpenFile = True
         Else
            CloseFile
         End If
      End If
   End If
   
End Function

Public Property Get FileIsOpen() As Boolean
   FileIsOpen = m_bOpen
End Property

Private Sub FreeBuffers()
Dim i As Long
   For i = 0 To m_iBufCount - 1
      If Not (m_ptrBuf(i) = 0) Then
         LocalUnlock m_hMemBuf(i)
         m_ptrBuf(i) = 0
      End If
      If Not (m_hMemBuf(i) = 0) Then
         LocalFree m_hMemBuf(i)
         m_hMemBuf(i) = 0
      End If
   Next i
End Sub

Private Function AllocateBuffers() As Boolean
Dim i As Long
Dim bFail As Boolean

   If Not (m_bBuffersAllocated) Then
      m_iBufCount = BUFFER_COUNT
      ReDim m_hMemBuf(0 To m_iBufCount - 1) As Long
      ReDim m_ptrBuf(0 To m_iBufCount - 1) As Long
      For i = 0 To m_iBufCount - 1
         m_hMemBuf(i) = LocalAlloc(GPTR, m_lBufferSize * CHUNKS_PER_READ)
         If (m_hMemBuf(i) = 0) Then
            bFail = True
            Exit For
         Else
            m_ptrBuf(i) = LocalLock(m_hMemBuf(i))
            If m_ptrBuf(i) = 0 Then
               bFail = True
               Exit For
            End If
         End If
      Next i
   
      If (bFail) Then
         FreeBuffers
      Else
         m_bBuffersAllocated = True
         AllocateBuffers = True
      End If
   Else
      AllocateBuffers = True
   End If
   
End Function

Public Sub CloseFile()
   If (m_bOpen) Then
      CloseStream
      m_bOpen = False
   End If
End Sub
Public Property Get Percent() As Long
Dim lPercent As Long
   If (m_bOpen) Then
      Percent = (TrackCurrentTime * 100) / TrackTotalTime
   Else
      Percent = 0
   End If
End Property

Public Property Get SampleRate() As Long
   If (m_bOpen) Then
      SampleRate = GetSampleRate()
   Else
      SampleRate = 0
   End If
End Property

Public Property Get Channels() As Long
   If (m_bOpen) Then
      Channels = GetChannels()
   End If
End Property

Public Sub TrackSeek(ByVal lTime As Long)
   If (m_bOpen) Then
      SeekStream lTime, SEEK_TIME
      m_lReadBytes = (lTime * 2# * GetSampleRate() * GetChannels()) / 1000#
   End If
End Sub

Public Property Get TrackTotalTime() As Long
   If (m_bOpen) Then
      TrackTotalTime = GetTrackTotalTime()
   End If
End Property

Public Property Get TrackCurrentTime() As Long
   If (m_bOpen) Then
      TrackCurrentTime = (m_lReadBytes / (GetSampleRate() * GetChannels() * 2))
       * 1000
   End If
End Property

Public Property Get PluginCount() As Long
   PluginCount = GetPluginCount()
End Property

Public Function ConvertChunk(ByVal iBuffer As Long) As Long
Dim lRead As Long
Dim lThisRead As Long
Dim lChunk As Long
Dim lPtr As Long
   
   If (m_bOpen) And (m_lReadBytes < m_lTotalBytes) Then
      lPtr = m_ptrBuf(iBuffer - 1)
      For lChunk = 1 To CHUNKS_PER_READ
         
         lThisRead = Read(ByVal lPtr, m_lBufferSize)
         
         If (lThisRead = 0) Then
            lRead = m_lTotalBytes - m_lReadBytes
            m_lReadBytes = m_lTotalBytes
            Exit For
         End If
         
         ' In some cases, the track total time is adjusted as play continues...
         m_lTotalBytes = ((GetTrackTotalTime() * 1#) * (GetSampleRate() * 1#) *
          GetChannels() * 2) / 1000#
         'Debug.Print lThisRead, m_lTotalBytes
         
         lPtr = UnsignedAdd(lPtr, lThisRead)
         lRead = lRead + lThisRead
         If (m_lReadBytes + lRead > m_lTotalBytes) Then
            lRead = m_lTotalBytes - m_lReadBytes
            Exit For
         End If
         
      Next lChunk
      
      m_lReadBytes = m_lReadBytes + lRead
               
   End If
   
   ConvertChunk = lRead
   
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

Public Property Get ReadBufferPtr(ByVal iBuffer As Long)
   If (m_bOpen) Then
      ReadBufferPtr = m_ptrBuf(iBuffer - 1)
   End If
End Property

Public Property Get BufferCount() As Long
   BufferCount = m_iBufCount
End Property

Private Sub ClearUp()
   If (m_lCount > 0) Then
      CleanUp
      m_lCount = 0
   End If
   FreeBuffers
End Sub

Private Sub Class_Terminate()
   ClearUp
End Sub