Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0495: Windows herunterfahren II

 von 

Beschreibung 

Dieser Tipp ist eine Alternative zu Tipp 418. Hier können ebenfalls 9x(95,98,Me etc.) und NT(2k,XP etc.) Systeme heruntergefahren werden.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

AdjustTokenPrivileges, ExitWindowsEx, GetCurrentProcess, GetVersionExA (GetVersionEx), InitiateSystemShutdownA (InitiateSystemShutdown), LookupPrivilegeValueA (LookupPrivilegeValue), OpenProcessToken, SetSystemTime

Download:

Download des Beispielprojektes [3,57 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command1"

Option Explicit

Private Sub Command1_Click()
    If SystemDown Then
        Me.Caption = "Fahre herunter..."
    Else
        Me.Caption = "Fehler!"
    End If
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "ExitWin" alias ExitWin.bas ---------
Option Explicit

Private Declare Function SetSystemTime Lib "kernel32" ( _
                         lpSystemTime As SYSTEMTIME) As Long
                         
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" _
                         Alias "LookupPrivilegeValueA" ( _
                         ByVal lpSystemName As String, _
                         ByVal lpName As String, _
                         lpLuid As LARGE_INTEGER) As Long
                         
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

Private 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
                         
Private Declare Function OpenProcessToken Lib "advapi32.dll" ( _
                         ByVal ProcessHandle As Long, _
                         ByVal DesiredAccess As Long, _
                         TokenHandle As Long) As Long
                         
Private Declare Function ExitWindowsEx Lib "user32" ( _
                         ByVal uFlags As Long, _
                         ByVal dwReserved As Long) As Long
                         
Private 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
                         
Private Declare Function GetVersionEx Lib "kernel32" _
                         Alias "GetVersionExA" ( _
                         lpVersionInformation As OSVERSIONINFO) As Long
                         
Public Const ANYSIZE_ARRAY = 1
Public Const TOKEN_ADJUST_PRIVILEGES = 32
Public Const TOKEN_QUERY = 8
Public Const SE_PRIVILEGE_ENABLED As Long = 2
Public Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Public Const SE_SHUTDOWN_NAME = "SeShutdownPrivilege"
Public Const SE_REMOTE_SHUTDOWN_NAME = "SeRemoteShutdownPrivilege"

Private Const SE_SYSTEMTIME_NAME = "SeSystemtimePrivilege"

Public Type LARGE_INTEGER
    lowpart As Long
    highpart As Long
End Type

Public Type LUID_AND_ATTRIBUTES
    pLuid As LARGE_INTEGER
    Attributes As Long
End Type

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

Private Type OSVERSIONINFO ' für den Aufruf des GetVersionEx-API
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Private Function SetTime(Datum As Date) As Boolean

    Dim ret As Long
    Dim hToken As Long
    Dim tkp As TOKEN_PRIVILEGES
    Dim tkpOld As TOKEN_PRIVILEGES
    Dim fOk As Boolean
    Dim Time As SYSTEMTIME
    
    ' Überprüfen, ob Window NT ausgeführt wird.
    If IsWindowsNT() Then
    
        ' Windows NT wird ausgeführt.
        ' Sicherheitsüberprüfungen und
        ' Veränderungen sind jetzt notwendig,
        ' um sicherzustellen, daß das Token
        ' vorhanden ist, das einen Neustart zuläßt.
        If OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, _
            hToken) Then
            
            ret = LookupPrivilegeValue(vbNullString, SE_SYSTEMTIME_NAME, tkp.Privileges( _
                0).pLuid)
                
            tkp.PrivilegeCount = 1
            tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
            fOk = AdjustTokenPrivileges(hToken, 0, tkp, LenB(tkpOld), tkpOld, ret)
        End If
    Else
    
        ' Win95/98 wird ausgeführt. Keine Aktion ist notwendig.
        fOk = True
    End If
    
    If fOk Then
        Time.wSecond = Val(Format(Datum, "ss"))
        
        Time.wMinute = Val(Mid(Format(Datum, "long time"), InStr(Format(Datum, "long " & _
            "time"), ":") + 1))
            
        Time.wHour = Val(Format(Datum, "hh")) - 1
        Time.wDay = Val(Format(Datum, "d"))
        Time.wMonth = Val(Format(Datum, "m"))
        Time.wYear = Val(Format(Datum, "yyyy"))
        SetTime = (SetSystemTime(Time) <> 0)
    End If
End Function

Public Function SystemDown() As Boolean
    Dim ret As Long
    Dim hToken As Long
    Dim tkp As TOKEN_PRIVILEGES
    Dim tkpOld As TOKEN_PRIVILEGES
    Dim fOKRunterfahren As Boolean
    
    Const sSHUTDOWN As String = SE_SHUTDOWN_NAME
    
    ' Überprüfen, ob Windows NT ausgeführt wird.
    If IsWindowsNT() Then
    
        ' Windows NT wird ausgeführt.
        ' Sicherheitsüberprüfungen und
        ' Veränderungen sind jetzt notwendig,
        ' um sicherzustellen, daß das Token
        ' vorhanden ist, das einen Neustart zuläßt.
        If OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, _
            hToken) Then
            
            ret = LookupPrivilegeValue(vbNullString, sSHUTDOWN, tkp.Privileges(0).pLuid)
            tkp.PrivilegeCount = 1
            tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
            
            fOKRunterfahren = AdjustTokenPrivileges(hToken, 0, tkp, LenB(tkpOld), _
                tkpOld, ret)
        End If
    Else
        ' Win95/98 wird ausgeführt. Keine Aktion ist notwendig.
        fOKRunterfahren = True
    End If
    
    If fOKRunterfahren Then
        SystemDown = (ExitWindowsEx(EWX_SHUTDOWN, 0) <> 0)
    End If
End Function

' -----------------------------------------------------------
' FUNKTION: IsWindowsNT
'
' Liefert "True", falls dieses Programm unter
' Windows NT ausgeführt wird.
' -----------------------------------------------------------
'
Public Function IsWindowsNT() As Boolean
    Const dwMaskNT = &H2&
    IsWindowsNT = (GetWinPlatform() And dwMaskNT)
End Function

' ----------------------------------------------------------
' FUNKTION: GetWinPlatform
' Aktuelle Windows-Plattform ermitteln.
' ---------------------------------------------------------
Public Function GetWinPlatform() As Long
    Dim osvi As OSVERSIONINFO
    
    osvi.dwOSVersionInfoSize = Len(osvi)
    
    If GetVersionEx(osvi) = 0 Then
        Exit Function
    End If
    
    GetWinPlatform = osvi.dwPlatformId
End Function
'---------- Ende Modul "ExitWin" alias ExitWin.bas ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 12 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von hemntorc am 17.08.2011 um 02:29

ydzkgk <a href="http://ozrlkofwrpkw.com/">ozrlkofwrpkw</a>, [url=http://pedorordrglr.com/]pedorordrglr[/url], [link=http://fkfbjntfxlus.com/]fkfbjntfxlus[/link], http://nvatpwhcbcmw.com/

Kommentar von Wolfgang am 04.10.2007 um 11:17

Ich habe den Tip dahingehend verändert, das mein XP rebootet
wird.


If fOKRunterfahren Then
SystemDown = (ExitWindowsEx(EWX_SHUTDOWN, 0) <> 0)
End If

Welche Einstellungen sind notwendig, damit die Maschine auch im Falle eines schwerwiegenden Systemfehlers zwingend neu gestartet wird? !

Kommentar von Der Da Drüben am 18.02.2006 um 21:47

Na was wohl?

DAS SYSTEM RUNTERFAHREN VIELLEICHT? ;)

Kommentar von klaus cuur-au am 29.06.2003 um 23:28

welche wirkung erzeugt dein programm?

Kommentar von Timo S. am 06.06.2003 um 08:37

Bei mir funzt der Source nicht richtig.
W2K tut den aktuellen User abmelden, fährt aber nicht runter. Drücke ich STRG+ALT+ENTF krieg ich dieses Sicherheits-Fenster. Wenn ich das abbreche ist Windows wie nach einer erfolgreichen Anmeldung wieder voll da.

Bin ich nun zu blöd dazu? Übrigens habe ich die Sub SetTme(Datum as Date) rauskommentiert, da diese, wie von Michael beschrieben, nichts mit dem Shutdown zu tun hat.

MfG der Freak

Kommentar von Börge Schmüser am 05.05.2003 um 16:55

Hallo,
ich will die obige Methode in C# umschreiben, bekomme aber bei OpenProcessToken für den Thoken immer Null. Hat jemand eine Hilfestellung bei der richtigen Deklaration von Public Type TOKEN_PRIVILEGES oder ein funktionierendes Beispiel wie ich unter C# eine Shutdown-Methode realisieren kann?
Danke für Eure Hilfe,
Gruß Börge Schmüser

Kommentar von Melf Christiansen am 10.04.2003 um 09:36

Kann mir jamanderzählen wie das genau geht und wo man das alles macht mit dem herunterfahren.ich kenne mich noch nicht so damit aus, und hätte gern eine genaue erklärung.

Kommentar von hfg am 03.02.2003 um 12:42

fghfg

Kommentar von JAY am 01.02.2003 um 04:11

sdfsdfsdf

Kommentar von .::crazycons::. am 16.11.2002 um 23:14

Ich peil ja den Modulteil, aber net das billige Teil in der Form. Ich möchte doch garnet, daß sich da irgendwie die Schrift ändert, sondern nur, daß mein System runtergefahren wird. ich hab da jetzt einfach mal nur systemdown hingeschrieben. Bin mal gespannt, was passiert.
mfg
de nixbligger

Kommentar von Sven am 24.07.2002 um 10:25

Das ganze klappt recht gut, egal ob mit 95/98/2000 oder XP. Aber ein Problem hab zumindest ich trotzdem noch: der Rechner wird bei EWX_SHUTDOWN nicht abgeschaltet. Ich hab schon eine zusätzliche Variable definiert (EWX_POWEROFF) und die auf 8 oder 3 gesetzt (die Werte hab ich in anderen Tipps zu dem Thema gefunden), aber dann macht die Maschine einen Neustart statt des Poweroff.
Weiß jemand welchen Wert ich dazu verwenden muß oder muß ich das irgendwie anders machen??

Kommentar von Michael G. am 30.06.2002 um 10:51

wozu ist der SetTime Sub? damit kann man zwar auch unter nt die zeit veräbdern, aber hat mit den runterfahren nichts zu tun, oder?
auf jeden fall super tipp!