كود ايقاف تشغيل ويندوز

يا شباب انا اريد كود يغلق جهاز الحاسوب بشرط ان النظام اكس بي

مفهوم

السلام عليكم ورحمة الله وبركاته

خذ أخي هذا الكود يفي بكل أغراض أغلاق ويندوز أكس بي من أغلاق وعمل ريستارت ولوج أوف وهيبرنيت

ولكني قريبا سأجهز لك كودا أفضل من هذا ولكن هذا الكود يعمل بكفاءة

أرجوا أن يفيدك

'This following code demostrate how to shutdown, reboot, lock workstation NT and hibernate system if supported
Option Explicit

'System Contants
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const TokenPrivileges = 3
Private Const ANYSIZE_ARRAY = 1
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_SHUTDOWN_NAME = "SeShutdownPrivilege"

'Shutdown constants
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
'Platform constants
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32s = 0

'OS version data structure
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
Dim typOS As OSVERSIONINFO

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
    TheLuid As LUID
    Attributes As Long
    'Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function SetSuspendState Lib "Powrprof.dll" (ByVal Hibernate As Integer, ByVal ForceCritical As Integer, ByVal DisableWakeEvent As Integer) As Integer
Private Declare Function IsPwrHibernateAllowed Lib "Powrprof.dll" () As Integer
Private Declare Function LockWorkStation Lib "user32" () As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) 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 LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Sub AllowTokenShutdown()
Dim hProcessHandle As Long
Dim hTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lbuffer As Long

hProcessHandle = GetCurrentProcess()

OpenProcessToken hProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hTokenHandle

LookupPrivilegeValue "", "seShutdownPrivilege", tmpLuid
With tkp
    .PrivilegeCount = 1
    .TheLuid = tmpLuid
    .Attributes = SE_PRIVILEGE_ENABLED

End With

AdjustTokenPrivileges hTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lbuffer

End Sub

'this funstion can log off from your system
Public Sub LogOff()
Dim ans As Integer
Dim rc As Long
ans = MsgBox("Are you sure you want to LogOff", vbSystemModal + vbYesNo + vbQuestion + vbDefaultButton2, "Log Off")
If ans = vbYes Then
rc = ExitWindowsEx(EWX_LOGOFF, 0&)
End If
End Sub

'this function can rebboot your local system
Public Sub Reboot()
Dim ans As Integer
Dim rc As Long
ans = MsgBox("Hay!! You are going to reboot this system!" & vbCrLf & _
    "Are You sure ? ", vbQuestion + vbYesNo + vbSystemModal + vbDefaultButton2, "System Reboot")
If ans = vbYes Then
    AllowTokenShutdown
    rc = ExitWindowsEx(EWX_REBOOT, 0&)
End If
End Sub

Public Sub ShutDown() ' Shut Down Your System
Dim ans As Integer
Dim rc As Long
ans = MsgBox("Hay!! You are going to Shuting Down this system!" & vbCrLf & _
    "Are You sure ? ", vbQuestion + vbYesNo + vbSystemModal + vbDefaultButton2, "System ShutDown")
If ans = vbYes Then
    AllowTokenShutdown
    rc = ExitWindowsEx(EWX_SHUTDOWN, 0&)
End If
End Sub

Public Function LockComputer() ' Lock Computer
Dim OsWinNt As Boolean
Dim rc As Long
OsWinNt = OsVer
If OsWinNt = True Then
    rc = LockWorkStation
Else
   MsgBox "This is only for Windows NT Not for this OS", vbInformation + vbSystemModal, "Lock Error"
End If
End Function

Public Function Hibernate()
Dim rc As Integer
Dim ans As Integer
ans = MsgBox("Hay! You are going to Hibernate your system" & vbCrLf & "Are you sure " _
, vbQuestion + vbYesNo + vbDefaultButton2 + vbSystemModal, "Hibernate")
If ans = vbYes Then

    If IsPwrHibernateAllowed <> 0 Then
        rc = SetSuspendState(1, 0, 0)
    Else
        MsgBox "Your Computer doesn't support hibernation." & _
        vbCrLf & "This may be due to system setting or simply a computer bios does not support hibernation." & _
        vbCrLf & vbCrLf & "       Thanks For Using It!", vbCritical + vbSystemModal, "Hibernate Error"
    End If
End If
End Function

Public Function OsVer() As Boolean
    typOS.dwOSVersionInfoSize = Len(typOS)
    GetVersionEx typOS
    OsVer = typOS.dwPlatformId = VER_PLATFORM_WIN32_NT
End Function

جرب أخى هذا الكوود ، فى زر أغلاق و الحدث Click أكتب التالى :

Shell "shutdown -s"

أو 

Shell "shutdown -f"

اتمنى ان يفيدك و لو قليلا ، :rolleyes:

تقبل تخياتى