Shutdown Timer Using Visual Basic 6

[gaby90boy]

This is a sample program showing you how to make a program to time when to shutdown your computer. It uses 1 Form, 1 Module and the source code is listed below. Either download the project below or build a form called frmMain and copy the form source code into and and make a Module called modMain and copy the module source code into it. The properties for your form are listed below. The options in this program are as follows:

1. Shutdown your operating system at a certain time

2. Turn off your computer at a certain time

3. Restart your computer at a certain time

4. Log off your computer at a certain time

5. Use force to shutdown your computer

6. Force your computer to shutdown if it Freezes

Screenshot of Software Program

The properties for this project is listed below.

3 Command Buttons

4 Combo Boxes

1 Form

6 Labels

2 List Boxes

8 Menus

1 Timer

1 Module

You can also download the

http://www.11amdesign.com/visualbasic/shutdown_timer.zip

source code which has the project already built to learn from using Visual Basic 6.

Form Source Code

Option Explicit

Private Sub btnExit_Click()

frmCancelUnload = False

Unload Me

End Sub

Private Sub btnTurnOFF_Click()

btnTurnON.Enabled = True

btnTurnOFF.Enabled = False

mnuPopupTurnON.Enabled = True

mnuPopupTurnOFF.Enabled = False

cboHour.Enabled = True

cboMinute.Enabled = True

cboSecond.Enabled = True

cboAMPM.Enabled = True

lstOptions.Enabled = True

lstExtra.Enabled = True

Me.Caption = "Shutdown Timer - OFF"

tmrShutdown.Enabled = False

End Sub

Private Sub btnTurnON_Click()

btnTurnON.Enabled = False

btnTurnOFF.Enabled = True

mnuPopupTurnON.Enabled = False

mnuPopupTurnOFF.Enabled = True

cboHour.Enabled = False

cboMinute.Enabled = False

cboSecond.Enabled = False

cboAMPM.Enabled = False

lstOptions.Enabled = False

lstExtra.Enabled = False

Me.Caption = "Shutdown Timer - ON"

strShutdown = cboHour.Text & ":" & cboMinute.Text & ":" & cboSecond.Text & " " & cboAMPM.Text

tmrShutdown.Enabled = True

End Sub

Private Sub cboAMPM_Click()

strShutdown = cboHour.Text & ":" & cboMinute.Text & ":" & cboSecond.Text & " " & cboAMPM.Text

End Sub

Private Sub cboHour_Click()

strShutdown = cboHour.Text & ":" & cboMinute.Text & ":" & cboSecond.Text & " " & cboAMPM.Text

End Sub

Private Sub cboMinute_Click()

strShutdown = cboHour.Text & ":" & cboMinute.Text & ":" & cboSecond.Text & " " & cboAMPM.Text

End Sub

Private Sub cboSecond_Click()

strShutdown = cboHour.Text & ":" & cboMinute.Text & ":" & cboSecond.Text & " " & cboAMPM.Text

End Sub

Private Sub Form_Load()

Dim intCnt As Integer

Dim strOptSel As String

Dim strExtSel As String

Dim strHour As String

Dim strMinute As String

Dim strSecond As String

Dim strAMPM As String

For intCnt = 1 To 12

DoEvents

cboHour.AddItem intCnt

Next intCnt

For intCnt = 0 To 59

DoEvents

cboMinute.AddItem intCnt

Next intCnt

For intCnt = 0 To 59

DoEvents

cboSecond.AddItem intCnt

Next intCnt

With lstOptions

.AddItem "Shutdown OS"

.AddItem "Turn off Computer"

.AddItem "Restart"

.AddItem "Log off"

End With

cboAMPM.AddItem "AM"

cboAMPM.AddItem "PM"

lstExtra.AddItem "Use Force"

lstExtra.AddItem "Force only if Freezes"

strIniPath = App.Path & "\" & App.Title & ".ini"

strOptSel = String(255, vbNullChar)

strExtSel = String(255, vbNullChar)

Call GetPrivateProfileString("Options", "Selected", 1, strOptSel, 255, strIniPath)

Call GetPrivateProfileString("Extra", "Selected", 1, strExtSel, 255, strIniPath)

lstOptions.Selected(Int(strOptSel)) = True

lstExtra.Selected(Int(strExtSel)) = True

strHour = String(255, vbNullChar)

strMinute = String(255, vbNullChar)

strSecond = String(255, vbNullChar)

strAMPM = String(255, vbNullChar)

Call GetPrivateProfileString("Shutdown", "Hour", 3, strHour, 255, strIniPath)

Call GetPrivateProfileString("Shutdown", "Minute", 15, strMinute, 255, strIniPath)

Call GetPrivateProfileString("Shutdown", "Second", 45, strSecond, 255, strIniPath)

Call GetPrivateProfileString("Shutdown", "AMPM", "AM", strAMPM, 255, strIniPath)

cboHour.Text = strHour

cboMinute.Text = strMinute

cboSecond.Text = strSecond

cboAMPM.Text = strAMPM

strShutdown = cboHour.Text & ":" & cboMinute.Text & ":" & cboSecond.Text & " " & cboAMPM.Text

If IsWinNT = False Then lstExtra.Enabled = False

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

Dim xTray As Single

xTray = x / Screen.TwipsPerPixelX

Select Case xTray

Case WM_RBUTTONDOWN

Call SetForegroundWindow(Me.hwnd)

Call PopupMenu(mnuPopup)

Case WM_LBUTTONDBLCLK

Call SetForegroundWindow(Me.hwnd)

Me.Show

End Select

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

Cancel = frmCancelUnload

If frmCancelUnload = True Then

Me.WindowState = vbMinimized

Me.Hide

Me.WindowState = vbNormal

End If

End Sub

Private Sub Form_Unload(Cancel As Integer)

Call Shell_NotifyIcon(NIM_DELETE, nid_Tray)

Call SavePos(Me, strIniPath)

Call WriteINI("Options", "Selected", lstOptions.ListIndex, strIniPath)

Call WriteINI("Extra", "Selected", lstExtra.ListIndex, strIniPath)

Call WriteINI("Shutdown", "Hour", cboHour.Text, strIniPath)

Call WriteINI("Shutdown", "Minute", cboMinute.Text, strIniPath)

Call WriteINI("Shutdown", "Second", cboSecond.Text, strIniPath)

Call WriteINI("Shutdown", "AMPM", cboAMPM.Text, strIniPath)

End Sub

Private Sub lstExtra_Click()

lstExtra.Selected(lstExtra.ListIndex) = True

End Sub

Private Sub lstExtra_ItemCheck(Item As Integer)

Dim iLst As Integer

For iLst = 0 To (lstExtra.ListCount - 1)

If iLst <> Item Then lstExtra.Selected(iLst) = False

Next iLst

End Sub

Private Sub lstOptions_Click()

lstOptions.Selected(lstOptions.ListIndex) = True

End Sub

Private Sub lstOptions_ItemCheck(Item As Integer)

Dim iLst As Integer

For iLst = 0 To (lstOptions.ListCount - 1)

DoEvents

If iLst <> Item Then lstOptions.Selected(iLst) = False

Next iLst

End Sub

Private Sub mnuPopup_Click()

Select Case Me.Visible

Case True

mnuPopupHide.Enabled = True

mnuPopupShow.Enabled = False

Case False

mnuPopupHide.Enabled = False

mnuPopupShow.Enabled = True

End Select

End Sub

Private Sub mnuPopupExit_Click()

Call btnExit_Click

End Sub

Private Sub mnuPopupHide_Click()

Me.Hide

End Sub

Private Sub mnuPopupShow_Click()

Me.Show

End Sub

Private Sub mnuPopupTurnOFF_Click()

Call btnTurnOFF_Click

End Sub

Private Sub mnuPopupTurnON_Click()

Call btnTurnON_Click

End Sub

Private Sub tmrShutdown_Timer()

Dim lngFlags As Long

If FormatDateTime(strShutdown, vbLongTime) = FormatDateTime(Time, vbLongTime) Then

Select Case lstOptions.ListIndex

Case 0 'Shutdown OS

lngFlags = EWX_SHUTDOWN

Case 1 'Turn off System

lngFlags = EWX_POWEROFF

Case 2 'Restart

lngFlags = EWX_REBOOT

Case 3 'Logoff

lngFlags = EWX_LOGOFF

End Select

Select Case lstExtra.ListIndex

Case 0 'Use force

lngFlags = lngFlags Or EWX_FORCE

Case 1 'Force only if freezes

lngFlags = lngFlags Or EWX_FORCEIFHUNG

End Select

If IsWinNT = True Then Call EnableNTShutdown

Call ExitWindowsEx(lngFlags, 0)

Call btnTurnOFF_Click

End If

End Sub

Module Source Code

Option Explicit

Public Const ANYSIZE_ARRAY As Long = 1

Public Const EWX_FORCE As Long = 4

Public Const EWX_FORCEIFHUNG As Long = &H10

Public Const EWX_LOGOFF As Long = 0

Public Const EWX_POWEROFF As Long = &H8

Public Const EWX_REBOOT As Long = 2

Public Const EWX_SHUTDOWN As Long = 1

Public Const MAX_COMPUTERNAME As Long = 15

Public Const SE_PRIVILEGE_ENABLED As Long = &H2

Public Const TOKEN_ADJUST_DEFAULT As Long = &H80

Public Const TOKEN_ADJUST_GROUPS As Long = &H40

Public Const TOKEN_ADJUST_PRIVILEGES As Long = &H20

Public Const TOKEN_ADJUST_SESSIONID As Long = &H100

Public Const TOKEN_QUERY As Long = &H8

Public Const VER_PLATFORM_WIN32_NT As Long = 2

Public Const NIF_ICON = &H2

Public Const NIF_MESSAGE = &H1

Public Const NIF_TIP = &H4

Public Const NIM_ADD = &H0

Public Const NIM_DELETE = &H2

Public Const NIM_MODIFY = &H1

Public Const WM_LBUTTONDBLCLK As Long = &H203

Public Const WM_MOUSEMOVE As Long = &H200

Public Const WM_RBUTTONDOWN As Long = &H204

Public Const HWND_TOPMOST As Long = -1

Public Const SWP_NOMOVE As Long = &H2

Public Const SWP_NOSIZE As Long = &H1

Public Type LARGE_INTEGER

LowPart As Long

HighPart As Long

End Type

Public Type LUID

LowPart As Long

HighPart As Long

End Type

Public Type LUID_AND_ATTRIBUTES

pLuid As LUID

Attributes As Long

End Type

Public Type OSVERSIONINFO

dwOSVersionInfoSize As Long

dwMajorVersion As Long

dwMinorVersion As Long

dwBuildNumber As Long

dwPlatformId As Long

szCSDVersion As String * 128 ' Maintenance string for PSS usage

End Type

Public Type TOKEN_PRIVILEGES

PrivilegeCount As Long

Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES

End Type

Public Type NOTIFYICONDATA

cbSize As Long

hwnd As Long

uID As Long

uFlags As Long

uCallbackMessage As Long

hIcon As Long

szTip As String * 64

End Type

'ADVAPI32

Public Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" ( _

ByVal lpSystemName As String, _

ByVal lpName As String, _

ByRef lpLuid As LUID) As Long 'change lpLuid from LARGE_INTEGER to LUID

Public Declare Function AdjustTokenPrivileges Lib "advapi32.dll" ( _

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

Public Declare Function OpenProcessToken Lib "advapi32.dll" ( _

ByVal ProcessHandle As Long, _

ByVal DesiredAccess As Long, _

ByRef TokenHandle As Long) As Long

'COMCTL32

Public Declare Sub InitCommonControls Lib "comctl32.dll" ()

'KERNEL32

Public Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" ( _

ByRef lpVersionInformation As OSVERSIONINFO) As Long

Public Declare Function GetComputerName Lib "kernel32.dll" Alias "GetComputerNameA" ( _

ByVal lpBuffer As String, _

ByRef nSize As Long) As Long

Public Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long

'USER32

Public Declare Function ExitWindowsEx Lib "user32.dll" ( _

ByVal uFlags As Long, _

ByVal dwReserved As Long) As Long

Public Declare Function GetPrivateProfileString Lib "kernel32.dll" Alias "GetPrivateProfileStringA" ( _

ByVal lpApplicationName As String, _

ByVal lpKeyName As String, _

ByVal lpDefault As String, _

ByVal lpReturnedString As String, _

ByVal nSize As Long, _

ByVal lpFileName As String) As Long

Public Declare Function SetWindowPos Lib "user32.dll" ( _

ByVal hwnd As Long, _

ByVal hWndInsertAfter As Long, _

ByVal x As Long, _

ByVal y As Long, _

ByVal cx As Long, _

ByVal cy As Long, _

ByVal wFlags As Long) As Long

Public Declare Function WritePrivateProfileString Lib "kernel32.dll" Alias "WritePrivateProfileStringA" ( _

ByVal lpApplicationName As String, _

ByVal lpKeyName As Any, _

ByVal lpString As Any, _

ByVal lpFileName As String) As Long

Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

Public OSVerInfo As OSVERSIONINFO

Public nid_Tray As NOTIFYICONDATA

Public frmCancelUnload As Boolean

Public strIniPath As String

Public strShutdown As String

Public Sub Main()

Dim strBuffLeft As String

Dim strBuffTop As String

Dim lngFlags As Long

Dim blnTrig As Boolean

If App.PrevInstance = True Then End

Call InitCommonControls

If Command <> "" Then

If InStr(1, Command, "shutdown") <> 0 Then

lngFlags = EWX_SHUTDOWN

blnTrig = True

ElseIf InStr(1, Command, "poweroff") <> 0 Then

lngFlags = EWX_POWEROFF

blnTrig = True

ElseIf InStr(1, Command, "reboot") <> 0 Then

lngFlags = EWX_REBOOT

blnTrig = True

ElseIf InStr(1, Command, "logoff") <> 0 Then

lngFlags = EWX_LOGOFF

blnTrig = True

End If

If InStr(1, Command, "force") <> 0 Then

lngFlags = lngFlags Or EWX_FORCE

ElseIf InStr(1, Command, "forceifhung") <> 0 Then

lngFlags = lngFlags Or EWX_FORCEIFHUNG

End If

If blnTrig = True Then

If IsWinNT = True Then Call EnableNTShutdown

Call ExitWindowsEx(lngFlags, 0)

End

End If

End If

Load frmMain

With nid_Tray

.cbSize = Len(nid_Tray)

.hIcon = frmMain.Icon

.hwnd = frmMain.hwnd

.szTip = frmMain.Caption & vbNullChar

.uCallbackMessage = WM_MOUSEMOVE

.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP

.uID = vbNull

End With

Call Shell_NotifyIcon(NIM_ADD, nid_Tray)

frmCancelUnload = True 'cancel unload by default

strBuffLeft = String(255, vbNullChar)

strBuffTop = String(255, vbNullChar)

strIniPath = App.Path & "\" & App.Title & ".ini"

Call GetPrivateProfileString("Position", "Left", 0, strBuffLeft, 255, strIniPath)

Call GetPrivateProfileString("Position", "Top", 0, strBuffTop, 255, strIniPath)

frmMain.Left = strBuffLeft

frmMain.Top = strBuffTop

Call SetWindowPos(frmMain.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

frmMain.Show

End Sub

Public Sub WriteINI(strSection As String, strKey As String, strValue As String, strPath As String)

Call WritePrivateProfileString(strSection, strKey, strValue, strPath)

End Sub

Public Sub SavePos(frmSave As Form, strPath As String)

If frmSave.WindowState = vbNormal Then

Call WriteINI("Position", "Left", frmSave.Left, strPath)

Call WriteINI("Position", "Top", frmSave.Top, strPath)

End If

End Sub

Public Function IsWinNT() As Boolean

OSVerInfo.dwOSVersionInfoSize = Len(OSVerInfo)

Call GetVersionEx(OSVerInfo)

If OSVerInfo.dwPlatformId = VER_PLATFORM_WIN32_NT Then IsWinNT = True

End Function

Public Sub EnableNTShutdown()

Dim TknPriv_Old As TOKEN_PRIVILEGES

Dim TknPriv_New As TOKEN_PRIVILEGES

Dim LUID_NTShutdown As LUID

Dim CurProc As Long

Dim TknHnd As Long

CurProc = GetCurrentProcess

Call OpenProcessToken(CurProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, TknHnd)

Call LookupPrivilegeValue(CompName, "SeShutdownPrivilege", LUID_NTShutdown)

TknPriv_Old.PrivilegeCount = 1

TknPriv_Old.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED

TknPriv_Old.Privileges(0).pLuid = LUID_NTShutdown

Call AdjustTokenPrivileges(TknHnd, False, TknPriv_Old, 4 + (12 * TknPriv_Old.PrivilegeCount), TknPriv_New, 4 + (12 * TknPriv_New.PrivilegeCount))

End Sub

Public Function CompName() As String

Dim lngInStr As Long

CompName = String(MAX_COMPUTERNAME, vbNullChar)

Call GetComputerName(CompName, MAX_COMPUTERNAME + 1)

lngInStr = InStr(1, CompName, vbNullChar) 'error protection

If lngInStr <> 0 Then CompName = Mid(CompName, 1, lngInStr - 1)

End Function