VB 5/6-Tipp 0495: Windows herunterfahren II
von Daniel Darr
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: | Verwendete API-Aufrufe: AdjustTokenPrivileges, ExitWindowsEx, GetCurrentProcess, GetVersionExA (GetVersionEx), InitiateSystemShutdownA (InitiateSystemShutdown), LookupPrivilegeValueA (LookupPrivilegeValue), OpenProcessToken, SetSystemTime | Download: |
'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-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
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!