Autor
Fuerzo un apagado del pc, pero este se queda en.
Código:
Ahora puede apagar su ordenador con seguridad
Como puedo evitar que se quede ahi y fuerze el apagado total.
Me pasa con varios programas, hay va una muestra.
Código:
Option Explicit
Private Type LUID
LowPart As Long
HighPart As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
LuidUDT As LUID
Attributes As Long
End Type
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Private Declare Function GetVersion Lib "kernel32" () 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 Any, ReturnLength As Any) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, _
ByVal dwReserved As Long) As Long
Sub ShutDownWindows()
Dim hToken As Long
Dim tp As TOKEN_PRIVILEGES
Dim flags As Long
Dim reboot, force As Boolean
reboot = False
force = True
If GetVersion() >= 0 Then
' Open this process for adjusting its privileges
OpenProcessToken GetCurrentProcess(), (TOKEN_ADJUST_PRIVILEGES Or _
TOKEN_QUERY), hToken
LookupPrivilegeValue "", "SeShutdownPrivilege", tp.LuidUDT
tp.PrivilegeCount = 1
tp.Attributes = SE_PRIVILEGE_ENABLED
AdjustTokenPrivileges hToken, False, tp, 0, ByVal 0&, ByVal 0&
End If
flags = EWX_SHUTDOWN
If reboot Then flags = flags Or EWX_REBOOT
If force Then flags = flags Or EWX_FORCE
ExitWindowsEx flags, &HFFFF
End Sub
Private Sub Command1_Click()
ShutDownWindows
End Sub
Private Type LUID
LowPart As Long
HighPart As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
LuidUDT As LUID
Attributes As Long
End Type
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Private Declare Function GetVersion Lib "kernel32" () 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 Any, ReturnLength As Any) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, _
ByVal dwReserved As Long) As Long
Sub ShutDownWindows()
Dim hToken As Long
Dim tp As TOKEN_PRIVILEGES
Dim flags As Long
Dim reboot, force As Boolean
reboot = False
force = True
If GetVersion() >= 0 Then
' Open this process for adjusting its privileges
OpenProcessToken GetCurrentProcess(), (TOKEN_ADJUST_PRIVILEGES Or _
TOKEN_QUERY), hToken
LookupPrivilegeValue "", "SeShutdownPrivilege", tp.LuidUDT
tp.PrivilegeCount = 1
tp.Attributes = SE_PRIVILEGE_ENABLED
AdjustTokenPrivileges hToken, False, tp, 0, ByVal 0&, ByVal 0&
End If
flags = EWX_SHUTDOWN
If reboot Then flags = flags Or EWX_REBOOT
If force Then flags = flags Or EWX_FORCE
ExitWindowsEx flags, &HFFFF
End Sub
Private Sub Command1_Click()
ShutDownWindows
End Sub
y ahi otra:
Código:
Option Explicit
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const STILL_ACTIVE = &H103
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess&, ByVal bInheritHandle&, ByVal dwProcessId&) _
As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) _
As Long
Sub EsperarShell(sCmd As String)
Dim hShell As Long
Dim hProc As Long
Dim codExit As Long
' ejecutar comando
hShell = Shell(Environ$("Comspec") & " /c " & sCmd, 2)
' esperar a que se complete el proceso
hProc = OpenProcess(PROCESS_QUERY_INFORMATION, False, hShell)
Do
GetExitCodeProcess hProc, codExit
DoEvents
Loop While codExit = STILL_ACTIVE
End Sub
Private Sub Command1_Click()
Dim a
a "shutdown -s -f -t 60 -m \\wireless -c"
EsperarShell (a)
End Sub
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const STILL_ACTIVE = &H103
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess&, ByVal bInheritHandle&, ByVal dwProcessId&) _
As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) _
As Long
Sub EsperarShell(sCmd As String)
Dim hShell As Long
Dim hProc As Long
Dim codExit As Long
' ejecutar comando
hShell = Shell(Environ$("Comspec") & " /c " & sCmd, 2)
' esperar a que se complete el proceso
hProc = OpenProcess(PROCESS_QUERY_INFORMATION, False, hShell)
Do
GetExitCodeProcess hProc, codExit
DoEvents
Loop While codExit = STILL_ACTIVE
End Sub
Private Sub Command1_Click()
Dim a
a "shutdown -s -f -t 60 -m \\wireless -c"
EsperarShell (a)
End Sub
En línea
