View Full Version : سوال: تغییر Resolution و SHutDown با API ExitWindowsEx
  
lmaghsoodi
پنج شنبه 23 خرداد 1392, 13:46 عصر
با سلام خدمت دوستان عزیز 
من می خواهم با استفاده از  ای پی آی (( ExitWindowsEx )) ، هم عمل ShutDown و Restart  و هم عمل تغییر Resolution   را انجام دهم . 
چطور می توانم این کار را با کدنویسی انجام دهم ؟
لطفاً مرا راهنمایی نمایید . 
پیشاپیش یک دنیا ممنون
m.4.r.m
پنج شنبه 23 خرداد 1392, 15:47 عصر
یه ماژول درست کن و این کد ها رو توش کپی کن 
Public Const EWX_LogOff As Long = 0
Public Const EWX_SHUTDOWN As Long = 1
Public Const EWX_REBOOT As Long = 2
Public Const EWX_FORCE As Long = 4
Public Const EWX_POWEROFF As Long = 8
Public Const mlngWindows95 = 0
Public Const mlngWindowsNT = 1
این کد هارو هم به برنامت اضافه کن
Private glngWhichWindows32 As Long
Private Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)
  
'Sub to Adjust Tokens if you are running WindowsNT
Public Sub AdjustToken()
  
    Const TOKEN_ADJUST_PRIVILEGES = &H20
    Const TOKEN_QUERY = &H8
    Const SE_PRIVILEGE_ENABLED = &H2
  
    Dim hdlProcessHandle As Long
    Dim hdlTokenHandle   As Long
    Dim tmpLuid          As LUID
    Dim tkp              As TOKEN_PRIVILEGES
    Dim tkpNewButIgnored As TOKEN_PRIVILEGES
    Dim lBufferNeeded    As Long
  
    SetLastError 0
  
    hdlProcessHandle = GetCurrentProcess()
  
    If GetLastError <> 0 Then
        'MsgBox "GetCurrentProcess error==" & GetLastError
    End If
  
    OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle
  
    If GetLastError <> 0 Then
        'MsgBox "OpenProcessToken error==" & GetLastError
    End If
  
    LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
  
    If GetLastError <> 0 Then
        'MsgBox "LookupPrivilegeValue error==" & GetLastError
    End If
  
    tkp.PrivilegeCount = 1
    tkp.TheLuid = tmpLuid
    tkp.Attributes = SE_PRIVILEGE_ENABLED
  
    AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded
                            
    If GetLastError <> 0 Then
        'MsgBox "AdjustTokenPrivileges error==" & GetLastError
    End If
  
End Sub
  
'Goes into your SUB_LOAD
Private Sub Form_Load()
    Dim lngVersion As Long
    'Get current version of Windows
    lngVersion = GetVersion()
    'Checks to see if you are running NT
    If ((lngVersion And &H80000000) = 0) Then
        glngWhichWindows32 = mlngWindowsNT
    Else
        glngWhichWindows32 = mlngWindows95
    End If
End Sub
 
'Create a button called btnReboot
Private Sub btnReboot_Click()
    'Checks to see if you are running NT
    If glngWhichWindows32 = mlngWindowsNT Then AdjustToken
    'Forces the computer to reboot
    ExitWindowsEx EWX_SHUTDOWN Or EWX_FORCE Or EWX_REBOOT, &HFFFF
  
End Sub
m.4.r.m
پنج شنبه 23 خرداد 1392, 15:49 عصر
این هم سورس تغییر رزولوشن
http://www.planet-source-code.com/Upload_PSC/ftp/Change_Scr1738394282004.zip
lmaghsoodi
پنج شنبه 23 خرداد 1392, 16:40 عصر
m.4.r.m گرامی ...
تکه کد شما در برنامه من جواب نداد . از خط <pre class="brush: vb;" style="direction:ltr;"> ، خطا گرفت.
این تگ چیست که در VB استفاده کرده اید؟
هنگامی هم که این تگ را بر می دارم، از خط 
Public Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)  اشکال می گیرد.
 
vBulletin® v4.2.5, Copyright ©2000-1404, Jelsoft Enterprises Ltd.