komponen yang dibutuhkan adalah :
3 Command Buttons
4 Combo Boxes
1 Form
6 Labels
2 List Boxes
8 Menus
1 Timer
1 Module
jika kamu tidak ingin repot dengan membuat sendiri kamu juga bisa download source codenya yang sudah jadi dan langsung jalan
disini
Berikut source code lengkapnya
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
Source Code untuk module nya
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
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
No comments:
Post a Comment