Set Volume To 100 VB.NET Project

[Asphyxia]

THIS METHOD REQUIRES EXPLORER.EXE ~~~ a non-explorer.exe solution is available in next post.

With Windows 10 systems and others, you have to hook into the Windows system using DLL/API fanciness. It's really not that fancy and honestly looks like total trash.

I will provide an incredibly simple solution to setting a system's volume to 100 with a timer.

Public Class Form1

    Dim Volx As Int32

    Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Integer, ByVal dwExtraInfo As Integer)
    Const KEYEVENTF_KEYUP As Long = &H2

    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        Call keybd_event(Keys.VolumeUp, 0, 0, 0)
        Volx += 1
        If Volx = 50 Then
            Timer1.Enabled = False
        End If
    End Sub

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Volx = 0
    End Sub
End Class

This should be pretty simple to add to a project. While I am not most happy this adds an extra timer to a project --- shit happens!

!!!IMPORTANT!!!

The timer named Timer1 has an Interval set to 10 and I have changed Enabled to True!

Looking to set the system volume to 0 or mute? Simply replace that Call line with:

Call keybd_event(Keys.VolumeDown, 0, 0, 0)

If anyone wants to test this application, simply extract the vbproj.zip and run WindowsApp8.vbproj with Visual Studio 2017. If you run the test application, simply press Ctrl + F1 and you will notice the volume should adjust to maximum or minimum.

..........

This also is a PITA because it requires EXPLORER.EXE

Imports System.Runtime.InteropServices
Public Class Form1

Private Const VolUp As Integer = &HA0000
Private Const VolDn As Integer = &H90000
Private Const MsgNo As Integer = &H319

Declare Function SendMessageW Lib "user32" (ByVal hWnd As IntPtr, _
ByVal Msg As Integer, _
ByVal wParam As IntPtr, _
ByVal lParam As IntPtr) As IntPtr

Private Sub Form1_Load() Handles MyBase.Load
Button1.Text = "UP"
Button2.Text = "DOWN"
Button3.Text = "Close"
End Sub

Private Sub Button1_Click() Handles Button1.Click
SendMessageW(Me.Handle, MsgNo, Me.Handle, New IntPtr(VolUp))     
End Sub

Private Sub Button2_Click() Handles Button2.Click
SendMessageW(Me.Handle, MsgNo, Me.Handle, New IntPtr(VolDn))
End Sub

Private Sub Button3_Click() Handles Button3.Click
End
End Sub

Okay, I am going to scream... basically it is appearing without explorer.exe running, you may not adjust the volume of the system. What... the... fuck?! Do I need to code this in assembly and make my own OS too?

Imports System
Imports System.Windows.Forms
Imports System.Runtime.InteropServices

Public Class Form1

    Private Const APPCOMMAND_VOLUME_MUTE As Integer = &H80000
    Private Const APPCOMMAND_VOLUME_UP As Integer = &HA0000
    Private Const APPCOMMAND_VOLUME_DOWN As Integer = &H90000
    Private Const WM_APPCOMMAND As Integer = &H319

    <DllImport("user32.dll")>
    Public Shared Function SendMessageW(ByVal hWnd As IntPtr,
           ByVal Msg As Integer, ByVal wParam As IntPtr,
           ByVal lParam As IntPtr) As IntPtr
    End Function

    'mute SendMessageW(Me.Handle, WM_APPCOMMAND, Me.Handle, New IntPtr(APPCOMMAND_VOLUME_MUTE))

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        'SendMessageW(Me.Handle, WM_APPCOMMAND, Me.Handle, New IntPtr(APPCOMMAND_VOLUME_UP))
        SendMessageW(Me.Handle, WM_APPCOMMAND, Me.Handle, New IntPtr(APPCOMMAND_VOLUME_MUTE))
    End Sub
End Class

Hmm... hmmm... hmmm... NOPE.

 

[Asphyxia]

The only reason these are two separate posts is because they are two totally separate solutions. This is a RARE exception to the double posting rule.

I finally have a solution around explorer.exe that does not require NirCmd. I do not like using third party software when developing a solution.

With explorer.exe terminated you may still launch

sndvol.exe -f 26214900

Thanks to CoolCmd and Mokubai for their helpful information on the numbers trailing after -f:

This example creates window at x=500 y=400

coordinates = y * 65536 + x, where x and y - signed integers

We can manipulate the process sndvol in Windows 10 to spawn/launch the process sndvol.exe and allow only this process to be running with the app itself. Don't ask, I'm making a security app that is accessible.

Attached is my solution that may or may not help you. If you do not want to use NirCmd and want to use Microsoft Windows built-in only functionality to adjust volume, my attached zip contains a ".vbproj" file you can run in MSVS 2017.

This was a complete pain in my ass and I may have to develop specific support for Windows 7 because it uses sndvol32 as opposed to sndvol, I believe. I'm going to double check. Until then, enjoy my hacky solution.

'    ____  __ __  ____ _____   _   ______________
'   / __ \/ // / / __ \__  /  / | / / ____/_  __/
'  / /_/ / // /_/ /_/ //_ <  /  |/ / __/   / /
' / _, _/__  __/ ____/__/ / / /|  / /___  / /
'/_/ |_|  /_/ /_/   /____(_)_/ |_/_____/ /_/
'Asphyxia saved your day, buy him coffee or cake? A like is fine too!

Public Class Form1

    Public Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Integer) As Integer
    Public Declare Auto Function FindWindow Lib "user32.dll" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer


    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.TopMost = True
        Dim P = Process.Start("sndvol")
    End Sub


    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        'Dim P = Process.Start("sndvol", vbMaximizedFocus)
        'P.WaitForInputIdle(1000)
        'My.Computer.Keyboard.SendKeys("{UP}", True)

        For Each app As Process In Process.GetProcessesByName("sndvol")
            Dim theHandle As IntPtr = FindWindow(Nothing, app.MainWindowTitle)
            If theHandle <> IntPtr.Zero Then
                SetForegroundWindow(theHandle)
            End If
        Next
        My.Computer.Keyboard.SendKeys("{UP}", True)

    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        For Each app As Process In Process.GetProcessesByName("sndvol")
            Dim theHandle As IntPtr = FindWindow(Nothing, app.MainWindowTitle)
            If theHandle <> IntPtr.Zero Then
                SetForegroundWindow(theHandle)
            End If
        Next
        My.Computer.Keyboard.SendKeys("{HOME}", True)
    End Sub

    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        For Each app As Process In Process.GetProcessesByName("sndvol")
            Dim theHandle As IntPtr = FindWindow(Nothing, app.MainWindowTitle)
            If theHandle <> IntPtr.Zero Then
                SetForegroundWindow(theHandle)
            End If
        Next
        My.Computer.Keyboard.SendKeys("{END}", True)
    End Sub
End Class

My solution is certainly "hacked together" but it also definitely just works so far in all my testing. Notice: You may not minimize the SNDVOL window, for some reason SendKeys becomes ignored if you try that. You must just keep the process behind your main app which was done via Me.TopMost = True in the load.

Most importantly, I appear to be the only person in the entire world to solve this problem using Microsoft's built-in sndvol control application whereas others have given up and used third party software. I am not bragging but I am freaking happy!