Apagar / Reiniciar Windows NT

Debes colocar el siguiente código en un modulo .BAS

Option Explicit
' Shutdown Flags
Public Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Public fMainForm As frmMain
Public Const ANYSIZE_ARRAY = 1
Public Const SE_PRIVILEGE_ENABLED = &H2
Public Const TokenPrivileges = 3
Public Const TOKEN_ASSIGN_PRIMARY = &H1
Public Const TOKEN_DUPLICATE = &H2
Public Const TOKEN_IMPERSONATE = &H4
Public Const TOKEN_QUERY = &H8
Public Const TOKEN_QUERY_SOURCE = &H10
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_ADJUST_GROUPS = &H40
Public Const TOKEN_ADJUST_DEFAULT = &H80
Public Const SE_SHUTDOWN_NAME = "SeShutdownPrivilege"

Type LARGE_INTEGER
      lowpart As Long
      highpart As Long
End Type

Type Luid
     lowpart As Long
     highpart As Long
End Type

Type LUID_AND_ATTRIBUTES
      'pLuid As Luid
       pLuid As LARGE_INTEGER
       Attributes As Long
End Type

Type TOKEN_PRIVILEGES
       PrivilegeCount As Long
       Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

'Declaración para usar ventanas siempre visibles

'Versión para 32 bits
Declare Function SetWindowPos Lib "User32" (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

Declare Function ExitWindowsEx Lib "User32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Declare Function InitiateSystemShutdown Lib "advapi32.dll" Alias "InitiateSystemShutdownA" (ByVal _
         lpMachineName As String, ByVal lpMessage As String, ByVal dwTimeout As Long, _
         ByVal bForceAppsClosed As Long, ByVal bRebootAfterShutdown As Long) As Long
Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _
         TokenHandle As Long) As Long
Declare Function GetCurrentProcess Lib "kernel32" () As Long
Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, _
         ByVal lpName As String, lpLuid As LARGE_INTEGER) As Long
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 Long
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, _
         nSize As Long) As Long
Declare Function GetLastError Lib "kernel32" () As Long
Public Function InitiateShutdownMachine(ByVal Machine As String, Optional Force As Variant, _
         Optional Restart As Variant, Optional AllowLocalShutdown As Variant, Optional Delay As Variant, _
         Optional Message As Variant) As Boolean
    Dim hProc As Long
    Dim OldTokenStuff As TOKEN_PRIVILEGES
    Dim OldTokenStuffLen As Long
    Dim NewTokenStuff As TOKEN_PRIVILEGES
    Dim NewTokenStuffLen As Long
    Dim pSize As Long

    If IsMissing(Force) Then Force = False
    If IsMissing(Restart) Then Restart = True
    If IsMissing(AllowLocalShutdown) Then AllowLocalShutdown = False
    If IsMissing(Delay) Then Delay = 0
    If IsMissing(Message) Then Message = ""

    If InStr(Machine, "") = 1 Then
        Machine = Right(Machine, Len(Machine) - 2)
    End If

    If (LCase(GetMyMachineName) = LCase(Machine)) Then

        If AllowLocalShutdown = False Then Exit Function

        If 0 = OpenProcessToken(GetCurrentProcess(), _
                TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hProc) Then
            'MsgBox "OpenProcessToken Error: " & GetLastError()
            Exit Function
        End If
        If 0 = LookupPrivilegeValue(vbNullString, SE_SHUTDOWN_NAME, _
                OldTokenStuff.Privileges(0).pLuid) Then
            'MsgBox "LookupPrivilegeValue Error: " & GetLastError()
            Exit Function
        End If

        NewTokenStuff = OldTokenStuff

        NewTokenStuff.PrivilegeCount = 1
        NewTokenStuff.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED

        NewTokenStuffLen = Len(NewTokenStuff)

        pSize = Len(NewTokenStuff)

        If 0 = AdjustTokenPrivileges(hProc, False, NewTokenStuff, _
                NewTokenStuffLen, OldTokenStuff, OldTokenStuffLen) Then
            'MsgBox "AdjustTokenPrivileges Error: " & GetLastError()
            Exit Function
        End If

        If 0 = InitiateSystemShutdown("" & Machine, Message, Delay, Force, Restart) Then
            Exit Function
        End If

        NewTokenStuff.Privileges(0).Attributes = 0

        If 0 = AdjustTokenPrivileges(hProc, False, NewTokenStuff, _
                Len(NewTokenStuff), OldTokenStuff, Len(OldTokenStuff)) Then
            Exit Function
        End If

    Else

        If 0 = InitiateSystemShutdown("" & Machine, Message, Delay, Force, Restart) Then
            Exit Function
        End If

    End If
    InitiateShutdownMachine = True
End Function

Function GetMyMachineName() As String
    Dim StringSize As Long
    Dim TheString As String
    
    TheString = Space(100)
    StringSize = 100
    
    If GetComputerName(TheString, StringSize) Then
        GetMyMachineName = Left(TheString, StringSize)
    End If
End Function

Para apagar la máquina coloca un botón, en tu formulario y el siguiente código:

Private Sub Command1_Click()
    Dim Flag As Boolean
    Name1 = GetMyMachineName
    Flag = InitiateShutdownMachine(Name1, True, False, True, 0, "")
    If Flag = False Then Flag = ExitWindowsEx(5, Res)
End Sub

Publicado en microsoft.public.es.vb por Alejandro Maldonado

Anuncios

Responder

Introduce tus datos o haz clic en un icono para iniciar sesión:

Logo de WordPress.com

Estás comentando usando tu cuenta de WordPress.com. Cerrar sesión /  Cambiar )

Google photo

Estás comentando usando tu cuenta de Google. Cerrar sesión /  Cambiar )

Imagen de Twitter

Estás comentando usando tu cuenta de Twitter. Cerrar sesión /  Cambiar )

Foto de Facebook

Estás comentando usando tu cuenta de Facebook. Cerrar sesión /  Cambiar )

Conectando a %s