hier eine Version ...
26.04.2010 08:46:56
Tino
Hallo,
die ich mal im über Google gefunden habe.
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
Private Declare Function AdjustTokenPrivileges Lib "advapi32" ( _
ByVal TokenHandle As Long, _
ByVal DisableAllPrivileges As Long, _
ByRef NewState As TOKEN_PRIVILEGES, _
ByVal BufferLength As Long, _
ByRef PreviousState As Any, _
ByRef ReturnLength As Any _
) As Long
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 GetVersion Lib "kernel32" () As Long
Private Declare Function LookupPrivilegeValueA Lib "advapi32" ( _
ByVal lpSystemName As String, _
ByVal lpName As String, _
ByRef lpLuid As LUID _
) As Long
Private Declare Function OpenProcessToken Lib "advapi32" ( _
ByVal ProcessHandle As Long, _
ByVal DesiredAccess As Long, _
ByRef TokenHandle As Long _
) As Long
Public Sub ShutDown(Optional ByVal Reboot As Variant = 1, _
Optional ByVal Force As Boolean = False)
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1 'Neustart
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Const EWX_POWEROFF = 8
Const SE_PRIVILEGE_ENABLED = &H2
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Dim Flags As Long
Dim Token As Long
Dim TP As TOKEN_PRIVILEGES
'WinNT/2000 benötigt spezielle Rechte:
If GetVersion() >= 0 Then
OpenProcessToken _
GetCurrentProcess(), _
TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, Token
LookupPrivilegeValueA _
"", "SeShutdownPrivilege", TP.LuidUDT
TP.PrivilegeCount = 1
TP.Attributes = SE_PRIVILEGE_ENABLED
AdjustTokenPrivileges _
Token, False, TP, 0, ByVal 0&, ByVal 0&
End If
'Shutdown durchführen:
Flags = EWX_POWEROFF
If Reboot = 2 Then
Flags = Flags Or EWX_REBOOT
ElseIf Reboot = 0 Then
Flags = EWX_LOGOFF
ElseIf Reboot = 8 Then
Flags = EWX_POWEROFF
ElseIf Reboot = &H2 Then
Flags = SE_PRIVILEGE_ENABLED
ElseIf Reboot = &H8 Then
Flags = TOKEN_QUERY
Else
Flags = EWX_FORCE
End If
' If Force Then Flags = Flags Or EWX_FORCE
ExitWindowsEx Flags, &HFFFF
End Sub
Sub test()
'0 = Abmelden
'2 = Neustart
'8 = Ausschalten
'&H2 = Ausschalten ohne aus?
'&H8 = Ausschalten
ShutDown 2, False
SaveChanges = True
Application.Quit
End Sub
Gruß Tino