Attribute VB_Name = "modWinamp"

Option Base 0
Option Explicit
Option Compare Text

Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Const WM_WA_IPC As Long = &H400
Private Const WM_COMMAND As Long = &H111
Private Const IPC_GETOUTPUTTIME As Long = &H69
Private Const IPC_SETPLAYLISTPOS As Long = &H79
Private Const IPC_SETVOLUME As Long = &H7A
Private Const IPC_GETINFO As Long = &H7E
Private Const WINAMP_BUTTON1 As Long = &H9C6C
Private Const WINAMP_BUTTON2 As Long = &H9C6D
Private Const WINAMP_BUTTON3 As Long = &H9C6E
Private Const WINAMP_BUTTON4 As Long = &H9C6F
Private Const WINAMP_BUTTON5 As Long = &H9C70
Private WinampPath As String
Private WinampHandle As Long

Private Function ConvertTime(ByVal TimeSeconds As Long) As String
Dim Minutes As Long, Seconds As Long, tTime As Double
    tTime = TimeSeconds / 60
    Minutes = Int(tTime)
    Seconds = Int((tTime - Minutes) * 60)
    If Minutes < 10 Then
        ConvertTime = "0" & Minutes
    Else
        ConvertTime = Minutes
    End If
    If Seconds < 10 Then
        ConvertTime = ConvertTime & ":0" & Seconds
    Else
        ConvertTime = ConvertTime & ":" & Seconds
    End If
End Function

Private Function ParseVolume(ByVal Volume As Integer) As Long
    ParseVolume = Int(Volume * 2) + Int(Volume / 2) + Int(Volume Mod 16) + 1
End Function

Private Function InitWinamp() As Boolean
    WinampHandle = FindWindowA("Winamp v1.x", vbNullString)
    If WinampHandle Then InitWinamp = True
End Function

Public Sub LoadWinamp(Optional ByVal NoShell As Boolean)
Dim bKey As Long
    WinampPath = String$(256, vbNullChar)
    RegOpenKey &H80000001, "SOFTWARE\Winamp", bKey
    RegQueryValueEx bKey, vbNullString, 0, 1, WinampPath, 256
    RegCloseKey bKey
    WinampPath = TrimString(WinampPath)
    If Not NoShell Then Shell WinampPath & "\Winamp.exe", vbMinimizedNoFocus
    InitWinamp
End Sub

Public Sub QuitWinamp()
    If InitWinamp Then PostMessage WinampHandle, &H10, 0, 0
End Sub

Public Function GetSong() As String
Dim strReturn As String
    If InitWinamp Then
        strReturn = String$(256, vbNullChar)
        GetWindowText WinampHandle, strReturn, 256
        strReturn = TrimString(strReturn)
        GetSong = Left$(strReturn, InStr(strReturn, " - Winamp"))
        If GetSong <> vbNullString Then
            GetSong = GetSong & "[" & ConvertTime(GetCurrentSongPosition / 1000) & "/" & _
            ConvertTime(GetSongLength) & "] [" & GetBitrate & " kbps/" & GetSamplerate & " khz]"
        Else
            GetSong = "No song is playing."
        End If
    Else
        GetSong = "Winamp is not loaded."
    End If
End Function

Private Function GetCurrentSongPosition() As Long
    If InitWinamp Then GetCurrentSongPosition = SendMessage(WinampHandle, WM_WA_IPC, 0, IPC_GETOUTPUTTIME)
End Function

Private Function GetSongLength() As Long
    If InitWinamp Then GetSongLength = SendMessage(WinampHandle, WM_WA_IPC, 1, IPC_GETOUTPUTTIME)
End Function

Private Function GetSamplerate() As Long
    If InitWinamp Then GetSamplerate = SendMessage(WinampHandle, WM_WA_IPC, 0, IPC_GETINFO)
End Function

Private Function GetBitrate() As Long
    If InitWinamp Then GetBitrate = SendMessage(WinampHandle, WM_WA_IPC, 1, IPC_GETINFO)
End Function

Private Function SetPlayListPosition(Position As Integer) As Long
    If InitWinamp Then SetPlayListPosition = SendMessage(WinampHandle, WM_WA_IPC, Position, IPC_SETPLAYLISTPOS)
End Function

Public Function SetVolume(Volume As Integer) As Long
    If InitWinamp Then SetVolume = SendMessage(WinampHandle, WM_WA_IPC, ParseVolume(Volume), IPC_SETVOLUME)
End Function

Public Function PreviousTrack() As Long
    If InitWinamp Then PreviousTrack = SendMessage(WinampHandle, WM_COMMAND, WINAMP_BUTTON1, 0)
End Function

Public Function PlaySong(Optional ByVal Track As String) As Long
    If Track <> vbNullString Then
        If Not InitWinamp Then LoadWinamp
        If IsNumeric(Track) Then
            SetPlayListPosition CInt(Track) - 1
        Else
            Dim FF As Integer, b As String, i As Integer
            FF = FreeFile
            If WinampPath = vbNullString Then LoadWinamp True
            Open WinampPath & "\Winamp.m3u" For Input As #FF
                Do Until EOF(FF)
                    Line Input #FF, b
                    If Left$(b, 4) <> "#EXT" Then
                        b = StrReverse(b)
                        b = Left$(b, InStr(b, "\") - 1)
                        b = StrReverse(Mid$(b, InStr(b, ".") + 1))
                        If InStr(LCase$(b), LCase$(Track)) Then
                            SetPlayListPosition i
                            Exit Do
                        End If
                        i = i + 1
                    End If
                Loop
            Close #FF
        End If
    End If
    If InitWinamp Then PlaySong = SendMessage(WinampHandle, WM_COMMAND, WINAMP_BUTTON2, 0)
End Function

Public Function PauseSong() As Long
    If InitWinamp Then PauseSong = SendMessage(WinampHandle, WM_COMMAND, WINAMP_BUTTON3, 0)
End Function

Public Function StopSong() As Long
    If InitWinamp Then StopSong = SendMessage(WinampHandle, WM_COMMAND, WINAMP_BUTTON4, 0)
End Function

Public Function NextTrack() As Long
    If InitWinamp Then NextTrack = SendMessage(WinampHandle, WM_COMMAND, WINAMP_BUTTON5, 0)
End Function

Private Function TrimString(ByVal sString As String) As String
Dim i As Integer
    i = InStr(sString, vbNullChar)
    If i = 0 Then
        TrimString = sString
    Else
        TrimString = Left$(sString, i - 1)
    End If
End Function
