Shutdown Manager

Introduction

This article has been updated to be compatible with the Windows 7 Superbar, and UAC(User Account Control) settings.

The Windows "Turn off" buttons are three or more steps away from the desktop work area, depending on your personal settings. This can be not only inconvenient, but downright bothersome at times. These programs can power down the computer in just one or two steps.

This program is a multi-executable file group. It consists of several programs that each do different jobs. These programs can be used independently, or together with the main interface. They have now been backported to VB6 as well. Each version uses a new re-usable module named "ShutDown". It's also a fair side-by-side example of how to convert vb6 code into equivalent .NET code.

Illustration Program Use
VB6.EXE Applies to Visual Basic 6.0 code examples
vbexpress.exe Applies to Visual Basic 2005 Express Edition code examples
ShutdownUI.exe The main user interface can be used to set the user's preferences.
Power.exe Shuts down the system and turns off the power. To help prepare for the shutdown, all windows are minimized first. It gently forces any windows that are hung to close.
Restart.exe Shuts down the system and then restarts the system. To help prepare for the shutdown, all windows are minimized first. It gently forces any windows that are hung to close.
LogOffUser.exe Logs the user off. To help prepare for the shutdown, all windows are minimized first. It gently forces any windows that are hung to close.
SwitchUser.exe Switches to another user without having to close any programs. If you press and hold the Shift key while opening this program, the work station will be locked; otherwise, Windows Terminal Services switches users.
Standby.exe Reduces power consumption by cutting power to hardware not being used, and maintains power to your computer's memory so you don't lose your work. If standby has been disabled, this program asks whether you want to configure it now. Configuration will require a restart of the computer, so this program will ask if you want to restart.
Hibernate.exe Saves your desktop with all open files and documents, and then powers down the computer. When power is resumed, your files and documents are exactly as you left them. If hibernation is disabled, this program automatically enables it, and attempts to hibernate.
Remote.exe Shuts down a remote computer on the network. If none is specified, the computer calling it is shut down.

Advantages

  1. You are only one click away from powering down your computer, or two clicks if you want a dialog prompt.
  2. All power buttons are now grouped in one place, the way it should be.
  3. If standby is disabled, it can be enabled after a restart with your permission.
  4. If "Fast user switching" is disabled, it will be enabled on the fly.
  5. If Hibernate is disabled, it will be enabled on the fly.
  6. Power buttons can be pinned to the "start menu" and/or "quick launch" area.
  7. Any open windows are minimized all at once before a logoff, restart, or shutdown.
    This drastically reduces (by nearly 1/2) the amount of memory used, by any running program windows.
  8. The power buttons look and act like the real thing, but only better!
  9. The re-usable module comes in two flavors(VB6 & .NET), which can serve as a translatory example for conversion between the two.

Disadvantages

None known yet.

Screenshots

These screenshots were made with Microsoft's digitally signed Zune theme. You can download it here: Zune Theme.

Pin to quick launch(2K/XP/Vista/7)

Custom Pin to Taskbar/Superbar(2K/XP/Vista/7)

Pin to start menu

Dialog prompt

User interface

Shutdown Manager

Power | Restart | Logoff

[Power.JPG] | [Restart.JPG] | [Logoff.JPG]

The main API function used to power down windows is ExitWindowsEx. If the return value fails to exit Windows, it will forcefully call the function again.

[VB0575.JPG].NET

Const EWX_POWEROFF As Int32 = 8
Const EWX_REBOOT As Int32 = 2
Const EWX_LOGOFF As Int32 = 0
Const EWX_FORCE As Int32 = 4
Const EWX_FORCEIFHUNG As Int32 = 16
Const SHTDN_HUNG_ As Int32 = -2147483643
Const SHTDN_PLAN_ As Int32 = 65535
Private Declare Function apiExitWindowsEx Lib _
"user32" Alias "ExitWindowsEx" _
(ByVal EWX_ As Int32, _
ByVal dwReserved As Int32) As Int32
Private Declare Function apiSHShutDownDialog Lib _
"shell32" Alias "#60" () As Int32

Public Enum EWX
   pcPowerOff = EWX_POWEROFF
   pcRestart = EWX_REBOOT
   userLogOff = EWX_LOGOFF
End Enum

Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button1.Click
  On Error Resume Next 
  Dim ExitWindowsEx As Int32 = 0
  If EnablePrivilege <> 0 Then
    ExitWindowsEx = apiExitWindowsEx _
    (EWX.pcRestart, SHTDN_PLAN_)
    If ExitWindowsEx = 0 Then 
      ExitWindowsEx = apiExitWindowsEx(EWX.pcRestart Or _
      EWX_FORCEIFHUNG, SHTDN_HUNG_)
    End If
    If ExitWindowsEx = 0 Then 
      ExitWindowsEx = apiExitWindowsEx(EWX.pcRestart Or _
      EWX_FORCE, SHTDN_HUNG_)
    End If
    apiSHShutDownDialog()'May execute
    ' This helps finalize LogOff.
  Else
    MessageBox.Show _
    ("Could not get the privileges to shutdown.")
  End If
End Sub

[VB675.JPG]VB6

Const EWX_POWEROFF As Long = 8
Const EWX_REBOOT As Long = 2
Const EWX_LOGOFF As Long = 0
Const EWX_FORCE As Long = 4
Const EWX_FORCEIFHUNG As Long = 16
Const SHTDN_HUNG_ As Long = -2147483643
Const SHTDN_PLAN_ As Long = 65535
Private Declare Function apiExitWindowsEx Lib _
"user32" Alias "ExitWindowsEx" _
(ByVal EWX_ As Long, _
ByVal dwReserved As Long) As Long
Private Declare Function apiSHShutDownDialog Lib _
"shell32" Alias "#60" () As Long

Public Enum EWX
   pcPowerOff = EWX_POWEROFF
   pcRestart = EWX_REBOOT
   userLogOff = EWX_LOGOFF
End Enum

Private Sub Command1_Click()
   On Error Resume Next 
   Dim ExitWindowsEx As Long
   If EnablePrivilege <> 0 Then
     ExitWindowsEx = apiExitWindowsEx _
     (EWX.pcRestart, SHTDN_PLAN_)
     If ExitWindowsEx = 0 Then
        ExitWindowsEx = apiExitWindowsEx _
        (EWX.pcRestart Or EWX_FORCEIFHUNG, SHTDN_HUNG_)
     End If
     If ExitWindowsEx = 0 Then
         ExitWindowsEx = apiExitWindowsEx _
         (EWX.pcRestart Or EWX_FORCE, SHTDN_HUNG_)
     End If
     Call apiSHShutDownDialog
   Else
     MsgBox "Could not get the privileges to shutdown."
   End If
End Sub

This doesn't work unless you enable the privilege for shutdown first.

[VB0575.JPG].NET

Imports System.Runtime.InteropServices    'Up top!

Const SE_PRIVILEGE_ENABLED As Int32 = 2
Const SE_SHUTDOWN_NAME As String = "SeShutdownPrivilege"
Const TOKEN_ADJUST_PRIVILEGES As Int32 = 32
Const TOKEN_QUERY As Int32 = 8

<StructLayout(LayoutKind.Sequential, Pack:=1)> _
Friend Structure Luid
   Public Count As Int32, Luid As Long, Attr As Int32
End Structure

Private Declare Function apiAdjustTokenPrivileges Lib _
"advapi32" Alias "AdjustTokenPrivileges" _
(ByVal TokenHandle As Int32, _
ByVal DisableAllPrivileges As Boolean, _
ByRef NewState As Luid, _
ByVal BufferLength As Int32, _
ByVal PreviousState As Int32, _
ByVal ReturnLength As Int32) As Boolean
Private Declare Function apiLookupPrivilegeValue Lib _
"advapi32" Alias "LookupPrivilegeValueA" _
(ByVal lpSystemName As String, _
ByVal lpName As String, _
ByRef lpLuid As Long) As Boolean
Private Declare Function apiOpenProcessToken Lib _
"advapi32" Alias "OpenProcessToken" _
(ByVal ProcessHandle As Int32, _
ByVal DesiredAccess As Int32, _
ByRef byrefTokenHandle As Int32) As Boolean

Private Function EnablePrivilege() As Boolean
   Try
   Dim pProc, pToken As Int32, pLUID As New Luid : pToken = 0
   'get process handle
   pProc = Diagnostics.Process.GetCurrentProcess. _
      Handle.ToInt32
   'Open token
   apiOpenProcessToken _
   (pProc, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, pToken)
   'Set structure
   pLUID.Count = 1 
   pLUID.Luid = 0 
   pLUID.Attr = SE_PRIVILEGE_ENABLED
   'Look for privilege
   apiLookupPrivilegeValue _
   (Nothing, SE_SHUTDOWN_NAME, pLUID.Luid)
   'Adjust privileges
   EnablePrivilege = apiAdjustTokenPrivileges _
   (pToken, False, pLUID, 0, 0, 0)
   Catch ex As Exception
      MessageBox.Show(ex.Message)
    End Try
End Function

[VB675.JPG]VB6

Const ANYSIZE_ARRAY As Long = 1
Const SE_SHUTDOWN_NAME As String = "SeShutdownPrivilege"
Const SE_PRIVILEGE_ENABLED As Long = 2
Const TOKEN_ADJUST_PRIVILEGES As Long = 32
Const TOKEN_QUERY As Long = 8
Private Type LUID
    LowPart As Long
    HighPart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Private Declare Function apiAdjustTokenPrivileges Lib _
"advapi32" Alias "AdjustTokenPrivileges" _
(ByVal TokenHandle As Long, _
ByVal DisableAllPrivileges As Long, _
ByRef NewState As TOKEN_PRIVILEGES, _
ByVal BufferLength As Long, _
ByRef PreviousState As TOKEN_PRIVILEGES, _
ByRef ReturnLength As Long) As Long
Private Declare Function apiGetCurrentProcess Lib _
"kernel32" Alias "GetCurrentProcess" () As Long
Private Declare Function apiLookupPrivilegeValue Lib _
"advapi32" Alias "LookupPrivilegeValueA" _
(ByVal lpSystemName As String, _
ByVal lpName As String, _
ByRef lpLuid As LUID) As Long
Private Declare Function apiOpenProcessToken Lib _
"advapi32" Alias "OpenProcessToken" _
(ByVal ProcessHandle As Long, _
ByVal DesiredAccess As Long, _
ByRef TokenHandle As Long) As Long

Private Function EnablePrivilege() As Long
    On Error Resume Next
    Dim hProc As Long
    Dim hToken As Long
    Dim mLUID As LUID
    Dim mPriv As TOKEN_PRIVILEGES
    Dim mNewPriv As TOKEN_PRIVILEGES
    hProc = apiGetCurrentProcess()
    Call apiOpenProcessToken(hProc, _
    TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken)
    Call apiLookupPrivilegeValue _
    ("", SE_SHUTDOWN_NAME, mLUID)
    mPriv.PrivilegeCount = 1
    mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
    mPriv.Privileges(0).pLuid = mLUID
    EnablePrivilege = apiAdjustTokenPrivileges _
    (hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), _
    mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount))
End Function

Shutdown Manager

Fast User Switching

[SwitchUser.JPG]

If you want to switch users or lock the work station, you'll need these APIs and these functions.

[VB0575.JPG].NET

Const WM_COMMAND As Int32 = 273
Const WTS_CURRENT_SESSION As Int32 = -1
Const WTS_CURRENT_SERVER_HANDLE As Int32 = 0
Private Declare Auto Function apiLockWorkStation Lib _
"user32" Alias "LockWorkStation" () As Int32
Private Declare Auto Function apiWTSDisconnectSession Lib _
"wtsapi32" Alias "WTSDisconnectSession" _
(ByVal hServer As Int32, _
ByVal SessionId As Int32, _
ByVal bWait As Boolean) As Boolean
Private Declare Auto Function apiWTSLogoffSession Lib _
"wtsapi32" Alias "WTSLogoffSession" _
(ByVal hServer As Int32, _
ByVal SessionId As Int32, _
ByVal bWait As Boolean) As Boolean
Private Declare Auto Function apiWTSOpenServer Lib _
"wtsapi32" Alias "WTSOpenServer" _
(ByVal pServerName As String) As Int32
Private Declare Auto Function apiWTSCloseServer Lib _
"wtsapi32" Alias "WTSCloseServer" _
(ByVal hServer As Int32) As Boolean
Private Declare Function apiGetAsyncKeyState Lib _
"user32" Alias "GetAsyncKeyState" _
(ByVal vKey As Int32) As Int32
Private Declare Function apiFindWindow Lib _
"user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Int32
Private Declare Function apiSendMessage Lib _
"user32" Alias "SendMessageA" _
(ByVal hWnd As Int32, _
ByVal wMsg As Int32, _
ByVal wParam As Int32, _
ByVal lParam As String) As Int32


Private Function DissconnectSession _
(ByVal ServerName As String, ByVal SessionID As Integer) _
As Boolean
    On Error Resume Next
    Dim OpenedServer As Int32
    OpenedServer = WTS_CURRENT_SERVER_HANDLE
    If ServerName <> "" Then
        OpenedServer = apiWTSOpenServer(ServerName)
    End If
    If SessionID = 0 Then SessionID = WTS_CURRENT_SESSION
    DissconnectSession = apiWTSDisconnectSession _
    (OpenedServer, SessionID, False)
    apiWTSCloseServer(OpenedServer)
End Function

Private Function LogoffSession _
(Optional ByVal ServerName As String, _
Optional ByVal SessionID As Int32) As Boolean
    On Error Resume Next
    Dim OpenedServer As Int32
    OpenedServer = WTS_CURRENT_SERVER_HANDLE
    If ServerName <> "" Then
        OpenedServer = apiWTSOpenServer(ServerName)
    End If
    If SessionID = 0 Then SessionID = WTS_CURRENT_SESSION
    LogoffSession = apiWTSLogoffSession _
    (OpenedServer, SessionID, False)
    apiWTSCloseServer(OpenedServer)
End Function

Private Sub Button1_Click(ByVal sender As System.Object, _
                          ByVal e As System.EventArgs) _
      Handles Button1.Click
    IsFastUserSwitching()
    If apiGetAsyncKeyState(Keys.ControlKey) <> 0 AndAlso _
    apiGetAsyncKeyState(Keys.ShiftKey) <> 0 Then
      LogoffSession()
    ElseIf sLock = False OrElse _
    apiGetAsyncKeyState(Keys.ShiftKey) <> 0 Then
      apiLockWorkStation()
    ElseIf apiGetAsyncKeyState(Keys.ControlKey) <> 0 Then
      Dim tBar As Int32
      tBar = apiFindWindow("Shell_TrayWnd", vbNullString)
      apiSendMessage(tBar, WM_COMMAND, 402, vbNullString)
    Else
      DissconnectSession()
    End If
End Sub

[VB675.JPG]VB6

Const WM_COMMAND As Long = 273
Const VK_SHIFT As Long = 16
Const VK_CONTROL As Long = 17
Const WTS_CURRENT_SESSION As Long = -1
Const WTS_CURRENT_SERVER_HANDLE As Long = 0
Private Declare Function apiLockWorkStation Lib _
"user32" Alias "LockWorkStation" () As Long
Private Declare Function apiWTSDisconnectSession Lib _
"wtsapi32" Alias "WTSDisconnectSession" _
(ByVal hServer As Long, ByVal SessionID As Long, _
ByVal bWait As Boolean) As Boolean
Private Declare Function apiWTSLogoffSession Lib _
"wtsapi32" Alias "WTSLogoffSession" _
(ByVal hServer As Long, ByVal SessionID As Long, _
ByVal bWait As Boolean) As Boolean
Private Declare Function apiWTSOpenServer Lib _
"wtsapi32" Alias "WTSOpenServer" _
(ByVal pServerName As String) As Long
Private Declare Function apiWTSCloseServer Lib _
"wtsapi32" Alias "WTSCloseServer" _
(ByVal hServer As Long) As Boolean
Private Declare Function apiGetAsyncKeyState Lib _
"user32" Alias "GetAsyncKeyState" _
(ByVal vKey As Long) As Long
Private Declare Function apiFindWindow Lib _
"user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function apiSendMessage Lib _
"user32" Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As String) As Long

Private Function DissconnectSession _
(Optional ByVal ServerName As String, _
Optional ByVal SessionID As Long) As Boolean
    On Error Resume Next
    Dim OpenedServer As Long
    OpenedServer = WTS_CURRENT_SERVER_HANDLE
    If ServerName <> "" Then
        OpenedServer = apiWTSOpenServer(ServerName)
    End If
    If SessionID = 0 Then SessionID = WTS_CURRENT_SESSION
    DissconnectSession = apiWTSDisconnectSession _
    (OpenedServer, SessionID, False)
    apiWTSCloseServer (OpenedServer)
End Function

Private Function LogoffSession _
(Optional ByVal ServerName As String, _
Optional ByVal SessionID As Long) As Boolean
    On Error Resume Next
    Dim OpenedServer As Long
    OpenedServer = WTS_CURRENT_SERVER_HANDLE
    If ServerName <> "" Then
        OpenedServer = apiWTSOpenServer(ServerName)
    End If
    If SessionID = 0 Then SessionID = WTS_CURRENT_SESSION
    LogoffSession = apiWTSLogoffSession _
    (OpenedServer, SessionID, False)
    apiWTSCloseServer (OpenedServer)
End Function

Private Sub Command1_Click()
    Call IsFastUserSwitching
    If apiGetAsyncKeyState(VK_CONTROL) <> 0 And _
    apiGetAsyncKeyState(VK_SHIFT) <> 0 Then
      Call LogoffSession
    ElseIf sLock = False Or _
    apiGetAsyncKeyState(VK_SHIFT) <> 0 Then
      Call apiLockWorkStation
    ElseIf apiGetAsyncKeyState(VK_CONTROL) <> 0 Then
      Dim tBar As Long
      tBar = apiFindWindow("Shell_TrayWnd", vbNullString)
      Call apiSendMessage(tBar, WM_COMMAND, 402, vbNullString)
    Else
      Call DissconnectSession
    End If
End Sub

As you can see, I've added some extra options to switching users. If you hold the Shift key down while switching, the workstation will be locked, requiring a password to get back in. If you hold the Control key down while switching, the classic switch dialog will be displayed. If you hold the Control and Shift keys down while switching, the session will be logged off. Otherwise, if no keys are held, it will simply bring you to the switch user's screen.

You should check to see whether Fast User Switching is enabled, and if not, enable it.

[VB0575.JPG].NET

Private Function IsFastUserSwitching() As Boolean
  Dim regKey As Microsoft.Win32.RegistryKey
  Dim regValue As Int32 : regKey = Nothing
  Try
    regKey = Microsoft.Win32.Registry.LocalMachine.OpenSubKey _
    ("SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", True)
    regValue = CInt(regKey.GetValue("AllowMultipleTSSessions"))
    If regValue = 0 Then regKey.SetValue("AllowMultipleTSSessions", 1)
    regValue = CInt(regKey.GetValue("AllowMultipleTSSessions"))
    regKey.Flush()
    regKey.Close()
  Catch ex As Exception
    regKey.Close()
  End Try
  Return CBool(regValue)
End Function

[VB675.JPG]VB6

These Registry functions, GetRegistryValue & SetRegistryValue, will be used again in this article.

Const ERROR_SUCCESS As Long = 0
Const KEY_QUERY_VALUE As Long = 1
Const KEY_ENUMERATE_SUB_KEYS As Long = 8
Const KEY_NOTIFY As Long = 16
Const KEY_SET_VALUE As Long = 2
Const KEY_CREATE_SUB_KEY As Long = 4
Const READ_CONTROL As Long = 131072
Const STANDARD_RIGHTS_WRITE As Long = _
(READ_CONTROL)
Const SYNCHRONIZE As Long = 1048576
Const KEY_READ As Long = _
((READ_CONTROL Or KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_WRITE As Long = _
((STANDARD_RIGHTS_WRITE Or _
KEY_SET_VALUE Or _
KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Const HKEY_LOCAL_MACHINE As Long = -2147483646
Const HKEY_CURRENT_USER As Long = -2147483647
Const REG_SZ As Long = 1
Const REG_BINARY As Long = 3
Const REG_DWORD As Long = 4
Private Declare Function apiRegOpenKeyEx Lib _
"advapi32" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
ByRef phkResult As Long) As Long
Private Declare Function apiRegCloseKey Lib _
"advapi32" Alias "RegCloseKey" _
(ByVal hKey As Long) As Long
Private Declare Function apiRegQueryValueEx Lib _
"advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
ByRef lpType As Long, _
ByRef lpData As Any, _
ByRef lpcbData As Long) As Long
Private Declare Function apiRegSetValueEx Lib _
"advapi32" Alias "RegSetValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal Reserved As Long, _
ByVal dwType As Long, _
ByRef lpData As Any, _
ByVal cbData As Long) As Long

Private Function IsFastUserSwitching() As Boolean
    On Error Resume Next
    Dim regKey As String
    Dim regValue As Long
    regKey = _
"SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon"
    regValue = CLng(GetRegistryValue _
    (HKEY_LOCAL_MACHINE, regKey, _
    "AllowMultipleTSSessions", REG_DWORD))
    If regValue = 0 Then
        Call SetRegistryValue _
        (HKEY_LOCAL_MACHINE, regKey, _
        "AllowMultipleTSSessions", REG_DWORD, 1)
    End If
    regValue = CLng(GetRegistryValue _
    (HKEY_LOCAL_MACHINE, regKey, _
    "AllowMultipleTSSessions", REG_DWORD))
    IsFastUserSwitching = CBool(regValue)
End Function

Public Function GetRegistryValue _
(ByVal hKey As Long, _
ByVal KeyName As String, _
ByVal ValueName As String, _
ByVal KeyType As Integer, _
Optional DefaultValue As Variant = Empty) As Variant
    On Error Resume Next
    Dim handle As Long
    Dim resLong As Long
    Dim resString As String
    Dim length As Long
    Dim resBinary() As Byte
    GetRegistryValue = DefaultValue
    If apiRegOpenKeyEx _
    (hKey, KeyName, 0, KEY_READ, handle) _
    <> ERROR_SUCCESS Then Exit Function
    If KeyType = REG_DWORD Then
      If apiRegQueryValueEx _
      (handle, ValueName, 0, REG_DWORD, resLong, 4) _
      = 0 Then
        GetRegistryValue = resLong
      End If
    ElseIf KeyType = REG_SZ Then
      length = 1024: resString = Space(length)
      If apiRegQueryValueEx _
      (handle, ValueName, 0, REG_SZ, _
      ByVal resString, length) = 0 Then
        GetRegistryValue = Left(resString, length - 1)
      End If
    ElseIf KeyType = REG_BINARY Then
      length = 4096
      ReDim resBinary(length - 1) As Byte
      If apiRegQueryValueEx _
      (handle, ValueName, 0, REG_BINARY, resBinary(0), _
      length) = 0 Then
        ReDim Preserve resBinary(length - 1) As Byte
        GetRegistryValue = resBinary()
      End If
    Else
      MsgBox "Reg type not supported"
    End If
    apiRegCloseKey (handle)
End Function

Public Sub SetRegistryValue _
(ByVal hKey As Long, _
ByVal KeyName As String, _
ByVal ValueName As String, _
ByVal KeyType As Integer, _
ByRef value As Variant)
    On Error Resume Next
    Dim handle As Long
    Dim lngValue As Long
    Dim strValue As String
    Dim binValue() As Byte
    Dim length As Long
    If apiRegOpenKeyEx _
    (hKey, KeyName, 0, KEY_WRITE, handle) <> _
    ERROR_SUCCESS Then Exit Sub
    If KeyType = REG_DWORD Then
      lngValue = value
      Call apiRegSetValueEx _
      (handle, ValueName, 0, KeyType, lngValue, 4)
    ElseIf KeyType = REG_SZ Then
      strValue = value
      Call apiRegSetValueEx _
      (handle, ValueName, 0, KeyType, _
      ByVal strValue, Len(strValue))
    ElseIf KeyType = REG_BINARY Then
      binValue = value
      length = UBound(binValue) - LBound(binValue) + 1
      Call apiRegSetValueEx _
      (handle, ValueName, 0, KeyType, _
      binValue(LBound(binValue)), length)
    Else
      MsgBox "Reg type not supported"
    End If
     apiRegCloseKey (handle)
End Sub

Shutdown Manager

Standby

[Standby.JPG]

If you want the computer to go to a standby mode, you should make sure that your computer's BIOS is configured to allow standby. Then, you will need these APIs and the EnablePrivilege function.

[VB0575.JPG].NET

Private Declare Function apiIsPwrSuspendAllowed Lib _
"Powrprof" Alias "IsPwrSuspendAllowed" () As Int32
Private Declare Function apiSetSystemPowerState Lib _
"kernel32" Alias "SetSystemPowerState" _
(ByVal fSuspend As Boolean, _
ByVal fForce As Boolean) As Int32

Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) _
Handles Button1.Click
   If IsStandbyConfigured() = True Then
      If apiIsPwrSuspendAllowed() <> 0 Then
         EnablePrivilege()
         apiSetSystemPowerState(True, False)
      Else
         MessageBox.Show("Standby is not configured.")
      End If
   End If
End Sub

[VB675.JPG]VB6

Private Declare Function apiIsPwrSuspendAllowed Lib _
"Powrprof" Alias "IsPwrSuspendAllowed" () As Long
Private Declare Function apiSetSystemPowerState Lib _
"kernel32" Alias "SetSystemPowerState" _
(ByVal fSuspend As Boolean, _
ByVal fForce As Boolean) As Long

Private Sub Command1_Click()
  If IsStandbyConfigured = True Then
    If apiIsPwrSuspendAllowed() <> 0 Then
        Call apiSetSystemPowerState(True, False)
    Else
        MsgBox ("Standby is not configured.")
    End If
  End If
End Sub

You should check to make sure that standby is configured in the operating system first.

[VB0575.JPG].NET

Const EWX_REBOOT As Int32 = 2
Const SHTDN_PLAN_ As Int32 = 65535
Private Declare Function apiExitWindowsEx Lib _
"user32" Alias "ExitWindowsEx" _
(ByVal uFlags As Int32, _
ByVal dwReserved As Int32) As Int32 

  Private Function IsStandbyConfigured() As Boolean
    Dim regKey As Microsoft.Win32.RegistryKey
    Dim regValue As Int32 : regKey = Nothing
    Try
      regKey = _
      Microsoft.Win32.Registry.LocalMachine.OpenSubKey _
      ("SYSTEM\CurrentControlSet\Services\ACPI\Parameters", _
      True)
      regValue = CInt(regKey.GetValue("Attributes"))
      If regValue = 112 Then           'If standby is off
        Dim ask As New DialogResult    'be polite about it
        regKey.SetValue("Attributes", 0)
        regValue = CInt(regKey.GetValue("Attributes"))
        If regValue = 0 Then
          IsStandbyConfigured = True
          ask = MessageBox.Show _
          ("Standby was not enabled." & vbCrLf & _
          "You must restart you computer before" & _
          " the new settings will take effect." _
          & vbCrLf & vbCrLf & _
          "Do you want to restart your computer now?", _
          "System Settings Change", _
          MessageBoxButtons.YesNo, MessageBoxIcon.Question)
          If ask = Windows.Forms.DialogResult.Yes Then
              apiExitWindowsEx(EWX_REBOOT, SHTDN_PLAN_)
          End If
        End If
      ElseIf regValue = 0 Then
          IsStandbyConfigured = True
      End If
      regKey.Flush()
      regKey.Close()
    Catch ex As Exception
      regKey.Close()
    End Try
  End Function

[VB675.JPG]VB6

You will need the functions, GetRegistryValue and SetRegistryValue, found on Page 3.

Const EWX_REBOOT As Long = 2
Const SHTDN_PLAN_ As Long = 65535
Private Declare Function apiExitWindowsEx Lib _
"user32" Alias "ExitWindowsEx" _
(ByVal uFlags As Long, _
ByVal dwReserved As Long) As Long

Private Function IsStandbyConfigured() As Boolean
  On Error Resume Next
  Dim regKey As String
  Dim regValue As Long
  regKey = "SYSTEM\CurrentControlSet\Services\ACPI\Parameters"
  regValue = CLng(GetRegistryValue(HKEY_LOCAL_MACHINE, _
  regKey, "Attributes", REG_DWORD))
  If regValue = 112 Then
    Call SetRegistryValue _
    (HKEY_LOCAL_MACHINE, regKey, "Attributes", REG_DWORD, 0)
    IsStandbyConfigured = True
    Dim res As Long
    res = MsgBox _
    ("You must restart you computer before" _
    & " the new settings will take effect." _
    & vbCrLf & vbCrLf & _
    "Do you want to restart your computer now?", _
    vbYesNo, "System Settings Change")
    If res = 6 Then 
      apiExitWindowsEx(EWX_REBOOT, SHTDN_PLAN_)
    End If
  ElseIf regValue = 0 Then
    IsStandbyConfigured = True
  End If
End Function

Shutdown Manager

Hibernate

[Hibernate.JPG]

If you want the computer to hibernate, you should make sure that your computer's BIOS is configured to allow hibernation. Then, you will need these APIs and the EnablePrivilege function.

[VB0575.JPG].NET

Const SW_HIDE As Int32 = 0
Private Declare Function apiSetSystemPowerState Lib _
"kernel32" Alias "SetSystemPowerState" _
(ByVal fSuspend As Boolean, _
ByVal fForce As Boolean) As Int32
Private Declare Function apiIsPwrHibernateAllowed Lib _
"Powrprof" Alias "IsPwrHibernateAllowed" () As Int32
Private Declare Function apiWinExec Lib _
"kernel32" Alias "WinExec" _
(ByVal lpCmdLine As String, _
ByVal nCmdShow As Int32) As Int32

Private Sub Button1_Click(ByVal sender As System.Object, _
                          ByVal e As System.EventArgs) _
   Handles Button1.Click
   apiWinExec("POWERCFG /Hibernate on", SW_HIDE)
   System.Threading.Thread.Sleep(1200)
   EnablePrivilege()
   If apiIsPwrHibernateAllowed <> 0 Then
      apiSetSystemPowerState(False, False)
   Else
      MessageBox.Show("Hibernate is not configured.")
   End If
End Sub

[VB675.JPG]VB6

Const SW_HIDE As Long = 0
Private Declare Function apiIsPwrHibernateAllowed Lib _
"Powrprof" Alias "IsPwrHibernateAllowed" () As Long
Private Declare Function apiSetSystemPowerState Lib _
"kernel32" Alias "SetSystemPowerState" _
(ByVal fSuspend As Boolean, _
ByVal fForce As Boolean) As Long
Private Declare Function apiWinExec Lib _
"kernel32" Alias "WinExec" _
(ByVal lpCmdLine As String, _
ByVal nCmdShow As Long) As Long
Private Declare Function apiSleep Lib _
"kernel32" Alias "Sleep" _
(ByVal dwMilliseconds As Long) As Long

Private Sub Command1_Click()
    Call apiWinExec("POWERCFG /Hibernate on", SW_HIDE)
    apiSleep (1200)
    If apiIsPwrHibernateAllowed <> 0 Then
        Call apiSetSystemPowerState(False, False)
    Else
        MsgBox ("Hibernate is not configured.")
    End If
End Sub

Shutdown Manager

Remote Shutdown

[Remote.JPG]

If you want to power down a remote computer, you can use the WinExec API.

[VB0575.JPG].NET

Const EWX_LOGOFF As Int32 = 0
Const EWX_REBOOT As Int32 = 2
Const EWX_POWEROFF As Int32 = 8
Const SW_SHOWNORMAL As Int32 = 1
Private Declare Function apiWinExec Lib _
"kernel32" Alias "WinExec" _
(ByVal lpCmdLine As String, _
ByVal nCmdShow As Int32) As Int32

Public Sub RemoteShutdown _
(ByVal EWX_ As Int32, ByVal cmpName As String)
  On Error Resume Next
  If EWX_ = EWX.POWER Then
    apiWinExec _
    ("tsshutdn /server:" & cmpName & " /powerdown", _
    SW_SHOWNORMAL)
  ElseIf EWX_ = EWX.RESTART Then
    apiWinExec _
    ("tsshutdn /server:" & cmpName & " /reboot", _
    SW_SHOWNORMAL)
  ElseIf EWX_ = EWX.LOGOFF Then
    Dim p As String
    p = Process.GetCurrentProcess.SessionId.ToString()
    apiWinExec _
    ("LOGOFF " & p & " /SERVER:" & cmpName & " /V", _
    SW_SHOWNORMAL)
  Else
    MessageBox.Show("Shutdown method not supported.")
  End If
End Sub

[VB675.JPG]VB6

Const EWX_LOGOFF As Long = 0
Const EWX_REBOOT As Long = 2
Const EWX_POWEROFF As Long = 8
Const SW_SHOWNORMAL As Long = 1
Const MAX_COMPUTERNAME_LENGTH As Long = 31
Private Declare Function apiWinExec Lib _
"kernel32" Alias "WinExec" _
(ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
Private Declare Function apiGetCurrentProcessId Lib _
"kernel32" Alias "GetCurrentProcessId" () As Long
Private Declare Function apiGetComputerName Lib _
"kernel32" Alias "GetComputerNameA" _
(ByVal lpBuffer As String, ByRef nSize As Long) As Long

Private Sub RemoteShutdown _
(ByVal EWX_ As Long, Optional ByVal cmpName As String)
  On Error Resume Next
  If cmpName = "" Then cmpName = GetCompName
  If EWX_ = EWX_POWEROFF Then
    Call apiWinExec _
    ("tsshutdn /server:" & cmpName & " /powerdown", _
    SW_SHOWNORMAL)
  ElseIf EWX_ = EWX_REBOOT Then
    Call apiWinExec _
    ("tsshutdn /server:" & cmpName & " /reboot", _
    SW_SHOWNORMAL)
  ElseIf EWX_ = EWX_LOGOFF Then
    Dim p As String
    P = CStr(apiGetCurrentProcessId)
    Call apiWinExec _
    ("LOGOFF " & p & " /SERVER:" & cmpName & " /V", _
    SW_SHOWNORMAL)
  Else
    MsgBox ("Shutdown method not supported.")
  End If
End Sub

Public Function GetCompName() As String
    On Error Resume Next
    Dim dwLen As Long
    dwLen = MAX_COMPUTERNAME_LENGTH + 1
    GetCompName = String(dwLen, "X")
    Call apiGetComputerName(GetCompName, dwLen)
    GetCompName = Left(GetCompName, dwLen)
End Function

Shutdown Manager

[mnuStart.JPG]

Pin to Start Menu

[StartMenu.JPG]

If you want to pin items to the start menu, this function works for 2K/XP/Vista/7

[VB0575.JPG].NET


Private Declare Function apiShellExecute Lib _
"shell32" Alias "ShellExecuteA" _
(ByVal hwnd As Int32, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Int32) As Int32


Private Declare Function apiFindWindow Lib _
"user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Int32

Private Function PinToStartMenu _
(ByVal fName As String, _
Optional ByVal pMenu As Boolean = True) As Boolean
  On Error Resume Next
  If apiFindWindow("DV2ControlHost", "Start Menu") = 0 Then
    If pMenu = True Then
       FileCopy(CurDir() & "\" & fName, smPath & fName)
       PinToStartMenu = IO.File.Exists(smPath & fName)
    End If
    If pMenu = False Then
       Kill(smPath & fName)
       PinToStartMenu = Not IO.File.Exists(smPath & fName)
    End If
  Else
    If pMenu = True Then
       PinToStartMenu = DoVerb(CurDir, fName, "Pin to Start Menu")
    Else
       PinToStartMenu = DoVerb(CurDir, fName, "Unpin from Start Menu")
    End If
  End If
End Function

Private Function DoVerb _
(ByVal dirName As String, _
ByVal filName As String, _
ByVal sVerb As String) As Integer
    On Error Resume Next

   'If blank assume this current directory
    If dirName = "" Then dirName = CurDir()

    'Create a new vbscript file and name it the verb
    FileOpen(1, sVerb.Replace("&", "") & ".vbs", _
    OpenMode.Output, , OpenShare.Shared)
    'Print out the scripts contents
    PrintLine(1, _
    "On Error Resume Next")
    PrintLine(1, _
    "Set objShell = CreateObject(" & Chr(34) & _
    "Shell.Application" & Chr(34) & ")")
    PrintLine(1, _
    "Set objFolder = objShell.Namespace(" & _
    Chr(34) & dirName & Chr(34) & ")")
    PrintLine(1, _
    "Set objFolderItem = objFolder.ParseName(" & _
    Chr(34) & filName & Chr(34) & ")")
    PrintLine(1, _
    "Set objVerbs = objFolderItem.verbs")
    PrintLine(1, _
    "For Each objVerb In objVerbs")
    PrintLine(1, _
    "If LCase(RePlace(objVerb.Name, " & _
    Chr(34) & Chr(38) & Chr(34) & ", " & Chr(34) & _
    Chr(34) & ")) = " & Chr(34) & _
    LCase(Replace(sVerb, "&", "")) & Chr(34) & " Then")
    PrintLine(1, "objVerb.DoIt")
    PrintLine(1, "End If")
    PrintLine(1, "Next")
    FileClose(1)
    'Give the script a moment to exist
    For i As Int32 = 1 To 20
        Threading.Thread.Sleep(100)
        If IO.File.Exists _
         (sVerb.Replace("&", "") & ".vbs") = True Then
            Exit For
        End If
    Next
    'If it was not created then abort function
    If IO.File.Exists _
    (sVerb.Replace("&", "") & ".vbs") = False Then
        Exit Function
    End If
    Threading.Thread.Sleep(100)
    'Open script with ShellExecute in the directory
    DoVerb = apiShellExecute _
    (0, "open", sVerb.Replace("&", "") & ".vbs", _
    vbNullString, dirName, 1)
End Function

[VB675.JPG]VB6

Const MAX_PATH As Long = 260
Const NOERROR As Long = 0
Const CSIDL_PERSONAL As Long = 5
Const CSIDL_STARTMENU As Long = 11
Private Type SHITEMID
    cb As Long
    abID As Byte
End Type
Private Type ITEMIDLIST
    mkid As SHITEMID
End Type
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Declare Function apiShellExecute Lib _
"shell32" Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Private Declare Function apiSleep Lib _
"kernel32" Alias "Sleep" _
(ByVal dwMilliseconds As Long) As Boolean

Private Declare Function apiFileExists Lib _
"shlwapi" Alias "PathFileExistsA" _
(ByVal pszPath As String) As Boolean

Private Declare Function apiFindWindow Lib _
"user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function apiCopyFile Lib _
"kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long

Private Declare Function apiDeleteFile Lib _
"kernel32" Alias "DeleteFileA" _
(ByVal fName As String) As Long

Private Declare Function apiGetVersionEx Lib _
"kernel32" Alias "GetVersionExA" _
(ByRef lpVersionInformation As OSVERSIONINFO) As Long

Private Declare Function apiSHGetSpecialFolderLocation Lib _
"shell32" Alias "SHGetSpecialFolderLocation" _
(ByVal hwndOwner As Long, _
ByVal nFolder As Long, _
ByRef pidl As ITEMIDLIST) As Long

Private Declare Function apiSHGetPathFromIDList Lib _
"shell32" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Function PinToStartMenu _
(ByVal fName As String, _
Optional ByVal pMenu As Boolean = True) As Long
   On Error Resume Next
   Dim Ret As Long
   Dim smPath As String
   smPath = GetSpecialfolder(CSIDL_STARTMENU)
   If apiFindWindow("DV2ControlHost", "Start Menu") = 0 Then
      If pMenu = True Then
        PinToStartMenu = CBool(apiCopyFile(CurDir & "\" & fName & ".lnk", smPath & "\" & fName & ".lnk", 0))
      Else
        PinToStartMenu = CBool _
        (apiDeleteFile(smPath & "\" & fName & ".lnk"))
      End If
   Else
     If pMenu = True Then
        PinToStartMenu = DoVerb _
        (CurDir, fName, "Pin to Start Menu")
     Else
        PinToStartMenu = DoVerb _
        (CurDir, fName, "Unpin from Start Menu")
     End If
   End If
End Function

Private Function DoVerb _
(ByVal dirName As String, _
ByVal filName As String, _
ByVal sVerb As String) As Long
  On Error Resume Next
  
   'If blank assume this current directory
  If dirName = "" Then dirName = CurDir
  
  'Create a new vbscript file and name it the verb
  Open Replace(sVerb, "&", "") & ".vbs" For Output Shared As #1
  Print #1, "Set objShell = CreateObject(" & Chr(34) & "Shell.Application" & Chr(34) & ")"
  Print #1, "Set objFolder = objShell.Namespace(" & Chr(34) & dirName & Chr(34) & ")"
  Print #1, "Set objFolderItem = objFolder.ParseName(" & Chr(34) & filName & Chr(34) & ")"
  Print #1, "Set objVerbs = objFolderItem.verbs"
  Print #1, "For Each objVerb In objVerbs"
  Print #1, "If LCase(RePlace(objVerb.Name, " & Chr(34) & Chr(38) & Chr(34) & ", " & _
  Chr(34) & Chr(34) & ")) = " & Chr(34) & LCase(Replace(sVerb, "&", "")) & Chr(34) & " Then"
  Print #1, "objVerb.DoIt"
  Print #1, "End If"
  Print #1, "Next"
  Close #1
  
  'Give it a moment to exist
  apiSleep (100)
  If apiFileExists _
  (Replace(sVerb, "&", "") & ".vbs") = False Then
     apiSleep (400)
  End If
  
  'If file did not exist in a reasonable time then exit
  If apiFileExists _
  (Replace(sVerb, "&", "") & ".vbs") = False Then
     Exit Function
  End If
  apiSleep (100)
  
  'Shell the vbscript
  DoVerb = apiShellExecute _
  (0, "open", Replace(sVerb, "&", "") & ".vbs", _
  vbNullString, dirName, 1)
End Function

Public Function GetSpecialfolder _
(ByRef CSIDL As Long) As String
  On Error Resume Next
  Dim IDL As ITEMIDLIST
  If apiSHGetSpecialFolderLocation _
  (100, CSIDL, IDL) = NOERROR Then
      Dim path As String
      path = Space(512)
      Call apiSHGetPathFromIDList _
      (ByVal IDL.mkid.cb, ByVal path)
      GetSpecialfolder = Left _
      (path, InStr(path, Chr(0)) - 1)
      Exit Function
  End If
End Function

Shutdown Manager

Pin to Quick Launch

[QuickLaunch.JPG]

If you want to pin items to the quick launch on 2000/XP/Vista.
Update: The quick launch no longer exists in Windows 7, but you can still pin items to the superbar, by using the DoVerb function on page 7 of this article, along with the following code.

[VB0575.JPG].NET

Private Function PinToQuickLaunch _
(ByVal fName As String, _
Optional ByVal pQLaunch As Boolean = True) As Boolean
On Error Resume Next

 Dim osv As String = _
 Environment.OSVersion.VersionString.Substring(21, 5).Remove(3, 1)
If pQLaunch = True Then
 If CDbl(osv) >= 6.17 Then
     DoVerb(CurDir, fName, "Pin to Taskbar")
 Else
    FileCopy(sDir & fName, qPath & fName)
    If IO.File.Exists(qPath & fName) = True Then
       PinToQuickLaunch = True
    End If 
 End If
Else
 If CDbl(osv) >= 6.17 Then
    DoVerb(CurDir, fName, "Unpin from Taskbar")
 Else
    If IO.File.Exists(qPath & fName) = True Then
       Kill(qPath & fName)
    End If
    If IO.File.Exists(qPath & fName) = False Then
       PinToQuickLaunch = True
    End If
 End If
End If
End Function

[VB675.JPG]VB6

Const NOERROR As Long = 0
Const CSIDL_PERSONAL As Long = 5
Private Type SHITEMID
    cb As Long
    abID As Byte
End Type
Private Type ITEMIDLIST
    mkid As SHITEMID
End Type
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Declare Function apiShellExecute Lib _
"shell32" Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Private Declare Function apiSHGetSpecialFolderLocation Lib _
"shell32" Alias "SHGetSpecialFolderLocation" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, _
pidl As ITEMIDLIST) As Long

 Private Declare Function apiSHGetPathFromIDList Lib _
"shell32" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function apiGetVersionEx Lib _
"kernel32" Alias "GetVersionExA" _
(ByRef lpVersionInformation As OSVERSIONINFO) As Long

Private Declare Function apiCopyFile Lib _
"kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long

Private Declare Function apiDeleteFile Lib _
"kernel32" Alias "DeleteFileA" _
(ByVal fName As String) As Long

Private Declare Function apiSleep Lib _
"kernel32" Alias "Sleep" _
(ByVal dwMilliseconds As Long) As Boolean

Private Declare Function apiFileExists Lib _
"shlwapi" Alias "PathFileExistsA" _
(ByVal pszPath As String) As Boolean

Private Declare Function apiFindWindow Lib _
"user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Sub Form_Load()
 Call PinToQuickLaunch(App.EXEName & ".exe", True)
End Sub


Private Function PinToQuickLaunch _
(ByVal fName As String, _
Optional ByVal pQLaunch As Boolean = True) As Boolean
   On Error Resume Next
   Dim qPath As String
   Dim osv As String
   Dim cDir As String
   qPath = GetSpecialfolder(CSIDL_PERSONAL)
   osv = GetOSVersion
   cDir = CurDir
   If osv = "5.0" Or osv = "5.1" Then
       qPath = Mid(qPath, 1, Len(qPath) - 13)
       qPath = qPath & _
"\Application Data\Microsoft\Internet Explorer\Quick Launch"
   ElseIf Mid(osv, 1, 1) = "6" Then
       qPath = Mid(qPath, 1, Len(qPath) - 10)
       qPath = qPath & _
"\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch"
   End If
   If pQLaunch = True Then
      If CDbl(osv) < 6.1 Then
         PinToQuickLaunch = apiCopyFile _
         (cDir & "\" & fName & ".lnk", _
         qPath & "\" & fName & ".lnk", 0)
      Else
        'Windows 7
         Call DoVerb _
         (CurDir, fName, "Pin to Taskbar")
      End If
   Else
      If CDbl(osv) < 6.1 Then
        If FileExists _
        (qPath & "\" & fName & ".lnk") = True Then
           PinToQuickLaunch = apiDeleteFile _
           (qPath & "\" & fName & ".lnk")
        End If
      Else
         'Windows 7
  
         Call DoVerb _
         (CurDir, fName, "Unpin from Taskbar")
      End If
   End If
End Function

Public Function GetSpecialfolder _
(ByRef CSIDL As Long) As String
  On Error Resume Next
  Dim IDL As ITEMIDLIST
  If apiSHGetSpecialFolderLocation _
    (100, CSIDL, IDL) = NOERROR Then
    Dim path As String
    path = Space(512)
    Call apiSHGetPathFromIDList _
    (ByVal IDL.mkid.cb, ByVal path)
    GetSpecialfolder = Left _
    (path, InStr(path, Chr(0)) - 1)
    Exit Function
  End If
End Function

Private Function GetOSVersion() As String
    On Error Resume Next
    Dim OSInfo As OSVERSIONINFO
    OSInfo.dwOSVersionInfoSize = Len(OSInfo)
    Call apiGetVersionEx(OSInfo)
    GetOSVersion = CStr(OSInfo.dwMajorVersion) _
    & "." & LTrim(CStr(OSInfo.dwMinorVersion))
    GetOSVersion = Trim(GetOSVersion)
End Function

Function FileExists _
(ByRef filename As String) As Boolean
    On Error Resume Next
    FileExists = (Dir(filename) <> "")
End Function

Private Function DoVerb _
(ByVal dirName As String, _
ByVal filName As String, _
ByVal sVerb As String) As Long
  On Error Resume Next
  
   'If blank assume this current directory
  If dirName = "" Then dirName = CurDir
  
  'Create a new vbscript file and name it the verb
  Open Replace(sVerb, "&", "") & ".vbs" For Output Shared As #1
  Print #1, "Set objShell = CreateObject(" & Chr(34) & "Shell.Application" & Chr(34) & ")"
  Print #1, "Set objFolder = objShell.Namespace(" & Chr(34) & dirName & Chr(34) & ")"
  Print #1, "Set objFolderItem = objFolder.ParseName(" & Chr(34) & filName & Chr(34) & ")"
  Print #1, "Set objVerbs = objFolderItem.verbs"
  Print #1, "For Each objVerb In objVerbs"
  Print #1, "If LCase(RePlace(objVerb.Name, " & Chr(34) & Chr(38) & Chr(34) & ", " & _
  Chr(34) & Chr(34) & ")) = " & Chr(34) & LCase(Replace(sVerb, "&", "")) & Chr(34) & " Then"
  Print #1, "objVerb.DoIt"
  Print #1, "End If"
  Print #1, "Next"
  Close #1
  
  'Give it a moment to exist
  apiSleep (100)
  If apiFileExists _
  (Replace(sVerb, "&", "") & ".vbs") = False Then
     apiSleep (400)
  End If
  
  'If file did not exist in a reasonable time then exit
  If apiFileExists _
  (Replace(sVerb, "&", "") & ".vbs") = False Then
     Exit Function
  End If
  apiSleep (100)
  
  'Shell the vbscript
  DoVerb = apiShellExecute _
  (0, "open", Replace(sVerb, "&", "") & ".vbs", _
  vbNullString, dirName, 1)
End Function


Shutdown Manager

Keep Taskbar on Top

[QuickLaunch.JPG]

If you want to keep the taskbar on top of other windows.

[VB0575.JPG].NET

Const ABM_GETSTATE As Int32 = 4
Const ABM_SETSTATE As Int32 = 10
Const ABS_AUTOHIDE As Int32 = 1
Const ABS_ALWAYSONTOP As Int32 = 2
Private Structure APPBARDATA
   Public cbSize, hwnd, uCallbackMessage, uEdge As Int32, rc _
      As RECT, lParam As Int32
End Structure
Private Structure RECT
   Public rLeft, rTop, rRight, rBottom As Int32
End Structure
Private Declare Function apiSHAppBarMessage Lib _
"shell32" Alias "SHAppBarMessage" _
(ByVal dwMessage As Int32, _
ByRef pData As APPBARDATA) As Int32

Private Function AlwaysOnTop(ByVal kOnTop As Boolean) As Int32
 On Error Resume Next
 Dim ABD As New APPBARDATA
 AlwaysOnTop = apiSHAppBarMessage(ABM_GETSTATE, Nothing)
 If kOnTop = True Then
   If AlwaysOnTop = 0 OrElse AlwaysOnTop = ABS_AUTOHIDE Then
     AlwaysOnTop += ABS_ALWAYSONTOP
     ABD.lParam = AlwaysOnTop
     apiSHAppBarMessage(ABM_SETSTATE, ABD)
     AlwaysOnTop = apiSHAppBarMessage(ABM_GETSTATE, Nothing)
     If AlwaysOnTop = 0 OrElse AlwaysOnTop = ABS_AUTOHIDE Then
        Return 0
     Else
        Return 1
     End If
   End If
 Else
    If AlwaysOnTop = ABS_ALWAYSONTOP OrElse AlwaysOnTop = _
     (ABS_AUTOHIDE + ABS_ALWAYSONTOP) Then
     AlwaysOnTop -= ABS_ALWAYSONTOP
     ABD.lParam = AlwaysOnTop
     apiSHAppBarMessage(ABM_SETSTATE, ABD)
     SendKeys.Flush() : Threading.Thread.Sleep(0)
     AlwaysOnTop = apiSHAppBarMessage(ABM_GETSTATE, Nothing)
     If AlwaysOnTop = ABS_ALWAYSONTOP OrElse AlwaysOnTop = _
        (ABS_ALWAYSONTOP + ABS_AUTOHIDE) Then
        Return 0
     Else
        Return 1
     End If
    End If
 End If
End Function

[VB675.JPG]VB6

Const ABM_GETSTATE As Long = 4
Const ABM_SETSTATE As Long = 10
Const ABS_AUTOHIDE As Long = 1
Const ABS_ALWAYSONTOP As Long = 2
Private Type RECT
    rLeft As Long
    rTop As Long
    rRight As Long
    rBottom As Long
End Type
Private Type APPBARDATA
    cbSize As Long
    hWnd As Long
    uCallbackMessage As Long
    uEdge As Long
    rc As RECT
    lParam As Long
End Type
Private Declare Function apiSHAppBarMessage Lib _
"shell32" Alias "SHAppBarMessage" _
(ByVal dwMessage As Long, ByRef pData As APPBARDATA) As Long

Private Function AlwaysOnTop(ByVal kOnTop As Boolean) As Long
   On Error Resume Next
   Dim abd As APPBARDATA
   AlwaysOnTop = apiSHAppBarMessage(ABM_GETSTATE, abd)
   If kOnTop = True Then
     If AlwaysOnTop = 0 Or AlwaysOnTop = ABS_AUTOHIDE Then
       AlwaysOnTop = AlwaysOnTop + ABS_ALWAYSONTOP
       abd.lParam = AlwaysOnTop
       Call apiSHAppBarMessage(ABM_SETSTATE, abd)
       AlwaysOnTop = apiSHAppBarMessage(ABM_GETSTATE, abd)
       If AlwaysOnTop = 0 Or AlwaysOnTop = ABS_AUTOHIDE Then
          AlwaysOnTop = 0
       Else
          AlwaysOnTop = 1
       End If
       Exit Function
     End If
   Else
     If AlwaysOnTop = ABS_ALWAYSONTOP Or _
     AlwaysOnTop = (ABS_ALWAYSONTOP + ABS_AUTOHIDE) Then
       AlwaysOnTop = AlwaysOnTop - ABS_ALWAYSONTOP
       abd.lParam = AlwaysOnTop
       Call apiSHAppBarMessage(ABM_SETSTATE, abd)
       AlwaysOnTop = apiSHAppBarMessage(ABM_GETSTATE, abd)
       If AlwaysOnTop = ABS_ALWAYSONTOP Or _
       AlwaysOnTop = (ABS_ALWAYSONTOP + ABS_AUTOHIDE) Then
          AlwaysOnTop = 0
       Else
          AlwaysOnTop = 1
       End If
       Exit Function
     End If
   End If
End Function

Shutdown Manager

Show Quick Launch | Lock the Taskbar

[TaskStartProp.JPG]

If you want to automatically set "Show Quick Launch" or "Lock the taskbar", it can be done like this.

[VB0575.JPG].NET

Const BM_GETCHECK As Int32 = 240
Const BST_UNCHECKED As Int32 = 0
Const BST_CHECKED As Int32 = 1
Const WM_CLOSE As Int32 = 16
Const KEYEVENTF_KEYUP As Int32 = 2
Const WM_COMMAND As Int32 = 273
Private Declare Function apiFindWindow Lib _
"user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Int32
Private Declare Function apiFindWindowEx Lib _
"user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Int32, _
ByVal hWnd2 As Int32, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Int32
Private Declare Function apikeybd_event Lib _
"user32" Alias "keybd_event" _
(ByVal bVk As Int32, _
ByVal bScan As Int32, _
ByVal dwFlags As Int32, _
ByVal dwExtraInfo As Int32) As Boolean
Private Declare Function apiSendMessage Lib _
"user32" Alias "SendMessageA" _
(ByVal hWnd As Int32, _
ByVal wMsg As Int32, _
ByVal wParam As Int32, _
ByVal lParam As String) As Int32
Private Declare Function apiPostMessage Lib _
"user32" Alias "PostMessageA" _
(ByVal hWnd As Int32, _
ByVal wMsg As Int32, _
ByVal wParam As Int32, _
ByVal lParam As String) As Int32
Private Declare Function apiSetForegroundWindow Lib _
"user32" Alias "SetForegroundWindow" _
(ByVal hWnd As Int32) As Int32

Public Sub ShowQuickLaunch()
  On Error Resume Next
  Dim hWnd, twnd, qWnd, lwnd, tBar As Int32
  Dim res, i, lState, qState As Int32
  tBar = apiFindWindow("Shell_TrayWnd", vbNullString)
  apiSendMessage _
  (tBar, WM_COMMAND, 413, vbNullString)
  For i = 1 To 160
      hWnd = apiFindWindow(vbNullString, _
      "Taskbar and Start Menu Properties")
      If hWnd <> 0 Then Exit For
      Threading.Thread.Sleep(25)
  Next
  If hWnd <> 0 Then
    twnd = apiFindWindowEx _
    (hWnd, 0, vbNullString, "Taskbar")
    If twnd <> 0 Then
      qWnd = apiFindWindowEx _
      (twnd, 0, "Button", "Show &Quick Launch")
      lwnd = apiFindWindowEx _
      (twnd, 0, "Button", "&Lock the taskbar")
      lState = apiSendMessage _
      (lwnd, BM_GETCHECK, 0, vbNullString)
      qState = apiSendMessage _
      (qWnd, BM_GETCHECK, 0, vbNullString)
      If qState = BST_UNCHECKED Then
          If apiSetForegroundWindow(hWnd) <> 0 Then
            KeyEvent(Keys.Q)
            If lState = BST_CHECKED Then
                KeyEvent(Keys.L)
            End If
            KeyEvent(Keys.A)
            Threading.Thread.Sleep(400)
          End If
      End If
    End If
    apiPostMessage(hWnd, WM_CLOSE, 0, vbNullString)
  End If
End Sub

Private Function KeyEvent(ByVal vKey As Int32) As Int32
    On Error Resume Next
    Dim kd As Boolean
    Dim ku As Boolean
    kd = apikeybd_event(vKey, 0, 0, 0)
    ku = apikeybd_event(vKey, 0, KEYEVENTF_KEYUP, 0)
    If kd = True AndAlso ku = True Then KeyEvent = 1
End Function

[VB675.JPG]VB6

Const BM_GETCHECK As Long = 240
Const BST_UNCHECKED As Long = 0
Const BST_CHECKED As Long = 1
Const KEYEVENTF_KEYUP As Long = 2
Const WM_CLOSE As Long = 16
Const VK_A As Long = 65
Const VK_L As Long = 76
Const VK_Q As Long = 81
Const WM_COMMAND As Long = 273
Private Declare Function apiFindWindow Lib _
"user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function apiFindWindowEx Lib _
"user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function apikeybd_event Lib _
"user32" Alias "keybd_event" _
(ByVal bVk As Long, _
ByVal bScan As Long, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long) As Boolean
Private Declare Function apiSendMessage Lib _
"user32" Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As String) As Long
Private Declare Function apiPostMessage Lib _
"user32" Alias "PostMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As String) As Long
Private Declare Function apiSetForegroundWindow Lib _
"user32" Alias "SetForegroundWindow" _
(ByVal hWnd As Long) As Long
Private Declare Function apiSleep Lib _
"kernel32" Alias "Sleep" _
(ByVal dwMilliseconds As Long) As Long

Public Sub ShowQuickLaunch()
  On Error Resume Next
  Dim hWnd As Long
  Dim twnd As Long
  Dim qWnd As Long
  Dim lwnd As Long
  Dim tBar As Long
  Dim lState As Long
  Dim qState As Long
  Dim i As Long
  tBar = apiFindWindow("Shell_TrayWnd", vbNullString)
  Call apiSendMessage _
  (tBar, WM_COMMAND, 413, vbNullString)
  For i = 1 To 160
      hWnd = apiFindWindow(vbNullString, _
      "Taskbar and Start Menu Properties")
      If hWnd <> 0 Then Exit For
      Call apiSleep(25)
  Next
  If hWnd <> 0 Then
    twnd = apiFindWindowEx _
    (hWnd, 0, vbNullString, "Taskbar")
    If twnd <> 0 Then
      qWnd = apiFindWindowEx _
      (twnd, 0, "Button", "Show &Quick Launch")
      lwnd = apiFindWindowEx _
      (twnd, 0, "Button", "&Lock the taskbar")
      lState = apiSendMessage _
      (lwnd, BM_GETCHECK, 0, vbNullString)
      qState = apiSendMessage _
      (qWnd, BM_GETCHECK, 0, vbNullString)
      If qState = BST_UNCHECKED Then
        If apiSetForegroundWindow(hWnd) <> 0 Then
          KeyEvent (VK_Q)
          If lState = BST_CHECKED Then
            KeyEvent (VK_Q)
          End If
          KeyEvent (VK_A)
          Call apiSleep(400)
        End If
      End If
    End If
    Call apiPostMessage(hWnd, WM_CLOSE, 0, vbNullString)
  End If
End Sub
Private Function KeyEvent(ByVal vKey As Long) As Long
    On Error Resume Next
    Dim kd As Boolean
    Dim ku As Boolean
    kd = apikeybd_event(vKey, 0, 0, 0)
    ku = apikeybd_event(vKey, 0, KEYEVENTF_KEYUP, 0)
    If kd = True And ku = True Then KeyEvent = 1
End Function

Shutdown Manager

Hide/Show Power Button

[Power.JPG]

If you want to hide/show the Windows power button from the Start menu, change the Registry setting for it. Then, restart the computer for the new settings to take effect.

[VB0575.JPG].NET

Const EWX_REBOOT As Int32 = 2
Private Declare Function apiRestartDialog Lib _
"shell32" Alias "RestartDialog" _
(ByVal hWnd As Int32, _
ByVal xPrompt As String, _
ByVal EWX_ As Int32) As Int32

Private Function IsPowerVisible _
(ByVal wHide As Boolean) As Boolean
 Dim regKey As Microsoft.Win32.RegistryKey, _
    regValue As Int32, IsChange As Boolean
 Dim result As New DialogResult, rMess As String
 regKey = Nothing
 Try
    regKey = Microsoft.Win32.Registry.CurrentUser.OpenSubKey _
       ("SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\ _
         Explorer", True)
    regValue = CInt(regKey.GetValue("NoClose"))
    If regValue = 1 Then
     If wHide = False Then
      rMess = "The windows power button is not visible." _
      & vbCrLf & vbCrLf & "Would you like to make it _
      visible now?"
      result = MessageBox.Show(rMess, "Power Configuration", _
      MessageBoxButtons.YesNo, MessageBoxIcon.Question)
      If result = Windows.Forms.DialogResult.Yes Then
        regKey.SetValue("NoClose", 0) : IsChange = True
      End If
     End If
    Else
     If wHide = True Then
      rMess = "The windows power button is still visible." _
      & vbCrLf & vbCrLf & "Would you like to hide it now?"
      result = MessageBox.Show(rMess, "Power Configuration", _
      MessageBoxButtons.YesNo, MessageBoxIcon.Question)
      If result = Windows.Forms.DialogResult.Yes Then
        regKey.SetValue("NoClose", 1) : IsChange = True
      End If
     End If
    End If
    regValue = CInt(regKey.GetValue("NoClose"))
    regKey.Flush()
    regKey.Close()
    If IsChange = True Then
       apiRestartDialog _
       (Me.Handle.ToInt32, vbNullString, EWX_REBOOT)
    End If
 Catch ex As Exception
    regKey.Close()
 End Try
 Return Not CBool(regValue)
End Function

[VB675.JPG]VB6

You'll need the functions: GetRegistryValue and SetRegistryValue.

Const EWX_REBOOT As Long = 2
Private Declare Function apiRestartDialog Lib _
"shell32" Alias "RestartDialog" _
(ByVal hWnd As Long, _
ByVal xPrompt As String, _
ByVal EWX_ As Long) As Long

Private Function IsPowerVisible(ByVal wHide As Boolean) As Boolean
    On Error Resume Next
    If Loaded = False Then Exit Function
    Dim regKey As String
    Dim regValue As Long
    Dim IsChange As Boolean
    Dim result As Long
    Dim rMess As String
    regKey = _
    "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer"
    regValue = CInt(GetRegistryValue _
    (HKEY_CURRENT_USER, regKey, "NoClose", REG_DWORD))
    If regValue = 1 Then
       If wHide = False Then
          rMess = "The windows power button is not visible." _
          & vbCrLf & vbCrLf & _
          "Would you like to make it visible now?"
          result = MsgBox(rMess, vbYesNo, "Power Configuration")
          If result = vbYes Then
             Call SetRegistryValue(HKEY_CURRENT_USER, regKey, _
             "NoClose", REG_DWORD, 0)
             IsChange = True
          End If
       End If
    Else
       If wHide = True Then
          rMess = "The windows power button is still visible." _
          & vbCrLf & vbCrLf & "Would you like to hide it now?"
          result = MsgBox(rMess, vbYesNo, "Power Configuration")
          If result = vbYes Then
             Call SetRegistryValue(HKEY_CURRENT_USER, regKey, _
             "NoClose", REG_DWORD, 1)
             IsChange = True
          End If
       End If
    End If
    regValue = CInt(GetRegistryValue(HKEY_CURRENT_USER, regKey, _
    "NoClose", REG_DWORD))
    If IsChange = True Then
       Call apiRestartDialog(Me.hWnd, vbNullString, EWX_REBOOT)
    End If
    IsPowerVisible = Not CBool(regValue)
End Function

Hide/Show Logoff Button

[Logoff.JPG]

If you want to hide/show the Windows logoff button from the Start menu, change the Registry setting for it. Then, restart the computer for the new settings to take effect.

[VB0575.JPG].NET

Const EWX_REBOOT As Int32 = 2
Private Declare Function apiRestartDialog Lib "shell32" Alias _
"RestartDialog" (ByVal hWnd As Int32, ByVal xPrompt As String, _
                 ByVal EWX_ As Int32) As Int32

Private Function IsLogOffVisible(ByVal wHide As Boolean) As Boolean
   Dim regKey As Microsoft.Win32.RegistryKey, _
      regValue As Int32, IsChange As Boolean
   Dim result As New DialogResult, rMess As String
   regKey = Nothing
   Try
      regKey = Microsoft.Win32.Registry.CurrentUser.OpenSubKey _
         ("SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\ _
           Explorer", True)
      regValue = CInt(regKey.GetValue("StartMenuLogOff"))
      If regValue = 1 Then
         If wHide = False Then
            rMess = "The windows logoff button is not visible." _
            & vbCrLf & vbCrLf & "Would you like to make it _
               visible now?"
            result = MessageBox.Show(rMess, "Logoff Configuration", _
            MessageBoxButtons.YesNo, MessageBoxIcon.Question)
            If result = Windows.Forms.DialogResult.Yes Then
               regKey.SetValue("StartMenuLogOff", 0) : _
                  IsChange = True
            End If
         End If
      Else
         If wHide = True Then
            rMess = "The windows logoff button is still visible." _
            & vbCrLf & vbCrLf & "Would you like to hide it now?"
            result = MessageBox.Show(rMess, "Logoff Configuration", _
            MessageBoxButtons.YesNo, MessageBoxIcon.Question)
            If result = Windows.Forms.DialogResult.Yes Then
               regKey.SetValue("StartMenuLogOff", 1) : _
                  IsChange = True
            End If
         End If
      End If
      regValue = CInt(regKey.GetValue("StartMenuLogOff"))
      regKey.Flush()
      regKey.Close()
      If IsChange = True Then
         apiRestartDialog(Me.Handle.ToInt32, vbNullString, EWX_REBOOT)
      End If
   Catch ex As Exception
      regKey.Close()
   End Try
   Return Not CBool(regValue)
End Function

[VB675.JPG]VB6

You'll need the functions: GetRegistryValue and SetRegistryValue.

Const EWX_REBOOT As Long = 2
Private Declare Function apiRestartDialog Lib _
"shell32" Alias "RestartDialog" _
(ByVal hWnd As Long, ByVal xPrompt As String, _
ByVal EWX_ As Long) As Long

Private Function IsLogOffVisible(ByVal wHide As Boolean) As Boolean
   On Error Resume Next
   If Loaded = False Then Exit Function
   Dim regKey As String
   Dim regValue As Long
   Dim IsChange As Boolean
   Dim result As Long
   Dim rMess As String
   regKey = _
   "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer"
   regValue = GetRegistryValue _
   (HKEY_CURRENT_USER, regKey, "StartMenuLogOff", REG_DWORD)
       If regValue = 1 Then
          If wHide = False Then
             rMess = "The windows logoff button is not visible." _
             & vbCrLf & vbCrLf & "Would you like to make it visible now?"
             result = MsgBox(rMess, vbYesNo, "Logoff Configuration")
             If result = vbYes Then
               Call SetRegistryValue(HKEY_CURRENT_USER, regKey, _
               "StartMenuLogOff", REG_DWORD, 0)
               IsChange = True
             End If
          End If
       Else
          If wHide = True Then
             rMess = "The windows logoff button is still visible." _
             & vbCrLf & vbCrLf & "Would you like to hide it now?"
             result = MsgBox(rMess, vbYesNo, "Logoff Configuration")
             If result = vbYes Then
               Call SetRegistryValue(HKEY_CURRENT_USER, regKey, _
               "StartMenuLogOff", REG_DWORD, 1)
               IsChange = True
             End If
          End If
       End If
       regValue = CInt(GetRegistryValue(HKEY_CURRENT_USER, regKey, _
       "StartMenuLogOff", REG_DWORD))
       If IsChange = True Then

          Call apiRestartDialog(Me.hWnd, vbNullString, EWX_REBOOT)
       End If
       IsLogOffVisible = Not CBool(regValue)
End Function

That concludes this article for now. I hope you've found it useful, and error free. If you would like to learn more about customizing your taskbar, check out this great article by the well-known guru HanneSThEGreaT! The TaskBar and VB.NET.

Shutdown Manager

Bonus Pin to taskbar

[Context.jpg]

Before I figured out how to pin a program to the Superbar on Windows 7, I had written code to pin a form directly to the taskbar. This may be useful because it allows a little more flexibilty, since you can use all the common form events you're already familiar with. The windows 7 taskbar abilities can be duplicated or exceeded with relative ease.

Here is the basic code that will keep a form pinned to the windows 7 superbar. You will need to place a timer on a form.

Bonus: The full source to the ShutDownTask program is available below.

Public Class Form1
    Public Structure RECT
        Public rLeft As Int32
        Public rTop As Int32
        Public rRight As Int32
        Public rBottom As Int32
    End Structure
    Private Structure TASKBARINFO
        Public isTop As Boolean
        Public isBottom As Boolean
        Public isLeft As Boolean
        Public isRight As Boolean
        Public autoHide As Boolean
        Public alwaysTop As Boolean
        Public hwnd As Int32
        Public width As Int32
        Public height As Int32
        Public top As Int32
        Public bottom As Int32
        Public left As Int32
        Public right As Int32
    End Structure
    Private Declare Function apiFindWindowEx Lib _
    "user32" Alias "FindWindowExA" _
    (ByVal hWnd1 As Int32, _
    ByVal hWnd2 As Int32, _
    ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As Int32
    Private Declare Function apiGetWindowRect Lib _
    "user32" Alias "GetWindowRect" _
    (ByVal hWnd As Int32, _
    ByRef lpRect As RECT) As Boolean
    Private Declare Function apiMoveWindow Lib _
    "user32" Alias "MoveWindow" _
    (ByVal hWnd As Int32, _
    ByVal x As Int32, _
    ByVal y As Int32, _
    ByVal nWidth As Int32, _
    ByVal nHeight As Int32, _
    ByVal bRepaint As Boolean) As Boolean
    Private Declare Function apiSetParent Lib _
    "user32" Alias "SetParent" _
    (ByVal hWndChild As Int32, _
    ByVal hWndNewParent As Int32) As Int32
    Private cTas As New TASKBARINFO
    Private pTas As New TASKBARINFO
    Private osv As String = "5.00"

    Private Sub Form1_Load _
    (ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles MyBase.Load
        osv = _
        Environment.OSVersion.VersionString.Substring _
        (21, 5).Remove(3, 1)
        PinToTaskBar()
        Timer1.Interval = 200
        Timer1.Enabled = True
    End Sub

    Private Sub Form1_Click _
    (ByVal sender As Object, _
    ByVal e As System.EventArgs) Handles Me.Click
        MessageBox.Show("Closing")
        Me.Close()
    End Sub

    Private Sub Timer1_Tick _
    (ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles Timer1.Tick
        On Error Resume Next
        CheckPin()
    End Sub

    Private Sub CheckPin()
        On Error Resume Next

        'If already pinned, make sure taskbar not moved/resized
        If Me.FormBorderStyle <> _
        Windows.Forms.FormBorderStyle.None Then Exit Sub
        cTas = GetTaskBarInfo() 'Get current taskbar info

        'Get handle of "Running applications" parent
        Dim rWnd As Int32 = apiFindWindowEx _
        (cTas.hwnd, 0, "ReBarWindow32", Nothing)
        Dim r, rs As New RECT
        apiGetWindowRect(rWnd, r) 'Get its rectangle
        If CDbl(osv) >= 6 Then 'If Vista or above
            'Get the rectangle dimensions of the start button
            apiGetWindowRect _
            (apiFindWindowEx(0, 0, "Button", "Start"), rs)
        Else 'if 2000/xp/
            'Get the rectangle dimensions of the start button
            apiGetWindowRect _
            (apiFindWindowEx _
            (cTas.hwnd, 0, "Button", "Start"), rs)
        End If

        'If there is any difference from last check
        If cTas.height <> pTas.height OrElse _
        cTas.width <> pTas.width OrElse _
        cTas.isBottom <> pTas.isBottom OrElse _
        cTas.isTop <> pTas.isTop OrElse _
        cTas.isLeft <> pTas.isLeft OrElse _
        cTas.isRight <> pTas.isRight OrElse _
        cTas.isBottom = True AndAlso _
        r.rLeft < (rs.rRight + cTas.height) Then
            pTas = cTas 'Update previous to current
            PinToTaskBar() 're-pin taskbar if moved/resized
        End If
    End Sub

    Private Sub PinToTaskBar()
        On Error Resume Next
        Dim tbi As TASKBARINFO = GetTaskBarInfo()
        Dim srtRect, rbwRect As New RECT
        Dim rbHwnd As Int32

        'Hide titlebar
        Me.FormBorderStyle = _
        Windows.Forms.FormBorderStyle.None

        'Make sure form is not in taskbar also while pinned
        Me.ShowInTaskbar = False

        'get handle to taskbars middle window
        rbHwnd = apiFindWindowEx _
        (tbi.hwnd, 0, "ReBarWindow32", Nothing)

        'Set the taskbar as our new parent. Daddy
        apiSetParent(Me.Handle.ToInt32, tbi.hwnd)

        If CDbl(osv) >= 6 Then 'If Vista or above
            'Get the rectangle of the start button
            apiGetWindowRect _
            (apiFindWindowEx _
            (0, 0, "Button", "Start"), srtRect)
        Else 'if 2000/xp/
            'Get the rectangle of the start button
            apiGetWindowRect _
            (apiFindWindowEx _
            (tbi.hwnd, 0, "Button", "Start"), srtRect)
        End If

        'Get the rectangle of the running apps window
        apiGetWindowRect(rbHwnd, rbwRect)

        'If the taskbar/superbar on bottom of work area
        If tbi.isBottom Then
            apiMoveWindow _
            (Me.Handle.ToInt32, srtRect.rRight, 3, _
            (tbi.height - 4), (tbi.height - 4), True)
            apiMoveWindow _
            (rbHwnd, (srtRect.rRight + tbi.height), 0, _
            rbwRect.rRight - _
            (srtRect.rRight + tbi.height), tbi.height, True)
        ElseIf tbi.isTop Then 'taskbar is up top
            'move to proper coordinate relationship
        ElseIf tbi.isLeft Then 'taskbar is on the left
            'move to proper coordinates
        ElseIf tbi.isRight Then 'taskbar is on the right
            'move to proper coordinates
        End If
        'Bring it to the top
        Me.TopMost = True
    End Sub

    Private Function GetTaskBarInfo() As TASKBARINFO
        On Error Resume Next
        Dim d As New Size, r As New RECT
        Dim hwnd As Int32 = apiFindWindowEx _
        (0, 0, "Shell_TrayWnd", Nothing)
        apiGetWindowRect(hwnd, r)
        GetTaskBarInfo.hwnd = hwnd
        GetTaskBarInfo.height = (r.rBottom - r.rTop)
        GetTaskBarInfo.width = (r.rRight - r.rLeft)
        GetTaskBarInfo.top = r.rTop
        GetTaskBarInfo.bottom = r.rBottom
        GetTaskBarInfo.left = r.rLeft
        GetTaskBarInfo.right = r.rRight
        d = My.Computer.Screen.WorkingArea.Size

        'TaskBar Position
        If r.rTop = 0 AndAlso r.rBottom = d.Height Then
            If r.rLeft < (d.Width / 2) Then
                'Left
                GetTaskBarInfo.isLeft = True
            Else 'right
                GetTaskBarInfo.isRight = True
            End If
        Else
            If r.rTop < (d.Height / 2) Then
                'top
                GetTaskBarInfo.isTop = True
            Else 'bottom
                GetTaskBarInfo.isBottom = True
            End If
        End If
    End Function

End Class



About the Author

Shane Findley

Developer of applications for use in number theory.

Downloads

Comments

  • There are no comments yet. Be the first to comment!

Leave a Comment
  • Your email address will not be published. All fields are required.

Top White Papers and Webcasts

  • The explosion in mobile devices and applications has generated a great deal of interest in APIs. Today's businesses are under increased pressure to make it easy to build apps, supply tools to help developers work more quickly, and deploy operational analytics so they can track users, developers, application performance, and more. Apigee Edge provides comprehensive API delivery tools and both operational and business-level analytics in an integrated platform. It is available as on-premise software or through …

  • Live Event Date: September 10, 2014 @ 11:00 a.m. ET / 8:00 a.m. PT Modern mobile applications connect systems-of-engagement (mobile apps) with systems-of-record (traditional IT) to deliver new and innovative business value. But the lifecycle for development of mobile apps is also new and different. Emerging trends in mobile development call for faster delivery of incremental features, coupled with feedback from the users of the app "in the wild". This loop of continuous delivery and continuous feedback is …

Most Popular Programming Stories

More for Developers

Latest Developer Headlines

RSS Feeds