Newsgroup: it.comp.lang.visual-basic
Titolo: [Forse OT] Spegnimento computer

Salve a tutti.
Tempo fa avevo fatto un timer per lo spegnimento del pc, sotto girava
win98. Il comando che usavo era il seguente:
Shell("RUNDLL32.EXE user,ExitWindows", vbNormalFocus)
Ora sto usando windows 2000 e, ovviamente, non funziona. Qualcuno sa
come eseguire lo shutdowd o, meglio ancora, la sospensione?
Grazie
Gil

 e Piero si incontrarono nella radura di
Sherwood (it.comp.lang.visual-basic), dicendo:
Ho trovato nel sito comune alcuni sorgenti che dovrebbero fare cio che
voglio, ma *nessuno* funziona... non fanno assolutamente nulla, forse
per la versione di win che uso. Facendo una ricerca su google ho
trovato un programma che sembra funzionare, l'unico problema è che, a
seguito shutdown, il pc non si spegne ma appare la scritta Ora si può
spegnere il computer (cosa che normalmente non accade).
Vi posto il sorgente, nella speranza che qualcuno possa capire dove
andare a mettere le mani
      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
      Private Const EWX_SHUTDOWN As Long = 1
      Private Const EWX_FORCE As Long = 4
      Private Const EWX_REBOOT = 2
      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
Add a procedure called AdjustToken with the following code:
      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
Add a CommandButton to the form. In the Click event, add the following
code:
      Private Sub Command1_Click()
         AdjustToken
         ExitWindowsEx (EWX_SHUTDOWN Or EWX_FORCE Or EWX_REBOOT),
&HFFFF
      End Sub
Save the project and build an executable. When you run the executable
and click the CommandButton the computer will reboot as expected.

 fare cio che voglio, ma *nessuno* funziona...
Non ricordo chi posto' il codice seguente qualche mese fa.
Il suo commento fu: "questo chiude pure le finestre di casa"
:).
Io l'ho riadattato inserendo il tutto in una classe
(SystemShutdownHandler.cls).
Testato e funzionante su WinXP Pro, Me e 98, ma credo
funzioni dappertutto.
Per usarlo:
------------------------------------------------------------
----------- Codice Per il Logoff/Shutdown/Reboot -----------
------------------------------------------------------------
Dim SSH As SystemShutDownHandler
Set SSH = New SystemShutDownHandler
SSH._scegli_il_metodo_che_piu'_ti_aggrada
Set SSH = Nothing
Unload Me 'Se in un form
------------------------------------------------------------
------------------------------------------------------------
------ Codice della classe SystemShutdownHandler.cls  ------
------------------------------------------------------------
Option Explicit
Private mWin32Version As String
Private Const EWX_LOGOFF As Long = 0
Private Const EWX_SHUTDOWN As Long = 1
Private Const EWX_REBOOT As Long = 2
Private Const EWX_FORCE As Long = 4
Private Const EWX_POWEROFF As Long = 8
'ExitWindowsEx
'esegue disconnessione (log off), spegnimento (shutdown)
'o riavvio (reboot).
Private Declare Function ExitWindowsEx Lib "user32" _
                         (ByVal dwOptions As Long, _
                          ByVal dwReserved As Long) As Long
'GetLastError restituisce l'ultimo codice di errore
'del thread chiamante. L'ultimo codice di errore e'
'mantenuto per thread: thread multipli non
'sovrascrivono a vicenda il codice di errore.
Private Declare Function GetLastError Lib "kernel32" _
                         () As Long
'SetLastError imposta l'ultimo codice di errore del
'thread chiamante.
Private Declare Sub SetLastError Lib "kernel32" _
                        (ByVal dwErrCode As Long)
Private Const mWin9X_ME As String = "Windows 9x/ME"
Private Const mWinNT_2000_XP As String = "Windows
NT/2000/XP"
'GetVersion restituisce il sistema operativo in uso
Private Declare Function GetVersion Lib "kernel32" _
                         () As Long
Private Type LUID
    UsedPart As Long
    IgnoredForNowHigh32BitPart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
    TheLuid As LUID
    Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    TheLuid As LUID
    Attributes As Long
End Type
'GetCurrentProcess restituisce uno pseudohandle per il
'processo corrente
Private Declare Function GetCurrentProcess Lib "kernel32" _
                         () As Long
'OpenProcessToken apre un token di accesso associato ad un
'processo
Private Declare Function OpenProcessToken Lib "advapi32" _
                         (ByVal processHandle As Long, _
                          ByVal DesiredAccess As Long, _
                          tokenHandle As Long) As Long
'LookupPrivilegeValue recupera l'identificatore unico locale
'(LUID : locally Unique identifier) utilizzato su un sistema
'specificato per rappresentare localmente il nome del
'privilegio specificato
Private Declare Function LookupPrivilegeValue Lib "advapi32"
_
                         Alias "LookupPrivilegeValueA" _
                         (ByVal lpSystemName As String, _
                          ByVal lpName As String, _
                          lpLuid As LUID) As Long
'AdjustTokenPrivileges abilita o disabilita i privilegi nel
'token di accesso specificato. Abilitando o disabilitando i
'privilegi in un token di accesso, necessita l'accesso
'TOKEN_ADJUST_PRIVILEGES
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
Private Function AdjustToken() As Long
    'Questa procedura imposta i privilegi corretti per
    'permettere una disconnessione o uno spegnimento
    'sotto Windows NT/2000
    Const TOKEN_ADJUST_PRIVILEGES = &H20
    Const TOKEN_QUERY = &H8
    Const SE_PRIVILEGE_ENABLED = &H2
    Dim processHandle As Long
    Dim tokenHandle As Long
    Dim tmpLUID As LUID
    Dim tkp As TOKEN_PRIVILEGES
    Dim tkpNewButIgnored As TOKEN_PRIVILEGES
    Dim buffer As Long
    'Imposta il codice di errore dell'ultimo thread a zero,
    'in modo che la GetLastError non restituisca un valore
    'diverso da zero senza motivo apparente
    SetLastError 0
    'Imposta la variabile processHandle
    processHandle = GetCurrentProcess()
    If GetLastError <> 0 Then
        AdjustToken = GetLastError
        Exit Function
    End If
    OpenProcessToken processHandle, _
                     (TOKEN_ADJUST_PRIVILEGES Or
TOKEN_QUERY), _
                     tokenHandle
    If GetLastError <> 0 Then
        AdjustToken = GetLastError
        Exit Function
    End If
    'Recupera il LUID per il privilegio di spegnimento
    LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLUID
    If GetLastError <> 0 Then
        AdjustToken = GetLastError
        Exit Function
    End If
    tkp.PrivilegeCount = 1 ' One privilege to set
    tkp.TheLuid = tmpLUID
    tkp.Attributes = SE_PRIVILEGE_ENABLED
    'Abilita il privilegio di spegnimento nel
    'token di accesso di questa procedura
    AdjustTokenPrivileges tokenHandle, _
                          False, _
                          tkp, _
                          Len(tkpNewButIgnored), _
                          tkpNewButIgnored, _
                          buffer
    AdjustToken = GetLastError
End Function
Public Function LogOff() As Long
    ExitWindowsEx (EWX_LOGOFF), &HFFFF
    LogOff = GetLastError
End Function
Public Function ForceLogOff() As Long
    ExitWindowsEx (EWX_LOGOFF Or EWX_FORCE), &HFFFF
    ForceLogOff = GetLastError
End Function
Public Function ShutDown() As Long
    Dim e As Long
    If mWin32Version = mWinNT_2000_XP Then
        AdjustToken
        e = GetLastError
        If e <> 0 Then
            ShutDown = e
            Exit Function
        End If
    End If
    ExitWindowsEx (EWX_SHUTDOWN), &HFFFF
    ShutDown = GetLastError
End Function
Public Function ForceShutDown() As Long
    Dim e As Long
    If mWin32Version = mWinNT_2000_XP Then
        AdjustToken
        e = GetLastError
        If e <> 0 Then
            ForceShutDown = e
            Exit Function
        End If
    End If
    ExitWindowsEx (EWX_SHUTDOWN Or EWX_FORCE), &HFFFF
    ForceShutDown = GetLastError
End Function
Public Function Reboot() As Long
    Dim e As Long
    If mWin32Version = mWinNT_2000_XP Then
        AdjustToken
        e = GetLastError
        If e <> 0 Then
            Reboot = e
            Exit Function
        End If
    End If
    ExitWindowsEx (EWX_REBOOT), &HFFFF
    Reboot = GetLastError
End Function
Public Function ForceReboot() As Long
    Dim e As Long
    If mWin32Version = mWinNT_2000_XP Then
        AdjustToken
        e = GetLastError
        If e <> 0 Then
            ForceReboot = e
            Exit Function
        End If
    End If
    ExitWindowsEx (EWX_REBOOT Or EWX_FORCE), &HFFFF
    ForceReboot = GetLastError
End Function
Public Function PowerOff() As Long
    Dim e As Long
    If mWin32Version = mWinNT_2000_XP Then
        AdjustToken
        e = GetLastError
        If e <> 0 Then
            PowerOff = e
            Exit Function
        End If
    End If
    ExitWindowsEx (EWX_POWEROFF), &HFFFF
    PowerOff = GetLastError
End Function
Public Function ForcePowerOff() As Long
    Dim e As Long
    If mWin32Version = mWinNT_2000_XP Then
        AdjustToken
        e = GetLastError
        If e <> 0 Then
            ForcePowerOff = e
            Exit Function
        End If
    End If
    ExitWindowsEx (EWX_POWEROFF Or EWX_FORCE), &HFFFF
    ForcePowerOff = GetLastError
End Function
Public Property Get Win32Version() As String
    Win32Version = mWin32Version
End Property
Private Sub Class_Initialize()
    Dim tmpVer As Long
    tmpVer = GetVersion()
    If ((tmpVer And &H80000000) = 0) Then
        mWin32Version = mWinNT_2000_XP
    Else
        mWin32Version = mWin9X_ME
    End If
End Sub
------------------------------------------------------------
Approposito. Il quesito non e' OT :)
hth,
Lokar
--
Sito Comune: 
http://www.it-lang-vb.net/
Manifesto: 
http://www.it-lang-vb.net/docs/Manifesto.txt
Statuto: 
http://www.it-lang-vb.net/docs/Statuto.txt
UGIdotNET - 
http://www.ugidotnet.org