Module WinampControl '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 Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr End Function _ Private Function FindWindow(ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr End Function _ Private Function PostMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Boolean End Function Private Const WM_COMMAND = &H111 Private Const WM_COPYDATA = &H4A Private Structure COPYDATASTRUCT Public dwData As Long Public cbData As Long Public lpData As Long End Structure 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", vbNullString) If GetWinampHwnd = 0 Then Shell("Winamp.exe", vbNormalFocus) Do My.Application.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 = 0 GetWinampVersion = Microsoft.VisualBasic.Left(strResult, 1) + "." + Mid$(strResult, 2, 1) + Mid$(strResult, 4) End Select End Function Public Sub AddToPlaylist(ByVal Filename As String, Optional ByVal 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(ByVal Filename As String) 'This method was introduced in Winamp 1.7, and should be used instead 'of AddToPlaylist if AddToPlaylist causes Winamp to crash. 'Not sure how this works... 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(ByVal 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(ByVal 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(ByVal 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(ByVal 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(ByVal 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(ByVal Button As WinampButton, Optional ByVal ShiftState As WinampShiftState = WinampShiftState.None) 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 End Module