VBA ile Windows'tan çıkış

[balca]

Merhaba;
Soru yazılım donanım kısmına yazılmış ama belki bir alternatif olabilir,
( http://www.excel.web.tr/viewtopic.php?t=13871 )

Excelde boş bir modüle kopyaladıktan sonra makroyu çalıştırınız kapanmasını istediğiniz saati yazdığınızda bilgisayarınız kapanacaktır.

Dipnot: Excel kapatılmamalıdır

Kodlar Sayın Haluk Üstadımıza aittir.
Kendilerine buradan bir kez daha paylaşımlarını için teşekkür ediyorum.

EDIT;
Sub bilgisayari_hemen_Kapat()
Dim LResult
LResult = ExitWindowsEx(EWX_SHUTDOWN, 0&)
End Sub


Sub zamanvererek_bilgisayari_kapat()
Dim Kapatma_Zamani As Variant
Kapatma_Zamani = InputBox("Windows'un ne zaman kapanmasini istersiniz?", , _
Format(Now + TimeSerial(0, 1, 0), "hh:mm:ss"))
If Kapatma_Zamani = "" Then Exit Sub
Application.OnTime TimeValue(Kapatma_Zamani), "bilgisayari_hemen_Kapat"
End Sub


Not: Yeni bir konu olarak, forumun "Makrolar" bölümüne taşınmıştır. [Haluk ® ]

 

[Levent Menteşoğlu]

Sn balca

Verdiğiniz kodlar eksik, "bilgisayari_hemen_Kapat" isimli makroyuda vermeniz gerekir.

 

[balca]

Sn. leventm;
Teşekkür ederim kodları düzelttim.

 

[Haluk]

Merhaba;

API deklerasyonları yapılmadığı için Sn. balca'nın verdiği kodlar yine eksik kalmış.

Ayrıca, NT tabanlı işletim sistemlerinde bazı ilaveler daha yapmak gerekiyor.

Kodun tamamı aşağıdadır, calistir isimli prosedür çalıştırlmalıdır.

Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Const ANYSIZE_ARRAY = 1
Const VER_PLATFORM_WIN32_NT = 2
'
Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
'
Type LUID
    LowPart As Long
    HighPart As Long
End Type
'
Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type
'
Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
'
Declare Function GetCurrentProcess Lib "kernel32" () As Long

Declare Function OpenProcessToken Lib "advapi32" _
        (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _
         TokenHandle As Long) As Long

Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" _
        (ByVal lpSystemName As String, ByVal lpName As String, _
         lpLuid As LUID) As Long

Declare Function AdjustTokenPrivileges Lib "advapi32" _
        (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

Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _
         ByVal dwReserved As Long) As Long

Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
        (ByRef lpVersionInformation As OSVERSIONINFO) As Long
'
Function IsWinNT() As Boolean
    Dim myOS As OSVERSIONINFO
    myOS.dwOSVersionInfoSize = Len(myOS)
    GetVersionEx myOS
    IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
'
Sub EnableShutDown()
    Dim hProc As Long
    Dim hToken As Long
    Dim mLUID As LUID
    Dim mPriv As TOKEN_PRIVILEGES
    Dim mNewPriv As TOKEN_PRIVILEGES
    hProc = GetCurrentProcess()
    OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
    LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
    mPriv.PrivilegeCount = 1
    mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
    mPriv.Privileges(0).pLuid = mLUID
    AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), _
                          mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)
End Sub
'
Sub calistir()
    Dim Kapatma_Zamani As Variant
    Kapatma_Zamani = InputBox("Windows'un ne zaman kapanmasını istersiniz?", , _
    Format(Now + TimeSerial(0, 1, 0), "hh:mm:ss"))
    If Kapatma_Zamani = "" Then Exit Sub
    Application.OnTime TimeValue(Kapatma_Zamani), "Windowsu_Kapat"
End Sub
'
Sub Windowsu_Kapat()
    If IsWinNT Then EnableShutDown
    ExitWindowsEx EWX_SHUTDOWN, 0
End Sub

 

[balca]

Sn Haluk;
Bi zamanlar kodları almıştım demek eksik kalmış. Teşekkürler.

 

[kundakci]

merhaba
hemen kapat.xls balca nın programına class modül eklendi
kapatac.xls ise seçime bağlı değişik bir uygulama

umarım işinize yarar