20. juni 2003 - 14:10Der er
9 kommentarer og 3 løsninger
Slukker computer ved en knap
når man trykker på CmdSluk skal computer slukke men kan ikke finde ud af få kode til det den skal bare lukke sig ned (shutdown) uden advarelse fordi på knappen står da sluk computer ( det er et lille sjovt styresystem jeg laver :) )
Min er heller ikke helt hvad der bliver ønsket. For at undgå den advarsel der ellers ville komme, skal der tilføjes "-t 0". Altså for at følge joerns eksempel: slut = Shell("shutdown -s -f -t 0")
Jeg har kigget efter 'shutdown' for at se hvad parametrene betyder, men shutdown findes ikke i min vb5. Men stenner har ret. Irriterende at skulle teste funktionen. Den jeg har skrevet er ikke en speciel VB sag. Indsætter du: C:\Windows\Rundll.exe user.exe,exitwindows i startmenuens punkt 'kør' så lukker maskinen straks. Du kan også oprette et ikon, der indeholder kommandoen.
Stenner naah det er ikke et rigtigt styresystem det kan jeg sq ik finde ud af at lave men har altid ønsket mig at komme ind til microsoft eller lave mit ejet men tror aldrig det bliver til noget men håber stadig på det
Hvis du ønsker at gøre det code - only, har jeg noget kode til dig her:
Option Explicit Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long Declare Function LockWorkStation Lib "user32.dll" () As Long Private Const ENDSESSION_LOGOFF = &H80000000 Dim Pos As Long Dim GoShut As Boolean Dim ret As Long Dim uFlag As Long
EWX_RESET = EWX_LOGOFF Or EWX_FORCE Or EWX_REBOOT [_Last] = &H20& - 1 End Enum Public Enum EShutDownErrorBaseConstant eeSSDErrorBase = vbObjectError Or (1048 + &H210) End Enum
Private Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long Private Const VER_PLATFORM_WIN32_NT = 2 Private Const VER_PLATFORM_WIN32_WINDOWS = 1 Private Const VER_PLATFORM_WIN32s = 0
' To Report API errors: Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100 Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000 Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800 Private Const FORMAT_MESSAGE_FROM_STRING = &H400 Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200 Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
' ============================================================================================ ' NT Only Private Type LARGE_INTEGER LowPart As Long HighPart As Long End Type Private Type LUID LowPart As Long HighPart As Long End Type Private Type LUID_AND_ATTRIBUTES pLuid As LUID Attributes As Long End Type Private Type TOKEN_PRIVILEGES PrivilegeCount As Long Privileges(0 To 0) As LUID_AND_ATTRIBUTES End Type Private Declare Function GetCurrentProcess Lib "kernel32" () 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, TokenInformationClass As Integer, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength As Long) 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 LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long Private Const SE_SHUTDOWN_NAME = "SeShutdownPrivilege" Private Const SE_PRIVILEGE_ENABLED = &H2
Public Function WinError(ByVal lLastDLLError As Long) As String Dim sBuff As String Dim lCount As Long
' Return the error message associated with LastDLLError: sBuff = String$(256, 0) lCount = FormatMessage( _ FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _ 0, lLastDLLError, 0&, sBuff, Len(sBuff), ByVal 0) If lCount Then WinError = Left$(sBuff, lCount) End If
End Function
Public Function IsNT() As Boolean Static bOnce As Boolean Static bValue As Boolean
' Return whether the system is running NT or not: If Not (bOnce) Then Dim tVI As OSVERSIONINFO tVI.dwOSVersionInfoSize = Len(tVI) If (GetVersionEx(tVI) <> 0) Then bValue = (tVI.dwPlatformId = VER_PLATFORM_WIN32_NT) bOnce = True End If End If IsNT = bValue
End Function
Private Function NTEnableShutDown(ByRef sMsg As String) As Boolean Dim tLUID As LUID Dim hProcess As Long Dim hToken As Long Dim tTP As TOKEN_PRIVILEGES, tTPOld As TOKEN_PRIVILEGES Dim lTpOld As Long Dim lR As Long
' Under NT we must enable the SE_SHUTDOWN_NAME privilege in the ' process we're trying to shutdown from, otherwise a call to ' try to shutdown has no effect!
' Find the LUID of the Shutdown privilege token: lR = LookupPrivilegeValue(vbNullString, SE_SHUTDOWN_NAME, tLUID)
' If we get it: If (lR <> 0) Then
' Get the current process handle: hProcess = GetCurrentProcess() If (hProcess <> 0) Then ' Open the token for adjusting and querying (if we can - user may not have rights): lR = OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken) If (lR <> 0) Then
' Ok we can now adjust the shutdown priviledges: With tTP .PrivilegeCount = 1 With .Privileges(0) .Attributes = SE_PRIVILEGE_ENABLED .pLuid.HighPart = tLUID.HighPart .pLuid.LowPart = tLUID.LowPart End With End With
' Now allow this process to shutdown the system: lR = AdjustTokenPrivileges(hToken, 0, tTP, Len(tTP), tTPOld, lTpOld)
If (lR <> 0) Then NTEnableShutDown = True Else Err.Raise eeSSDErrorBase + 6, App.EXEName & ".mShutDown", "Can't enable shutdown: You do not have the privileges to shutdown this system. [" & WinError(Err.LastDllError) & "]" End If
' Remember to close the handle when finished with it: CloseHandle hToken Else Err.Raise eeSSDErrorBase + 6, App.EXEName & ".mShutDown", "Can't enable shutdown: You do not have the privileges to shutdown this system. [" & WinError(Err.LastDllError) & "]" End If Else Err.Raise eeSSDErrorBase + 5, App.EXEName & ".mShutDown", "Can't enable shutdown: Can't determine the current process. [" & WinError(Err.LastDllError) & "]" End If Else Err.Raise eeSSDErrorBase + 4, App.EXEName & ".mShutDown", "Can't enable shutdown: Can't find the SE_SHUTDOWN_NAME privilege value. [" & WinError(Err.LastDllError) & "]" End If
End Function
Public Function ShutdownSystem( _ Optional ByVal eType As EShutDownTypes) As Boolean Dim lR As Long Dim sMsg As String
' Validate shutdown type: If (eType < EShutDownTypes.[_First] And eType > EShutDownTypes.[_Last]) Then Err.Raise eeSSDErrorBase + 7, App.EXEName & ".mShutDown", "Invalid parameter to ShutdownSystem: " & eType, vbInformation Exit Function End If
' Make sure we have enabled the privilege to shutdown ' for this process if we're running NT: If (IsNT) Then If Not (NTEnableShutDown(sMsg)) Then Exit Function End If End If
' This is the code to shut down lR = ExitWindowsEx(eType, &HFFFFFFFF) If (lR = 0) Then Err.Raise eeSSDErrorBase + 3, App.EXEName & ".mShutDown", "ShutdownSystem failed: " & WinError(Err.LastDllError) Else ' Remember that shutdown will proceed on another ' thread to this one, so code may continue to ' execute after this. ShutdownSystem = True End If
Man opnår nøjagtig det samme. Jeg mener blot at kunne huske at spørgsmålet har været oppe før, og at C:\Windows\Rundll.exe user.exe,exitwindows på nogle maskiner ikke kunne bruges. Det er muligt, at jeg husker forkert.
>> stenner. Tak for orienteringen >> baxox Tak for point. Jeg bruger kommandoen i http://jkfsoft.dk/luk15.htm m.v.h. Jørn
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.