Private Declare Function FindWindow  Lib "user32" Alias "FindWindowA" ( _
                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, _
   lParam As Any _
) As Long

Private Declare Sub Sleep  Lib "kernel32" ( _
   ByVal dwMilliseconds As Long _
   

'system
Private Const WM_USER = &H400
Private Const WM_COMMAND = &H111
'winamp
Private Const WM_Raise_Volume = 40058       'increase 1%
Private Const WM_Lower_Volume = 40059       'decrease 1%
Private Const WM_Close_Winamp = 40001
Private Const WM_Previous = 40044
Private Const WM_Next = 40048
Private Const WM_Play = 40045
Private Const WM_Pause_Unpause = 40046
Private Const WM_Stop = 40047
Private Const WM_Toggle_Shuffle = 40023
Private Const WA_SETVOLUME = 122    

Dim Response As String
Dim Connections As Long

Private Sub Form_Load()
wnsServer(0).Protocol = sckTCPProtocol
wnsServer(0).LocalPort = 806
wnsServer(0).Listen
End Sub

Private Sub wnsServer_ConnectionRequest(index As Integer, ByVal requestID As Long)
If index = 0 Then
    Connections = Connections + 1
        Load wnsServer(Connections) 'Load New control
            wnsServer(Connections).LocalPort = 0
        wnsServer(Connections).Accept requested
        end if
    DoEvents
End Sub

Private Sub wnsServer_DataArrival(index As Integer, ByVal bytesTotal As Long)
    Dim hWnd As Long
    
    hWnd = FindWindow("Winamp v1.x", vbNullString)
    'если к нам подконектились и если у нас присутствует
    'винамп, ждем команду для отправки
    If bytesTotal <> 0 Then
      
      wnsServer(index).GetData Response 'получаем данные
          
      'если нет винампа то можно только выходить
      If hWnd = 0 Then
        Exit Sub
      End If

  'обработка поступившей команды
      'Next Track
      If InStr(1, Response, "next", vbTextCompare) <> 0 Then
        SendMessage hWnd, WM_COMMAND, WM_Next, vbNull
        Exit Sub
      End If
      'Previous Track
      If InStr(1, Response, "previous", vbTextCompare) <> 0 Then
        SendMessage hWnd, WM_COMMAND, WM_Previous, vbNull
        Exit Sub
      End If
      'Play
      If InStr(1, Response, "play", vbTextCompare) <> 0 Then
        SendMessage hWnd, WM_COMMAND, WM_Play, vbNull
        Exit Sub
      End If
      'Stop
      If InStr(1, Response, "stop", vbTextCompare) <> 0 Then
        SendMessage hWnd, WM_COMMAND, WM_Stop, vbNull
        Exit Sub
      End If
      'Shuffle
      If InStr(1, Response, "shuffle", vbTextCompare) <> 0 Then
        SendMessage hWnd, WM_COMMAND, WM_Toggle_Shuffle, vbNull
        Exit Sub
      End If
      'Pause/UnPause
      If InStr(1, Response, "pause", vbTextCompare) <> 0 Then
        SendMessage hWnd, WM_COMMAND, WM_Pause_Unpause, vbNull
        Exit Sub
      End If
      'Close
      If InStr(1, Response, "close", vbTextCompare) <> 0 Then
        SendMessage hWnd, WM_COMMAND, WM_Close_Winamp, vbNull
        Exit Sub
      End If
      'Volume inc
      If InStr(1, Response, "+", vbTextCompare) <> 0 Then
        If Response = "+" Then Response = "+1"
        Volume hWnd, CInt(Mid$(Response, InStr(1, Response, "+" + 1, 3)), 1
        Exit Sub
      End If
      'Volume dec
      If InStr(1, Response, "-", vbTextCompare) <> 0 Or
         InStr(1, Response, "0", vbTextCompare) <> 0 Then
        If Mid$(Response, InStr(1, Response, "-" + 1, 3) < "A" Then
         If Response = "-" Then Response = "-1"
         Volume hWnd, CInt(Mid$(Response, InStr(1, Response, "-" + 1, 3)), -1
        End If
      End If
  End If 'bytes
End Sub

Private Sub Volume(hWnd As Long, percent As Integer, incdec As Long)
    Dim i As Long
        For i = 0 To percent - 1
            Select Case incdec
                    Case -1
                        SendMessage hWnd, WM_COMMAND, WM_Lower_Volume, vbNull
                    Case 1
                        SendMessage hWnd, WM_COMMAND, WM_Raise_Volume, vbNull
            End Select
        Next i
End Sub

Private Sub wnsServer_SendComplete(index As Integer)
    Sleep 1000
    CloseSocket index
End Sub

'Само закрытие сокета и выгрузка его из памяти.
Private Sub CloseSocket(index As Integer)    
    wnsServer(index).Close
    Unload wnsServer(Connections)
    Connections = Connections - 1
    DoEvents                
End Sub