Desligar Windows 2000 Através Do Vb

[Guest Regiscruz]

Gente preciso de um código que seja capaz de desligar o windows 2000 da forma convencional com telinha de confirmação e tudo como se fosse pelo menu iniciar, já pesquisei no forum mas os códigos que consegui só desligam o windows 98 e não funcionam no 2000 ou deligam o micro como se estivesse desligando a alimentação sem salvar as configurações nem nada, uma loucura. Alguém sabe porque? Se alguém tiver este código e puder postar aqui eu agradeço muito.

Um abraço. B)

[AlexMunhoz]

Olha esse tópico...

http://scriptbrasil.com.br/forum/index.php...AR+O+COMPUTADOR

Abraço... ;)

[Guest Regiscruz]

Caro AlexMunhoz, muito obrigado pela dica mas meu caso é um pouco mais complicado.

Tenho que admitir que sou extremamente leigo no que diz respeito a programação em visual basic, minha especialidade é programação de CLP e Sistemas supervisórios como IFix, PCim e outros, mas tenho que resolver este problema do windows, você já imagina porque né?!.

Se não fosse muito abuso e se não for pedir muito, eu gostaria que você "ou quem estiver disposto" me passe um código mais simplificado, não precisa enviar os arquivos, apenas o código tipo com três botões reset, desliga e logout e com o código do módulo.

Não estou sendo folgado, mas me jogaram esse pepino nas mãos e não consigo sair do lugar. Até que estou gostando do VB, mas vou levar muito tempo pra aprender a resolver esse problema sozinho, por isso conto com vocês.

Um abraço.

[Graymalkin]

http://scriptbrasil.com.br/forum/index.php...st&p=177942

Você viu este post especificamente? Creio que tenha sido a ele que o Alex tenha se referido.

Abraços,

Graymalkin

[Guest Regiscruz]

Olá pessoal, com base no que vocês me mostraram eu consegui encontrar exatamente o que eu estava procurando, infelizmente precisava ser desta forma pois em aplicações industriais não é bom se fazer as coisas quando ainda existem dúvidas...rs...

Caro Alex, guardei aquele código que você me mostrou pois já tenho uma aplicação para ele e Graymalkin, obrigado pela força, não posso esquecer também os que tiveram pelo menos a intenção de ajudar e como forma de agradecimento segue abaixo o código para desligar o Windows NT e XP via Visual Basic.

Um abraço..... ;)

'----------- No Formulário -------------

Private Sub Command1_Click()

If (MsgBox("Você deseja desligar o Windows?", _

vbYesNo Or vbQuestion) = vbYes) Then

ShutdownSystem

End If

End Sub

Private Sub Command2_Click()

Unload Me

End Sub

Private Sub Form_Load()

If (MsgBox("Você deseja desligar o Windows?", _

vbYesNo Or vbQuestion) = vbYes) Then

ShutdownSystem

End If

End Sub

'--------------- No Módulo ---------------

' Para desligar o Windows:

Private Declare Function ExitWindowsEx Lib "user32" _

(ByVal uFlags As Long, ByVal dwReserved As Long) As Long

Private Const ENDSESSION_LOGOFF = &H80000000

Public Enum EShutDownTypes

[_First] = 0

EWX_LOGOFF = 0

EWX_SHUTDOWN = 1&

' EWX_REBOOT = 2&

EWX_FORCE = 4&

EWX_POWEROFF = 8&

EWX_FORCEIFHUNG = 10& ' NT5 only

EWX_RESET = EWX_LOGOFF Or EWX_FORCE Or EWX_SHUTDOWN 'EWX_REBOOT

[_Last] = &H20& - 1

End Enum

Public Enum EShutDownErrorBaseConstant

eeSSDErrorBase = vbObjectError Or (1048 + &H210)

End Enum

'Para determinar se o NT esta rodando ou não:

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

'Para reportar os erros de API

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 somente

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

Private Const READ_CONTROL = &H20000

Private Const STANDARD_RIGHTS_ALL = &H1F0000

Private Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)

Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)

Private Const STANDARD_RIGHTS_REQUIRED = &HF0000

Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)

Private Const TOKEN_ASSIGN_PRIMARY = &H1

Private Const TOKEN_DUPLICATE = (&H2)

Private Const TOKEN_IMPERSONATE = (&H4)

Private Const TOKEN_QUERY = (&H8)

Private Const TOKEN_QUERY_SOURCE = (&H10)

Private Const TOKEN_ADJUST_PRIVILEGES = (&H20)

Private Const TOKEN_ADJUST_GROUPS = (&H40)

Private Const TOKEN_ADJUST_DEFAULT = (&H80)

Private Const TOKEN_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _

TOKEN_ASSIGN_PRIMARY Or _

TOKEN_DUPLICATE Or _

TOKEN_IMPERSONATE Or _

TOKEN_QUERY Or _

TOKEN_QUERY_SOURCE Or _

TOKEN_ADJUST_PRIVILEGES Or _

TOKEN_ADJUST_GROUPS Or _

TOKEN_ADJUST_DEFAULT)

Private Const TOKEN_READ = (STANDARD_RIGHTS_READ Or _

TOKEN_QUERY)

Private Const TOKEN_WRITE = (STANDARD_RIGHTS_WRITE Or _

TOKEN_ADJUST_PRIVILEGES Or _

TOKEN_ADJUST_GROUPS Or _

TOKEN_ADJUST_DEFAULT)

Private Const TOKEN_EXECUTE = (STANDARD_RIGHTS_EXECUTE)

Private Const TokenDefaultDacl = 6

Private Const TokenGroups = 2

Private Const TokenImpersonationLevel = 9

Private Const TokenOwner = 4

Private Const TokenPrimaryGroup = 5

Private Const TokenPrivileges = 3

Private Const TokenSource = 7

Private Const TokenStatistics = 10

Private Const TokenType = 8

Private Const TokenUser = 1

' ============================================================

Public Function WinError(ByVal lLastDLLError As Long) As String

Dim sBuff As String

Dim lCount As Long

'Retorna o erro da mensagem associada ao 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

'Retorna se o sistema esta rodando o NT ou não:

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 = EWX_RESET _

) As Boolean

Dim lR As Long

Dim sMsg As String

'Valida o tipo de desligamento:

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

'Este é o código para desligar

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

End Function