Binaryworld - Retrive and set Auxiliary devices volume info. ... [ VB -> Multimedia ]

This code will loop through all Aux devices and set volume to 50%. You might have problem under NT/Win 2000 using auxXXXXXX APIs. Microsft recommands to use mixerXXXXX APIs. auxXXXXXX APIs are old school APIs. But for example purpose we have used auxXXXXXX APIs here.

Click here to copy the following block

Private Const HIGHEST_VOLUME_SETTING = 100  '%
Private Const AUX_MAPPER = -1&
Private Const MAXPNAMELEN = 32
Private Const AUXCAPS_CDAUDIO = 1  ' audio from internal CD-ROM drive
Private Const AUXCAPS_AUXIN = 2  ' audio from auxiliary input jacks
Private Const AUXCAPS_VOLUME = &H1  ' supports volume control
Private Const AUXCAPS_LRVOLUME = &H2  ' separate left-right volume control
Private Const MMSYSERR_NOERROR = 0
Private Const MMSYSERR_BASE = 0
Private Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)

Private Type AUXCAPS
  wMid As Integer
  wPid As Integer
  vDriverVersion As Long
  szPname As String * MAXPNAMELEN
  wTechnology As Integer
  dwSupport As Long
End Type

Private Type VolumeSetting
  LeftVol As Integer
  RightVol As Integer
End Type

Private Declare Function auxGetNumDevs Lib "winmm.dll" () As Long

Private Declare Function auxGetDevCaps Lib "winmm.dll" Alias "auxGetDevCapsA" ( _
  ByVal uDeviceID As Long, _
  lpCaps As AUXCAPS, _
  ByVal uSize As Long) As Long

Private Declare Function auxSetVolume Lib "winmm.dll" ( _
  ByVal uDeviceID As Long, _
  ByVal dwVolume As Long) As Long

Private Declare Function auxGetVolume Lib "winmm.dll" ( _
  ByVal uDeviceID As Long, _
  ByRef lpdwVolume As VolumeSetting) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
  hpvDest As Any, _
  hpvSource As Any, _
  ByVal cbCopy As Long)

Private Function nSigned(ByVal lUnsignedInt As Long) As Integer
  Dim nReturnVal As Integer  ' Return value from Function

  If lUnsignedInt > 65535 Or lUnsignedInt < 0 Then
    MsgBox "Error in conversion from Unsigned to nSigned Integer"
    nSignedInt = 0
    Exit Function
  End If

  If lUnsignedInt > 32767 Then
    nReturnVal = lUnsignedInt - 65536
  Else
    nReturnVal = lUnsignedInt
  End If
  nSigned = nReturnVal
End Function
Private Function lUnsigned(ByVal nSignedInt As Integer) As Long
  Dim lReturnVal As Long  ' Return value from Function

  If nSignedInt < 0 Then
    lReturnVal = nSignedInt + 65536
  Else
    lReturnVal = nSignedInt
  End If

  If lReturnVal > 65535 Or lReturnVal < 0 Then
    MsgBox "Error in conversion from nSigned to Unsigned Integer"
    lReturnVal = 0
  End If
  lUnsigned = lReturnVal
End Function
Private Function lSetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long
  Dim Volume As VolumeSetting, lBothVolumes As Long

  Volume.LeftVol = nSigned(lLeftVol * 65535 / HIGHEST_VOLUME_SETTING)
  Volume.RightVol = nSigned(lRightVol * 65535 / HIGHEST_VOLUME_SETTING)

  'copy our Volume-variable to a long
  CopyMemory lBothVolumes, Volume.LeftVol, Len(Volume)

  'call the SetVolume-function
  lSetVolume = auxSetVolume(lDeviceID, lBothVolumes)
End Function
Private Sub Form_Load()
  Dim Volume As VolumeSetting, Cnt As Long, AC As AUXCAPS, strMsg As String

  'loop through all the devices
  For Cnt = 0 To auxGetNumDevs - 1  'auxGetNumDevs is zero-based
    'get the volume
    auxGetVolume Cnt, Volume

    'get the device capabilities
    auxGetDevCaps Cnt, AC, Len(AC)

    'print the name on the form
    strMsg = "Device #" + Str$(Cnt + 1) + ": " + Left(AC.szPname, InStr(AC.szPname, vbNullChar) - 1) & vbCrLf
    strMsg = strMsg & "Left volume:" + Str$(HIGHEST_VOLUME_SETTING * lUnsigned(Volume.LeftVol) / 65535) & vbCrLf
    strMsg = strMsg & "Right volume:" + Str$(HIGHEST_VOLUME_SETTING * lUnsigned(Volume.RightVol) / 65535) & vbCrLf

    'set the left- and right-volume to 50%
    lSetVolume 50, 50, Cnt
    strMsg = strMsg & "Both volumes now set to 50%"

    MsgBox strMsg
  Next
End Sub