Attribute VB_Name = "WinampControl"
'This Module by Alex Vallat 2000.  Adapted from frontend.txt provided with Winamp
'Homepage - http://www.ByAlexV.com/ (Check out the Winamp Stuff area, in the Other Stuff section
'This file is provided As Is.  Don't blame me if it doesn't work.  Do email me if you like, at AlexV@ComPorts.com
Option Explicit
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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName 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 Const WM_COMMAND = &H111
Private Const WM_COPYDATA = &H4A
Private Type COPYDATASTRUCT
        dwData As Long
        cbData As Long
        lpData As Long
End Type
Private Const WM_WA_IPC = &H400
Private Const IPC_GETVERSION = 0
Private Const IPC_PLAYFILE = 100
Private Const IPC_DELETE = 101
Private Const IPC_STARTPLAY = 102
Private Const IPC_CHDIR = 103
Private Const IPC_ISPLAYING = 104
Public Enum PlayStatus
    Stopped = 0
    Playing = 1
    Undefined = 2
    Paused = 3
End Enum
Private Const IPC_GETOUTPUTTIME = 105
Private Const IPC_JUMPTOTIME = 106
Public Enum JumpResult
    NotPlaying = -1
    EndOfSong = 1
    Successful = 0
End Enum
Private Const IPC_WRITEPLAYLIST = 120
Private Const IPC_SETPLAYLISTPOS = 121
Private Const IPC_SETVOLUME = 122
Private Const IPC_SETPANNING = 123
Private Const IPC_GETLISTLENGTH = 124
Private Const WINAMP_OPTIONS_EQ = 40036
Private Const WINAMP_OPTIONS_PLEDIT = 40040
Private Const WINAMP_VOLUMEUP = 40058
Private Const WINAMP_VOLUMEDOWN = 40059
Private Const WINAMP_FFWD5S = 40060
Private Const WINAMP_REW5S = 40061
Public Enum WinampButton
    wbBack = 0
    wbPlay = 1
    wbPause = 2
    wbStop = 3
    wbForward = 4
End Enum
Public Enum WinampShiftState
    None = 0
    Shift = 100
    Ctrl = 110
End Enum
Private Const WINAMP_PREVSONG = 40198
Private Const WINAMP_FILE_PLAY = 40029
Private Const WINAMP_OPTIONS_PREFS = 40012
Private Const WINAMP_OPTIONS_AOT = 40019
Private Const WINAMP_HELP_ABOUT = 40041
Public Function GetWinampHwnd() As Long
    GetWinampHwnd = FindWindow("Winamp v1.x", 0&)
    If GetWinampHwnd = 0 Then
        Shell "Winamp.exe", vbNormalFocus
        Do
            DoEvents
            GetWinampHwnd = FindWindow("Winamp v1.x", 0&)
        Loop Until GetWinampHwnd <> 0
    End If
End Function
Public Function GetWinampVersion() As String
    Dim Result As Long, strResult As String
    Result = SendMessage(GetWinampHwnd, WM_WA_IPC, 0, IPC_GETVERSION)
    Select Case Result
    Case &H1551
        GetWinampVersion = "1.55"
    Case &H16A0
        GetWinampVersion = "1.6b"
    Case &H16AF
        GetWinampVersion = "1.60"
    Case &H16B0
        GetWinampVersion = "1.61"
    Case &H16B1
        GetWinampVersion = "1.62"
    Case &H16B3
        GetWinampVersion = "1.64"
    Case &H16B4
        GetWinampVersion = "1.666"
    Case &H16B5
        GetWinampVersion = "1.69"
    Case Else
        strResult = Hex$(Result)
        GetWinampVersion = Left$(strResult, 1) + "." + Mid$(strResult, 2, 1) + Mid$(strResult, 4)
    End Select
End Function
Private Sub AddToPlaylist(Filename As String, Optional blnForceOldMethod As Boolean = False)
    Dim Counter As Integer, WinampHwnd As Long
    If GetWinampVersion >= 1.7 And Not blnForceOldMethod Then
        AddToPlaylist2 Filename
        Exit Sub
    End If
    WinampHwnd = GetWinampHwnd
    For Counter = 1 To Len(Filename)
        PostMessage WinampHwnd, WM_WA_IPC, Asc(Mid$(Filename, Counter, 1)), IPC_PLAYFILE
    Next Counter
    PostMessage WinampHwnd, WM_WA_IPC, 0, IPC_PLAYFILE
End Sub
Public Sub AddToPlaylist2(Filename As String)
    'This method was introduced in Winamp 1.7, and should be used instead
    'of AddToPlaylist if AddToPlaylist causes Winamp to crash.
    Dim cds As COPYDATASTRUCT
    Static strFilename As String
    cds.dwData = IPC_PLAYFILE
    strFilename = StrConv(Filename, vbFromUnicode)
    cds.lpData = StrPtr(strFilename)
    cds.cbData = Len(Filename) + 1
    SendMessage GetWinampHwnd, WM_COPYDATA, 0, VarPtr(cds)
End Sub
Public Sub ClearPlaylist()
    SendMessage GetWinampHwnd, WM_WA_IPC, 0, IPC_DELETE
End Sub
Public Sub Play()
    SendMessage GetWinampHwnd, WM_WA_IPC, 0, IPC_STARTPLAY
End Sub
Public Sub SetWorkingFolder(Folder As String)
    'Use this so that relative filenames are correct, eg set this to c:\music, then just specify the name of the mp3 file for other functions
    Dim Counter As Integer, WinampHwnd As Long
    WinampHwnd = GetWinampHwnd
    For Counter = 1 To Len(Folder)
        PostMessage WinampHwnd, WM_WA_IPC, Asc(Mid$(Folder, Counter, 1)), IPC_CHDIR
    Next Counter
    PostMessage WinampHwnd, WM_WA_IPC, 0, IPC_CHDIR
End Sub
Public Function GetPlayStatus() As PlayStatus
    Dim Result As Long
    Result = SendMessage(GetWinampHwnd, WM_WA_IPC, 0, IPC_ISPLAYING)
    If Result < 0 Or Result > 3 Then Result = 2
    GetPlayStatus = Result
End Function
Public Function GetCurrentPos() As Long
    'Play position in milliseconds of currently playing song.  Returns -1 if not playing, or if an error occurs.
    GetCurrentPos = SendMessage(GetWinampHwnd, WM_WA_IPC, 0, IPC_GETOUTPUTTIME)
End Function
Public Function GetCurrentSongLength() As Long
    'Length in seconds of currently playing song.  Returns -1 if not playing, or if an error occurs.
    GetCurrentSongLength = SendMessage(GetWinampHwnd, WM_WA_IPC, 1, IPC_GETOUTPUTTIME)
End Function
Public Function JumpToTime(TimeMS As Long) As JumpResult
    Dim Version As Long, WinampHwnd As Long
    WinampHwnd = GetWinampHwnd
    Version = SendMessage(WinampHwnd, WM_WA_IPC, 0, IPC_GETVERSION)
    If Version < &H16AF Then
        MsgBox "JumpToTime is only available in Winamp v1.60 and above.", vbOKOnly, "Winamp Control"
        Exit Function
    End If
    JumpToTime = SendMessage(WinampHwnd, WM_WA_IPC, TimeMS, IPC_JUMPTOTIME)
End Function
Public Function WritePlayList() As Integer
    'Writes the current playlist to Winamp.pl
    'Returns the index of the current song in the playlist (first song is 0)
    Dim Version As Long, WinampHwnd As Long
    WinampHwnd = GetWinampHwnd
    Version = SendMessage(WinampHwnd, WM_WA_IPC, 0, IPC_GETVERSION)
    If Version < &H16B4 Then
        MsgBox "WritePlayList is only available in Winamp v1.666 and above.", vbOKOnly, "Winamp Control"
        Exit Function
    End If
    WritePlayList = SendMessage(WinampHwnd, WM_WA_IPC, 0, IPC_WRITEPLAYLIST)
End Function
Public Sub SetPlayListPos(ListPos As Long)
    'Doesn't appear to work.  Don't know why not.
    Dim Version As Long, WinampHwnd As Long
    WinampHwnd = GetWinampHwnd
    Version = SendMessage(WinampHwnd, WM_WA_IPC, 0, IPC_GETVERSION)
    If Version < &H2000 Then
        MsgBox "SetPlayListPos is only available in Winamp v2.0 and above.", vbOKOnly, "Winamp Control"
        Exit Sub
    End If
    SendMessage WinampHwnd, WM_WA_IPC, ListPos, IPC_SETPLAYLISTPOS
End Sub
Public Sub SetVolume(VolumeLevel As Integer)
    If VolumeLevel > 255 Then VolumeLevel = 255
    If VolumeLevel < 0 Then VolumeLevel = 0
    Dim Version As Long, WinampHwnd As Long
    WinampHwnd = GetWinampHwnd
    Version = SendMessage(WinampHwnd, WM_WA_IPC, 0, IPC_GETVERSION)
    If Version < &H2000 Then
        MsgBox "SetVolume is only available in Winamp v2.0 and above.", vbOKOnly, "Winamp Control"
        Exit Sub
    End If
    SendMessage WinampHwnd, WM_WA_IPC, VolumeLevel, IPC_SETVOLUME
End Sub
Public Sub SetPanning(Panning As Integer)
    '0 is center, goes up from -127 (left) to +127(right)
    If Panning < -127 Then Panning = -127
    If Panning > 127 Then Panning = 127
    If Panning < 0 Then Panning = 255 + Panning
    Dim Version As Long, WinampHwnd As Long
    WinampHwnd = GetWinampHwnd
    Version = SendMessage(WinampHwnd, WM_WA_IPC, 0, IPC_GETVERSION)
    If Version < &H2000 Then
        MsgBox "SetPanning is only available in Winamp v2.0 and above.", vbOKOnly, "Winamp Control"
        Exit Sub
    End If
    SendMessage WinampHwnd, WM_WA_IPC, Panning, IPC_SETPANNING
End Sub
Public Function GetPlayListLength() As Long
    'Returns number of tracks in playlist
    Dim Version As Long, WinampHwnd As Long
    WinampHwnd = GetWinampHwnd
    Version = SendMessage(WinampHwnd, WM_WA_IPC, 0, IPC_GETVERSION)
    If Version < &H2000 Then
        MsgBox "GetPlayListLength is only available in Winamp v2.0 and above.", vbOKOnly, "Winamp Control"
        Exit Function
    End If
    GetPlayListLength = SendMessage(WinampHwnd, WM_WA_IPC, 0, IPC_GETLISTLENGTH)
End Function
Public Sub ToggleEQ()
    SendMessage GetWinampHwnd, WM_COMMAND, WINAMP_OPTIONS_EQ, 0
End Sub
Public Sub TogglePlayList()
    SendMessage GetWinampHwnd, WM_COMMAND, WINAMP_OPTIONS_PLEDIT, 0
End Sub
Public Sub PressButton(Button As WinampButton, Optional ShiftState As WinampShiftState)
    Dim lCommand As Long
    lCommand = 40044 + Button + ShiftState
    SendMessage GetWinampHwnd, WM_COMMAND, lCommand, 0
End Sub

'Following are unsupported by latest versions of Winamp, but are included for completeness sake
Public Sub IncreaseVolume()
    SendMessage GetWinampHwnd, WM_COMMAND, WINAMP_VOLUMEUP, 0
End Sub
Public Sub DecreaseVolume()
    SendMessage GetWinampHwnd, WM_COMMAND, WINAMP_VOLUMEDOWN, 0
End Sub
Public Sub FastForward()
    'Fast Forward 5 seconds
    SendMessage GetWinampHwnd, WM_COMMAND, WINAMP_FFWD5S, 0
End Sub
Public Sub Rewind()
    'Rewind 5 seconds
    SendMessage GetWinampHwnd, WM_COMMAND, WINAMP_REW5S, 0
End Sub
Public Sub PreviousSong()
    Dim Version As Long, WinampHwnd As Long
    WinampHwnd = GetWinampHwnd
    Version = SendMessage(WinampHwnd, WM_WA_IPC, 0, IPC_GETVERSION)
    If Version < &H16B4 Then
        MsgBox "PreviousSong command is only available in Winamp v1.666 and above.", vbOKOnly, "Winamp Control"
        Exit Sub
    End If
    SendMessage WinampHwnd, WM_COMMAND, 0, WINAMP_PREVSONG
End Sub
Public Sub ShowLoadFile()
    SendMessage GetWinampHwnd, WM_COMMAND, 0, WINAMP_FILE_PLAY
End Sub
Public Sub ShowOptions()
    SendMessage GetWinampHwnd, WM_COMMAND, 0, WINAMP_OPTIONS_PREFS
End Sub
Public Sub ToggleAlwaysOnTop()
    SendMessage GetWinampHwnd, WM_COMMAND, 0, WINAMP_OPTIONS_AOT
End Sub
Public Sub ShowAbout()
    SendMessage GetWinampHwnd, WM_COMMAND, 0, WINAMP_HELP_ABOUT
End Sub
Sub Main()
    Stop
End Sub