' </> ----------------------------------------------------------------- </>
' </> ---&--- </> </> ---&--- </>
' </> ---&--- </> FRONT para Windows - Shutdown </> ---&--- </>
' </> ---&--- </> </> ---&--- </>
' </> ----------------------------------------------------------------- </>
Option Explicit
' </> ---&--- </> Shutdown
Public Shut_Botar As Byte, _
Shut_Tipo As Byte, _
Shut_Hora As String
Public Const EXC_SHUTDOWN = 1
Public Const EXC_LOGOFF = 0
Public Const EXC_REBOOT = 2
Public Const EXC_FORCE = 4
'---------------------------------------------------------------------------
' API declarations to obtain the Windows version and the type of
' keyboard.
'---------------------------------------------------------------------------
Private Declare Function apiGetVersion _
Lib "kernel32" _
Alias "GetVersionExA" (ByRef lpVersionInformation _
As OSVERSIONINFO) As Long
' size of 'Type' = (5 x 4 bytes) = 20 bytes (the 5 Longs)
' 128 bytes (fixed-length string)
' ----- +
' 148 bytes
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long ' Has to be set to size of 'type'= 148
dwMajorVersion As Long ' Gives the Major version
dwMinorVersion As Long ' Gives the Minor version
dwBuildNumber As Long ' Gives the buildnumber (I don't use it)
dwPlatformId As Long ' Gives the operating system.
szCSDVersion As String * 128 ' ?
End Type
'---------------------------------------------------------------------------
' API Declaración para Rebotar Windows 95/98
'---------------------------------------------------------------------------
'Declare Function ExitWindowsEx& Lib "user32" (ByVal uFlags&, _
ByVal dwReserved&)
'---------------------------------------------------------------------------
' API Declaración para Rebotar Windows NT
'---------------------------------------------------------------------------
' Tipos definidos
Private Type LUID
UsedPart As Long
IgnoredForNowHigh32BitPart As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
TheLuid As LUID
Attributes As Long
End Type
' Las funciones del API
Private Declare Function ExitWindowsEx _
Lib "user32" (ByVal dwOptions As Long, _
ByVal dwReserved As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken _
Lib "advapi32" (ByVal ProcessHandle As Long, _
ByVal DesiredAccess As Long, _
TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue _
Lib "advapi32" _
Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, _
ByVal lpName As String, _
lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges _
Lib "advapi32" (ByVal TokenHandle As Long, _
ByVal DisableAllPrivileges As Long, _
NewState As TOKEN_PRIVILEGES, _
ByVal BufferLength As Long, _
PreviousState As TOKEN_PRIVILEGES, _
ReturnLength As Long) As Long
'---------------------------------------------------------------------------
' SUB: WinVer
'
' This sub returns information about the operating system, and about
' the Windows Version.
'
' e.g. Windows 3.11
' The sub will return:
' - intMajor = 3
' - intMinor = 11
' - strPlatform = Windows 3.11
'
' OUT: intMajor - Integer containing the major version of Windows.
' intMinor - Integer containing the minor version of windows.
'
' strPlatfrom returns one of the following :
' Windows 95
' Windows NT
' Windows + Version
'
' If the call fails intMajor = 0, intMinor = 0, and strPlatform = ""
'---------------------------------------------------------------------------
Public Sub WinVer(ByRef intMajor As Integer, _
ByRef intMinor As Integer, _
ByRef strPlatform As String)
Dim OSystem As OSVERSIONINFO
OSystem.dwOSVersionInfoSize = 148
' The size of the structure must be set before the call.
If apiGetVersion(OSystem) Then
' Call the API. It fills the OSystem type.
intMajor = OSystem.dwMajorVersion ' Store the Major version
intMinor = OSystem.dwMinorVersion ' Store the Minor version
Select Case OSystem.dwPlatformId ' Set strPlatform
Case 0: strPlatform = "W" + CStr(intMajor)
Case 1: strPlatform = "W95"
Case 2: strPlatform = "WNT"
End Select
Else
' The call failed, set the values to zero
intMajor = 0
intMinor = 0
strPlatform = ""
End If
End Sub
' Código para poner en el formulario
Private Sub AdjustToken()
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
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
' Get the LUID for shutdown privilege.
LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
tkp.PrivilegeCount = 1 ' One privilege to set
tkp.TheLuid = tmpLuid
tkp.Attributes = SE_PRIVILEGE_ENABLED
' Enable the shutdown privilege in the access token of this
' process.
AdjustTokenPrivileges hdlTokenHandle, False, tkp, _
Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded
End Sub
Public Sub Reboot(Shut_Tipo)
Dim Opc As Long, _
Mayor As Integer, _
Menor As Integer, _
Version As String
WinVer Mayor, Menor, Version
If Version = "WNT" Then AdjustToken
Select Case Shut_Tipo
Case 1: Opc = ExitWindowsEx(EXC_REBOOT Or EXC_FORCE, &HFFFF)
Case 2: Opc = ExitWindowsEx(EXC_SHUTDOWN Or EXC_FORCE, &HFFFF)
Case 3: Opc = ExitWindowsEx(EXC_LOGOFF Or EXC_FORCE, &HFFFF)
End Select
End Sub
