Option expedition
Private Declare Function SetSystemPowerState Lib "kernel32" (ByVal fSuspend As Long, ByVal fForce As Long) _ As LongPrivate Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As LongPrivate Declare Function GetCurrentProcess Lib "kernel32" ( ) As LongPrivate Declare Function GetCurrentProcessId Lib "kernel32" () As LongPrivate Declare Function LookupPrivilegevalue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" _ (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As LongPrivate Declare Function AdjustTokenPrivileges Lib " advapi32.dll "(ByVal TokenHandle As Long, _ ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As LongPrivate Declare Function OpenProcessToken Lib" advapi32.dll "(ByVal ProcessHandle As Long, _BYVAL DESIREDACCESS AS Long, Tokenhandle As Long) As longprivate declare function getversionEx lib "kern EL32 "Alias" getversion _ as osversioninfo) as long private enum howexitconst ewx_logoff = 0 EWX_SHUTDOWN = 1 EWX_REBOOT = 2 EWX_FORCE = 4 EMX_Poweroff = 8END ENUM
Private Type OsversionInfo DWOSVERSIONFOSIZE As Long DWMAJORVERSION As Long DwminorVersion As Long DwbuildNumber As Long DwplatformID As Long Szcsdversion AS String * 128 OsName As Integered Type
Private Const TOKEN_ADJUST_PRIVILEGES = & H20Private Const TOKEN_QUERY = & H8Private Const SE_PRIVILEGE_ENABLED = & H2Private Const ANYSIZE_ARRAY = 1Private Type LUID LowPart As Long HighPart As LongEnd TypePrivate Type LUID_AND_ATTRIBUTES pLuid As LUID Attributes As LongEnd Type
Private type token_privileges privilegegount as long privileges (anysize_array) as Luid_and_attributesend TYPE
Private sub adjustToken () 'Get system permissions
ON Error ResMe next
Dim hdlProcessHandle As Long Dim hdlTokenHandle As Long Dim tmpLuid As LUID Dim tkp As TOKEN_PRIVILEGES Dim tkpNewbutIgnored As TOKEN_PRIVILEGES Dim lBufferNeeded As Long hdlProcessHandle = GetCurrentProcess () OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle LookupPrivilegevalue "", "SeShutdownPrivilege", tmpLuid tkp. PrivilegeCount = 1 tkp.Privileges (0) .pLuid = tmpLuid tkp.Privileges (0) .Attributes = SE_PRIVILEGE_ENABLED AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len (tkpNewbutIgnored), tkpNewbutIgnored, lBufferNeeded
End Sub
Private sub halt () 'Shutdown Dim method as howexitconst method = ewx_shutdown ewx_force emx_poweroff call adjusttoken call exitwindowsex (Method, 0) End Sub
Private sub logon () Logout Dim Method as howexitconst method = ewx_logoff call adjustToken Call ExitWindowsex (Method, 0) End Sub
Private sub restart () Restart Dim method as howexitconst method = EWX_REBOOT CALL AdjustToken Call EXITWINDOWSEX (METHOD, 0) End Sub
'Get the version of the Windows operating system' OsName in the OsversionInfo structure Return to the operating system Name Private function getWindowsVersion () AS OSVERSIONFODIM VER AS OSVERSIONINFO
Ver.dwosversionInfosize = 148 getVersionex Ver
With Ver Select Case .dwplatformID Case 1 Select Case .dwminorversion Case 0 .osName = 1 '"Windows 95" Case 10 .osName = 2' "Windows 98" Case 90 .osName = 3 '"Windows Mellinnium" End Select Case 2 Select Case .dwmajorversion Case 3 .osname = 4 '"Windows NT 3.51" Case 4 .osName = 5' "Windows NT 4.0" Case 5 if .dwminorversion = 0 Then .osName = 6 '"Windows 2000" Else .osName = 7' "Windows XP" end if End SELECT End Select End With
GetWindowsVersion = VER
END FUNCTION
Public SUB PULL_THE_PLUG () 'Logout
DIM I as OsversionInfo
I = getWindowsVersion ()
SELECT CASE I.OSNAME CASE 1 To 3 'Call Exitwindowsex (EWX_LOGOFF, 0) Case 4 TO 7 CALL LOGON End SELECT End Sub
Public Sub log_off_current_user () 'Shutdown
DIM I as OsversionInfo
I = getWindowsVersion ()
Select Case I.OSName Case 1 To 3 'Call ExitWindowsex (EWX_SHUTDOWN EWX_FORCE EMX_POWEROFF, 0) Case 4 TO 7 Call Halt End SelectensEnd Sub
Public Sub Reboot_computer () 'Restart
DIM I as OsversionInfo
I = getWindowsVersion ()
Select Case I.OSName Case 1 To 3 'Call ExitwindowsEx (EWX_REBOOT, 0) Case 4 To 7 Call Restart End Select
End Sub
