Startseite / Tipps / VB 5/6-Tipp 0567: Winamp fernsteuern

VB 5/6-Tipp 0567: Winamp fernsteuern

 von Mario Zeller

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
' Die Komponente 'Microsoft Windows Common Controls 6.0 (SP6) (MSCOMCTL.OCX)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "cmdID3"
' Steuerelement: Schaltfläche "cmdOpenURL"
' Steuerelement: Schaltfläche "cmdOpenFile"
' Steuerelement: Schaltfläche "cmdPLEnd"
' Steuerelement: Schaltfläche "cmdPLStart"
' Steuerelement: Schaltfläche "cmdClose"
' Steuerelement: Schaltfläche "cmdPL"
' Steuerelement: Schaltfläche "cmdEQ"
' Steuerelement: Schaltfläche "cmdMW"
' Steuerelement: Rahmensteuerelement "Frame1"
' Steuerelement: Beschriftungsfeld "lblChannels" auf Frame1
' Steuerelement: Beschriftungsfeld "lblBitrate" auf Frame1
' Steuerelement: Beschriftungsfeld "lblSample" auf Frame1
' Steuerelement: Beschriftungsfeld "Label4" auf Frame1
' Steuerelement: Beschriftungsfeld "Label3" auf Frame1
' Steuerelement: Beschriftungsfeld "Label2" auf Frame1
' Steuerelement: Schaltfläche "cmdVolIncr"
' Steuerelement: Schaltfläche "cmdVolDecr"
' Steuerelement: Slider "sldVol"
' Steuerelement: Schaltfläche "cmdNext"
' Steuerelement: Schaltfläche "cmdFFW"
' Steuerelement: Schaltfläche "cmdStop"
' Steuerelement: Schaltfläche "cmdPause"
' Steuerelement: Schaltfläche "cmdPlay"
' Steuerelement: Schaltfläche "cmdFRW"
' Steuerelement: Schaltfläche "cmdPrev"
' Steuerelement: Slider "sldLength"
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Beschriftungsfeld "Label1"
' Steuerelement: Beschriftungsfeld "lblTime"
' Steuerelement: Beschriftungsfeld "lblSongName"

'Option Explicit
'
'Autor: Mario Zeller <Mario@ActiveVB.de>
'
'Hinweis: Funktioniert nicht mit Winamp 3.0!

Option Explicit

Private Sub cmdClose_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_CLOSE, 0
End Sub

Private Sub cmdEQ_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_TOGGLEEQ, 0
End Sub

Private Sub cmdFFW_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_FFW, 0
End Sub

Private Sub cmdFRW_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_FRW, 0
End Sub

Private Sub cmdID3_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_INFOBOX, 0
End Sub

Private Sub cmdMW_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_TOGGLEMW, 0
End Sub

Private Sub cmdNext_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_NEXT, 0
End Sub

Private Sub cmdOpenFile_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_OPENFILE, 0
End Sub

Private Sub cmdOpenURL_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_OPENURL, 0
End Sub

Private Sub cmdPause_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_PAUSE, 0
End Sub

Private Sub cmdPL_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_TOGGLEPL, 0
End Sub

Private Sub cmdPlay_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_PLAY, 0
End Sub

Private Sub cmdPLEnd_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_PLEND, 0
End Sub

Private Sub cmdPLStart_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_PLSTART, 0
End Sub

Private Sub cmdPrev_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_PREV, 0
End Sub

Private Sub cmdStop_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_STOP, 0
End Sub

Private Sub cmdVolDecr_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_VOLDECR, 0
End Sub

Private Sub cmdVolIncr_Click()
    SendMessage WA_hwnd, WM_COMMAND, WA_VOLINCR, 0
End Sub

Private Sub Form_Load()
    ' Eine Winamp Instance finden, wenn keine Vorhanden abbrechen
    ' Findwindow funktioniert mit Winamp 2 und 5
    ' Beide hören auf den Titel "Winamp v1.x"
    WA_hwnd = FindWindow("Winamp v1.x", vbNullString)
    
    If WA_hwnd = 0 Then
        MsgBox "Winamp ist im Moment nicht aktiv. Bitte erst starten!"
        Unload Me
        End
    End If
    
    DONTCHANGEBAR = False
End Sub

Private Sub sldLength_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    DONTCHANGEBAR = True
End Sub

Private Sub sldLength_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    SendMessage WA_hwnd, WM_USER, sldLength.Value * 1000, WA_SEEK
    DONTCHANGEBAR = False
End Sub

Private Sub sldVol_Scroll()
    SendMessage WA_hwnd, WM_USER, sldVol.Value * 25.5, WA_VOLUME
End Sub

Private Sub Timer1_Timer()
    On Error Resume Next
    
    Dim lngCurrentTime As Long
    Dim lngTrackTime As Long
    Dim strCurrentMin As String
    Dim strCurrentSec As String
    Dim strTrackMin As String
    Dim strTrackSec As String
    
    'Zeiten holen
    lngCurrentTime = SendMessage(WA_hwnd, WM_USER, 0, WA_TIME)
    lngTrackTime = SendMessage(WA_hwnd, WM_USER, 1, WA_TIME)
    
    'Slider einstellen
    If DONTCHANGEBAR = False Then
        sldLength.Max = lngTrackTime
        sldLength.Value = lngCurrentTime \ 1000
    End If
    
    'Zeiten umrechnen und anzeigen
    lngCurrentTime = lngCurrentTime \ 1000
    strCurrentMin = AddZeroes(Trim(Str(lngCurrentTime \ 60)))
    strCurrentSec = AddZeroes(Trim(Str(lngCurrentTime - 60 * (lngCurrentTime \ 60))))
    
    strTrackMin = AddZeroes(Trim(Str(lngTrackTime \ 60)))
    strTrackSec = AddZeroes(Trim(Str(lngTrackTime - 60 * (lngTrackTime \ 60))))
    
    lblTime.Caption = strCurrentMin & ":" & strCurrentSec & "/" & _
        strTrackMin & ":" & strTrackSec
    
    'Songtitel anzeigen
    lblSongName.Caption = GetSongName
    
    'TrackInfos setzen
    lblSample.Caption = SendMessage(WA_hwnd, WM_USER, 0, WA_TRACKINFO)
    lblBitrate.Caption = SendMessage(WA_hwnd, WM_USER, 1, WA_TRACKINFO)
    lblChannels.Caption = SendMessage(WA_hwnd, WM_USER, 2, WA_TRACKINFO)
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------
Option Explicit

Public Declare Function GetWindowText Lib "user32" _
    Alias "GetWindowTextA" ( _
    ByVal hwnd As Long, _
    ByVal lpString As String, _
    ByVal cch As Long _
    ) As Long
    
Public Declare Function FindWindow Lib "user32" _
    Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String _
    ) As Long
    
Public 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

Public DONTCHANGEBAR As Boolean

Public Const WM_COMMAND As Long = &H111&
Public Const WM_USER As Long = &H400&
Public WA_hwnd As Long

' Dies sind nur einige der vielen vorhandenen Konstanten.
' All denjenigen, welche weitere Infos benötigen, sei die Seite
' http://www.winamp.com/nsdn/winamp2x/dev/sdk/api.jhtml
' ans Herz gelegt.
' Manche der Konstanten funktionieren nur mit Winamp-Versionen
' neuer als 2.05!

'Konstanten zur Steuerung via WM_COMMAND
Public Const WA_PREV = 40044        'Previous track button
Public Const WA_NEXT = 40048        'Next track button
Public Const WA_PLAY = 40045        'Play button
Public Const WA_PAUSE = 40046       'Pause/Unpause button
Public Const WA_STOP = 40047        'Stop button
Public Const WA_FADESTOP = 40147    'Fadeout and stop
Public Const WA_STOPTRACK = 40157   'Stop after current track
Public Const WA_FFW = 40148         'Fast-forward 5 seconds
Public Const WA_FRW = 40144         'Fast-rewind 5 seconds
Public Const WA_PLSTART = 40154     'Start of playlist
Public Const WA_PLEND = 40158       'Go to end of playlist
Public Const WA_OPENFILE = 40029    'Open file dialog
Public Const WA_OPENURL = 40155     'Open URL dialog
Public Const WA_INFOBOX = 40188     'Open file info box
Public Const WA_TOGGLEEQ = 40036    'Toggle EQ
Public Const WA_TOGGLEPL = 40040    'Toggle playlist editor
Public Const WA_TOGGLEMW = 40258    'Toggle main window visible
Public Const WA_VOLINCR = 40058     'Raise volume by 1%
Public Const WA_VOLDECR = 40059     'Lower volume by 1%
Public Const WA_CLOSE = 40001       'Close Winamp
Public Const WA_AUDIOCD = 40323     'Play audio CD

'Konstanten for WM_USER

'Gibt die Versionsnummer zurück
Public Const WA_VERSION = 0

'Gibt bei wParam=0 die Spielzeit und bei wParam=1 die Tracklänge zurück
Public Const WA_TIME = 105

'Setzt die Position auf wParam in ms
Public Const WA_SEEK = 106

'Setzt die Lautstärke in wParam von 0 bis 255
Public Const WA_VOLUME = 122

'Setzt die Balance in wParam zwishcen 0 und 255. 128=Mitte
Public Const WA_PANNING = 123

'Gibt bei 0 die Sampe-, bei 1 die Bitrate und bei 2 die Channels zurück
Public Const WA_TRACKINFO = 126

'Fügt der Zeit fehlende Nullen hinzu
Function AddZeroes(strAdd As String) As String
    If Len(strAdd) = 1 Then
        AddZeroes = "0" + strAdd
    Else
        AddZeroes = strAdd
    End If
End Function

'Extrahiert den Titel das aktuellen Songs
Function GetSongName() As String
    On Error Resume Next
    
    Dim strTitle As String
    strTitle = String(2048, " ")
    
    GetWindowText WA_hwnd, strTitle, Len(strTitle)
    
    GetSongName = Left$(strTitle, InStr(strTitle, "- Winamp") - 1)
End Function
'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 26 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpszClassName As String, ByVal lpszWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" _
    (ByVal hwnd As Long, ByRef lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    
Private Const PROCESS_VM_READ As Long = &H10

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_USER As Long = &H400
Private Const IPC_GETPLAYLISTFILE As Long = 211
Private Const IPC_GETLISTPOS As Long = 125

Private Declare Function ReadProcessMemory Lib "kernel32" _
    (ByVal hProcess As Long, ByVal lpBaseAddress As Long, _
    ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesRead As Long) As Long
    
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const MAX_PATH As Long = 260
Private hWndWinamp As Long

Private Function GetWinampWindow() As Long
    GetWinampWindow = FindWindow("Winamp v1.x", vbNullString)
End Function



Public Function GetPlayingFileName() As String
    Dim strFileName As String
    Dim lp As Long, lpWinamp As Long
    Dim iIndex As Long
    Dim PID As Long
    Dim bRet As Long
    Dim dwRead As Long
    Dim Buffer(MAX_PATH) As Byte
    Dim Temp As String

    hWndWinamp = GetWinampWindow
    If hWndWinamp = 0 Then
      GetPlayingFileName = ""
      Exit Function
    End If
    
    iIndex = SendMessage(hWndWinamp, WM_USER, 0, IPC_GETLISTPOS)
    lp = SendMessage(hWndWinamp, WM_USER, iIndex, IPC_GETPLAYLISTFILE)
    If lp = 0 Then
        GetPlayingFileName = ""
        Exit Function
    End If
    Call GetWindowThreadProcessId(hWndWinamp, PID)
    '
    lpWinamp = OpenProcess(PROCESS_VM_READ, 0, PID)
    If lpWinamp = 0 Then
        GetPlayingFileName = ""
        Exit Function
    End If
    bRet = ReadProcessMemory(lpWinamp, lp, Buffer(0), MAX_PATH, dwRead)
    Call CloseHandle(lpWinamp)
    
    Temp = StrConv(Buffer, vbUnicode)
    strFileName = Left$(Temp, InStr(Temp, Chr$(0)) - 1)

    GetPlayingFileName = strFileName
        
End Function

'TrackInfos setzen
lblSample.Caption = SendMessage(WA_hwnd, WM_USER, 0, WA_TRACKINFO) & " kHz"
lblBitrate.Caption = SendMessage(WA_hwnd, WM_USER, 1, WA_TRACKINFO) & " kbps"
If SendMessage(WA_hwnd, WM_USER, 2, WA_TRACKINFO) = 1 Then lblChannels.Caption = "Mono"
If SendMessage(WA_hwnd, WM_USER, 2, WA_TRACKINFO) = 2 Then lblChannels.Caption = "Stereo"
If SendMessage(WA_hwnd, WM_USER, 2, WA_TRACKINFO) < 1 Then lblChannels.Caption = "???"
If SendMessage(WA_hwnd, WM_USER, 2, WA_TRACKINFO) > 2 Then lblChannels.Caption = "Dolby Souround"
End Sub

 Function GetSongName() As String
Dim strTitle As String

    strTitle = String(2048, " ")
    GetWindowText WA_hwnd, strTitle, Len(strTitle)

If InStr(strTitle, "- Winamp") - 1 > 0 Then
    GetSongName = _
    Left$(strTitle, InStr(strTitle, "- Winamp") - 1) + _
    " - Play"
End If

If InStr(strTitle, "- Winamp [Stopped]") - 1 > 0 Then
    GetSongName = _
    Left$(strTitle, InStr(strTitle, "- Winamp [Stopped]") - 1) + _
    " - Stop"
End If

If InStr(strTitle, "- Winamp [Paused]") - 1 > 0 Then
    GetSongName = _
    Left$(strTitle, InStr(strTitle, "- Winamp [Paused]") - 1) + _
    " - Pause"
End If

End Function

Dim hwnd As Long
Dim txt As String
txt = String(255, Chr(0))
hwnd = FindWindow("Studio", vbNullString)
Call GetWindowText(hwnd, txt, 255)
txt = Left(txt, InStr(1, txt, Chr(0)) - 1)
txt = Mid(txt, InStr(1, txt, ".") + 2, Len(txt))
For i = 1 To 2
    For j = Len(txt) To 1 Step -1
        If Mid(txt, j, 1) = "(" Then
            txt = Left(txt, j - 2)
            Exit For
        End If
    Next j
Next i
MsgBox txt