PDA

View Full Version : سوال: تغییر Resolution و SHutDown با API ExitWindowsEx



lmaghsoodi
پنج شنبه 23 خرداد 1392, 12:46 عصر
با سلام خدمت دوستان عزیز

من می خواهم با استفاده از ای پی آی (( ExitWindowsEx )) ، هم عمل ShutDown و Restart و هم عمل تغییر Resolution را انجام دهم .

چطور می توانم این کار را با کدنویسی انجام دهم ؟

لطفاً مرا راهنمایی نمایید .

پیشاپیش یک دنیا ممنون

m.4.r.m
پنج شنبه 23 خرداد 1392, 14: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, 14:49 عصر
این هم سورس تغییر رزولوشن

http://www.planet-source-code.com/Upload_PSC/ftp/Change_Scr1738394282004.zip

lmaghsoodi
پنج شنبه 23 خرداد 1392, 15:40 عصر
m.4.r.m گرامی ...

تکه کد شما در برنامه من جواب نداد . از خط <pre class="brush: vb;" style="direction:ltr;"> ، خطا گرفت.

این تگ چیست که در VB استفاده کرده اید؟

هنگامی هم که این تگ را بر می دارم، از خط
Public Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long) اشکال می گیرد.